[Vm-dev] VM Maker: VMMaker.oscog-eem.642.mcz
commits at source.squeak.org
commits at source.squeak.org
Mon Mar 17 21:24:19 UTC 2014
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.642.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.642
Author: eem
Time: 17 March 2014, 2:22:01.011 pm
UUID: 617048ca-1069-454c-951e-2ab94c6d66de
Ancestors: VMMaker.oscog-eem.641
Mostly simulator work.
Rationalize signed[32|64]BitIntegerFor:.
Fix odd bytes calculation in Spur>>allocateBytes:classIndex:.
Refactor the Spur leak checker so that references to garbage- collected classes are tolerated mid-way through GC but not before
or after.
Make primitiveSine etc simulate correctly when given Float nan as
operand.
Make asPositiveIntegerObj simulate correctly.
Fix screen update when large simulator windows are opened.
Fix screen update in BitBltSimulation>>unlockSurfaces and delete
the bogus fullDisplayUpdate on every 1000 bytecodes.
Fix access to the cmShiftTable in BitBltSimulation for negative shifts.
Fix the unitSize asserts in loadColorMap for simulation.
Fix simulation of primitivePixelValueAt[X:y:]
Increment byteCount by microseconds in ioRelinquishProcessorForMicroseconds:
so that microsecond clock advances (but this should be improved
by adding a separate microsecond clock).
Rewrite checkIfValidObjectRefAndTarget:pc:cogMethod: to use the
new accessors, but the assert for a cacheTag is still wrong for Spur.
Speed up StackInterpreterSimulator by adding a flag to control the
use of assertValidExecutionPointers on each bytecode, with a toggle
in the utilities menu.
=============== Diff against VMMaker.oscog-eem.641 ===============
Item was changed:
----- Method: BalloonArray>>at: (in category 'memory access') -----
at: index
| value |
value := simArray at: index+1.
"Debug only..."
value ifNil:
[self error: 'attempt to read an uninitialized field'.
^ super at: index "Maybe it was set in Squeak. Return the raw value"].
(self bitsOf: value) ~= (super at: index) ifTrue:
+ [self error: 'inconsistent values: ', (self bitsOf: value) printString, ' vs ', (super at: index) printString].
+ ^value!
- [self error: 'inconsistent values'].
- ^ value!
Item was changed:
----- Method: BitBltSimulation>>loadColorMap (in category 'interpreter interface') -----
loadColorMap
"ColorMap, if not nil, must be longWords, and
2^N long, where N = sourceDepth for 1, 2, 4, 8 bits,
or N = 9, 12, or 15 (3, 4, 5 bits per color) for 16 or 32 bits."
| cmSize oldStyle oop cmOop |
<inline: true>
cmFlags := cmMask := cmBitsPerColor := 0.
cmShiftTable := nil.
cmMaskTable := nil.
cmLookupTable := nil.
cmOop := interpreterProxy fetchPointer: BBColorMapIndex ofObject: bitBltOop.
cmOop = interpreterProxy nilObject ifTrue:[^true].
cmFlags := ColorMapPresent. "even if identity or somesuch - may be cleared later"
oldStyle := false.
(interpreterProxy isWords: cmOop) ifTrue:[
"This is an old-style color map (indexed only, with implicit RGBA conversion)"
cmSize := interpreterProxy slotSizeOf: cmOop.
cmLookupTable := interpreterProxy firstIndexableField: cmOop.
oldStyle := true.
self cCode: '' inSmalltalk:
[self assert: cmLookupTable unitSize = 4].
] ifFalse: [
"A new-style color map (fully qualified)"
((interpreterProxy isPointers: cmOop)
and:[(interpreterProxy slotSizeOf: cmOop) >= 3]) ifFalse:[^false].
cmShiftTable := self loadColorMapShiftOrMaskFrom:
(interpreterProxy fetchPointer: 0 ofObject: cmOop).
cmMaskTable := self loadColorMapShiftOrMaskFrom:
(interpreterProxy fetchPointer: 1 ofObject: cmOop).
oop := interpreterProxy fetchPointer: 2 ofObject: cmOop.
oop = interpreterProxy nilObject
ifTrue:[cmSize := 0]
ifFalse:[(interpreterProxy isWords: oop) ifFalse:[^false].
cmSize := (interpreterProxy slotSizeOf: oop).
cmLookupTable := interpreterProxy firstIndexableField: oop].
cmFlags := cmFlags bitOr: ColorMapNewStyle.
self cCode: '' inSmalltalk:
+ [self assert: (cmShiftTable isNil or: [cmShiftTable unitSize = 4]).
+ self assert: (cmMaskTable isNil or: [cmMaskTable unitSize = 4]).
+ self assert: (cmLookupTable isNil or: [cmLookupTable unitSize = 4])].
- [self assert: cmShiftTable unitSize = 4.
- self assert: cmMaskTable unitSize = 4.
- self assert: cmLookupTable unitSize = 4].
].
(cmSize bitAnd: cmSize - 1) = 0 ifFalse:[^false].
cmMask := cmSize - 1.
cmBitsPerColor := 0.
cmSize = 512 ifTrue: [cmBitsPerColor := 3].
cmSize = 4096 ifTrue: [cmBitsPerColor := 4].
cmSize = 32768 ifTrue: [cmBitsPerColor := 5].
cmSize = 0
ifTrue:[cmLookupTable := nil. cmMask := 0]
ifFalse:[cmFlags := cmFlags bitOr: ColorMapIndexedPart].
oldStyle "needs implicit conversion"
ifTrue:[ self setupColorMasks].
"Check if colorMap is just identity mapping for RGBA parts"
(self isIdentityMap: cmShiftTable with: cmMaskTable)
ifTrue:[ cmMaskTable := nil. cmShiftTable := nil ]
ifFalse:[ cmFlags := cmFlags bitOr: ColorMapFixedPart].
+ self cCode: [] inSmalltalk:
+ [cmShiftTable ifNotNil:
+ [cmShiftTable := CPluggableAccessor new
+ setObject: cmShiftTable;
+ atBlock: [:obj :idx| obj intAt: idx - 1]
+ atPutBlock: [:obj :idx :val| obj intAt: idx - 1 put: val];
+ yourself]].
^true!
Item was changed:
----- Method: BitBltSimulation>>unlockSurfaces (in category 'surface support') -----
unlockSurfaces
"Unlock the bits of any OS surfaces."
"See the comment in lockSurfaces. Similar rules apply. That is, the area provided in ioUnlockSurface can be used to determine the dirty region after drawing. If a source is unlocked, then the area will be (0,0,0,0) to indicate that no portion is dirty."
| sourceHandle destHandle destLocked fn |
<var: #fn declareC:'sqInt (*fn)(sqInt, sqInt, sqInt, sqInt, sqInt)'>
hasSurfaceLock ifTrue:[
unlockSurfaceFn = 0 ifTrue:[self loadSurfacePlugin ifFalse:[^nil]].
fn := self cCoerce: unlockSurfaceFn to: 'sqInt (*)(sqInt, sqInt, sqInt, sqInt, sqInt)'.
destLocked := false.
destHandle := interpreterProxy fetchPointer: FormBitsIndex ofObject: destForm.
(interpreterProxy isIntegerObject: destHandle) ifTrue:[
destHandle := interpreterProxy integerValueOf: destHandle.
"The destBits are always assumed to be dirty"
self cCode:'fn(destHandle, affectedL, affectedT, affectedR-affectedL, affectedB-affectedT)'.
destBits := destPitch := 0.
destLocked := true.
].
noSource ifFalse:[
sourceHandle := interpreterProxy fetchPointer: FormBitsIndex ofObject: sourceForm.
(interpreterProxy isIntegerObject: sourceHandle) ifTrue:[
sourceHandle := interpreterProxy integerValueOf: sourceHandle.
"Only unlock sourceHandle if different from destHandle"
(destLocked and:[sourceHandle = destHandle])
ifFalse:[self cCode: 'fn(sourceHandle, 0, 0, 0, 0)'].
sourceBits := sourcePitch := 0.
].
].
hasSurfaceLock := false.
+ self cCode: [] inSmalltalk:
+ [self touch: fn.
+ interpreterProxy displayObject = destForm ifTrue:
+ [interpreterProxy getDeferDisplayUpdates "for some reason this is true..."
+ ifTrue:
+ [interpreterProxy fullDisplayUpdate]
+ ifFalse:
+ [interpreterProxy fullDisplayUpdate]]].
].!
Item was added:
+ ----- Method: BitBltSimulator>>primitive:parameters:receiver: (in category 'simulation') -----
+ primitive: primitiveName parameters: parameterTypesArray receiver: rcvrType
+ primitiveName caseOf: {
+ ['primitivePixelValueAt'] -> [^self] }!
Item was added:
+ ----- Method: BitBltSimulator>>primitivePixelValueAt (in category 'simulation') -----
+ primitivePixelValueAt
+ self primitivePixelValueAtX: (interpreterProxy stackValue: 1) y: (interpreterProxy stackValue: 0)!
Item was added:
+ ----- Method: CogVMSimulator>>displayView (in category 'accessing') -----
+ displayView
+ "The VM SImulator draws directly on an imageMorph named displayView
+ displayView is housed on a Form named displayForm
+ Since this is housed directly on the Morph, I have this tight compling from here->model->morph.
+ "
+ self flag: 'tty'.
+ ^displayView!
Item was changed:
----- Method: CogVMSimulator>>incrementByteCount (in category 'interpreter shell') -----
incrementByteCount
(byteCount := byteCount + 1) = breakCount ifTrue:
[self doOrDefer: [self changed: #byteCountText; changed: #composeAll].
self halt].
byteCount \\ 1000 = 0 ifTrue:
[self doOrDefer: [self changed: #byteCountText; changed: #composeAll].
+ self forceInterruptCheck]!
- self forceInterruptCheck.
- byteCount \\ 10000 = 0 ifTrue: [self fullDisplayUpdate]]!
Item was changed:
----- Method: CogVMSimulator>>ioRelinquishProcessorForMicroseconds: (in category 'I/O primitives support') -----
ioRelinquishProcessorForMicroseconds: microseconds
"In the simulator give an indication that we're idling and check for input.
If called from machine code then increment the byte count since the clock
is derived from it and the clock will not advance otherwise.
If we're simulating threading we're in difficulties. We need a UI process
(to run activities such as fill-in-the-blanks) but we also need an independent
thread of control to run this VM thread. So we need to fork a new UI process."
Display reverse: (0 at 0 extent: 16 at 16).
- instructionPointer >= objectMemory startOfMemory ifFalse:
- [byteCount := byteCount + microseconds - 1.
- self incrementByteCount].
Sensor peekEvent ifNotNil:
[self forceInterruptCheck].
Processor activeProcess == Project uiProcess ifTrue:
[World doOneCycle].
microseconds >= 1000
ifTrue: [self isThreadedVM ifTrue:
[self forceInterruptCheckFromHeartbeat].
(Delay forMilliseconds: microseconds + 999 // 1000) wait]
+ ifFalse: [Processor yield].
+ byteCount := byteCount + microseconds - 1.
+ self incrementByteCount!
- ifFalse: [Processor yield]!
Item was removed:
- ----- Method: CogVMSimulator>>primitiveScreenSize (in category 'I/O primitives') -----
- primitiveScreenSize
- | size |
- size := self desiredDisplayExtent min: 800 at 640.
- self pop: 1 thenPush: (self makePointwithxValue: size x yValue: size y)!
Item was changed:
----- Method: CogVMSimulator>>stackLimitFromMachineCode (in category 'I/O primitives support') -----
stackLimitFromMachineCode
"Intercept accesses to the stackLimit from machine code to
increment byteCount so that ioMSecs/ioMicroseconds does
somethng reasonable when we're purely in machine code."
(byteCount := byteCount + 1) - lastPollCount >= 100 ifTrue:
[lastPollCount := byteCount.
- byteCount \\ 500 = 0 ifTrue:
- [self fullDisplayUpdate].
(Sensor peekEvent notNil
or: [nextProfileTick > 0
and: [nextProfileTick <= self ioUTCMicroseconds]]) ifTrue:
[suppressHeartbeatFlag "gets set by selector breakpoints"
ifTrue: [self forceInterruptCheck]
ifFalse: [self forceInterruptCheckFromHeartbeat]]].
^stackLimit!
Item was changed:
----- Method: Cogit>>checkIfValidObjectRefAndTarget:pc:cogMethod: (in category 'garbage collection') -----
checkIfValidObjectRefAndTarget: annotation pc: mcpc cogMethod: cogMethod
<var: #mcpc type: #'char *'>
+ | literal entryPoint |
- | literal cacheTag entryPoint |
annotation = IsObjectReference ifTrue:
[literal := backEnd literalBeforeFollowingAddress: mcpc asInteger.
(self asserta: (objectRepresentation checkValidObjectReference: literal)) ifFalse:
[^1].
((objectRepresentation couldBeObject: literal)
and: [objectMemory isReallyYoungObject: literal]) ifTrue:
[(self asserta: (self cCoerceSimple: cogMethod to: #'CogMethod *') cmRefersToYoung) ifFalse:
[^2]]].
(self isSendAnnotation: annotation) ifTrue:
[(self asserta: (self cCoerceSimple: cogMethod to: #'CogMethod *') cmType = CMMethod) ifFalse:
[^3].
+ self offsetCacheTagAndCouldBeObjectAt: mcpc annotation: annotation into:
+ [:offset :cacheTag :tagCouldBeObject|
+ tagCouldBeObject
+ ifTrue:
+ [(objectRepresentation couldBeObject: cacheTag)
+ ifTrue:
+ [(self asserta: (objectRepresentation checkValidObjectReference: cacheTag)) ifFalse:
+ [^4]]
+ ifFalse:
+ [(self asserta: (objectRepresentation checkValidInlineCacheTag: cacheTag)) ifFalse:
+ [^5]].
+ ((objectRepresentation couldBeObject: cacheTag)
+ and: [coInterpreter isReallyYoungObject: cacheTag]) ifTrue:
+ [(self asserta: (self cCoerceSimple: cogMethod to: #'CogMethod *') cmRefersToYoung) ifFalse:
+ [^6]]]
+ ifFalse:
+ [(self asserta: (objectRepresentation checkValidInlineCacheTag: cacheTag)) ifFalse:
+ [^7]]].
- cacheTag := backEnd inlineCacheTagAt: mcpc asInteger.
- (self asserta: (objectRepresentation checkValidInlineCacheTag: cacheTag)) ifFalse:
- [^4].
- ((objectRepresentation couldBeObject: cacheTag)
- and: [coInterpreter isReallyYoungObject: cacheTag]) ifTrue:
- [(self asserta: (self cCoerceSimple: cogMethod to: #'CogMethod *') cmRefersToYoung) ifFalse:
- [^5]].
entryPoint := backEnd callTargetFromReturnAddress: mcpc asInteger.
entryPoint > methodZoneBase ifTrue:
["It's a linked send; find which kind."
self targetMethodAndSendTableFor: entryPoint annotation: annotation into:
[:targetMethod :sendTable|
(self asserta: (targetMethod cmType = CMMethod
or: [targetMethod cmType = CMClosedPIC
or: [targetMethod cmType = CMOpenPIC]])) ifFalse:
+ [^8]]]].
- [^6]]]].
^0 "keep scanning"!
Item was added:
+ ----- Method: Integer>>asPositiveIntegerObj (in category '*VMMaker-interpreter simulator') -----
+ asPositiveIntegerObj
+ "This is a SmartSyntaxPlugin convenience, invented with little thought for simulation (grrr).
+ In the VM this is equivalent to
+ interpreterProxy methodReturnValue: (interpreterProxy positive32BitIntegerFor: self)
+ but if a plugin is being developed I /think/ it is just
+ ^self
+ So search the stack to discover what context it is being used in."
+ (thisContext findContextSuchThat: [:ctxt| ctxt receiver isInterpreterPlugin]) ifNotNil:
+ [:ctxt| | interpreter |
+ interpreter := ctxt receiver getInterpreter.
+ interpreter methodReturnValue: (interpreter positive32BitIntegerFor: self)].
+ ^self!
Item was added:
+ ----- Method: InterpreterPlugin>>isInterpreterPlugin (in category 'testing') -----
+ isInterpreterPlugin
+ <doNotGenerate>
+ "Simulation only"
+ ^true!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveArctan (in category 'arithmetic float primitives') -----
primitiveArctan
| rcvr |
<var: #rcvr type: #double>
rcvr := self popFloat.
self successful
+ ifTrue: [self pushFloat: (self cCode: [rcvr atan]
+ inSmalltalk: [rcvr = rcvr
+ ifTrue: [rcvr arcTan]
+ ifFalse: [Float nan]])]
- ifTrue: [self pushFloat: (self cCode: 'atan(rcvr)' inSmalltalk: [rcvr arcTan])]
ifFalse: [self unPop: 1]!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveExp (in category 'arithmetic float primitives') -----
primitiveExp
"Computes E raised to the receiver power."
| rcvr |
<var: #rcvr type: #double>
rcvr := self popFloat.
self successful
+ ifTrue: [self pushFloat: (self cCode: [rcvr exp]
+ inSmalltalk: [rcvr = rcvr
+ ifTrue: [rcvr exp]
+ ifFalse: [Float nan]])]
- ifTrue: [self pushFloat: (self cCode: 'exp(rcvr)' inSmalltalk: [rcvr exp])]
ifFalse: [self unPop: 1]!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveLogN (in category 'arithmetic float primitives') -----
primitiveLogN
"Natural log."
| rcvr |
<var: #rcvr type: #double>
rcvr := self popFloat.
self successful
+ ifTrue: [self pushFloat: (self cCode: [rcvr log]
+ inSmalltalk: [rcvr = rcvr
+ ifTrue: [rcvr ln]
+ ifFalse: [Float nan]])]
- ifTrue: [self pushFloat: (self cCode: 'log(rcvr)' inSmalltalk: [rcvr ln])]
ifFalse: [self unPop: 1]!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveScreenSize (in category 'I/O primitives') -----
primitiveScreenSize
+ "Answer a point indicating the current size of the Smalltalk window.
+ Currently there is a limit of 65535 in each direction because the
+ point is encoded into a single 32bit value in the image header.
+ This might well become a problem one day"
+ self
+ cCode:
+ [| pointWord |
+ pointWord := self ioScreenSize.
+ self pop: 1
+ thenPush: (self makePointwithxValue: (pointWord >> 16 bitAnd: 65535)
+ yValue: (pointWord bitAnd: 65535))]
+ inSmalltalk:
+ [| size |
+ "Default to a reasonable size for simulation, unless the window has opened,
+ in which case allow the screen to be as large as the simulation window"
+ size := (self displayView notNil and: [self savedWindowSize notNil])
+ ifTrue: [self desiredDisplayExtent]
+ ifFalse: [self desiredDisplayExtent min: 800 at 640].
+ self pop: 1 thenPush: (self makePointwithxValue: size x yValue: size y)]!
- "Return a point indicating the current size of the Smalltalk window. Currently there is a limit of 65535 in each direction because the point is encoded into a single 32bit value in the image header. This might well become a problem one day"
- | pointWord |
- self pop: 1.
- pointWord := self ioScreenSize.
- self push: (self makePointwithxValue: (pointWord >> 16 bitAnd: 65535) yValue: (pointWord bitAnd: 65535))!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveSine (in category 'arithmetic float primitives') -----
primitiveSine
| rcvr |
<var: #rcvr type: #double>
rcvr := self popFloat.
self successful
+ ifTrue: [self pushFloat: (self cCode: [rcvr sin]
+ inSmalltalk: [rcvr = rcvr
+ ifTrue: [rcvr sin]
+ ifFalse: [Float nan]])]
- ifTrue: [self pushFloat: (self cCode: 'sin(rcvr)' inSmalltalk: [rcvr sin])]
ifFalse: [self unPop: 1]!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveSquareRoot (in category 'arithmetic float primitives') -----
primitiveSquareRoot
| rcvr |
<var: #rcvr type: #double>
rcvr := self popFloat.
self success: rcvr >= 0.0.
self successful
+ ifTrue: [self pushFloat: rcvr sqrt]
- ifTrue: [self pushFloat: (self cCode: 'sqrt(rcvr)' inSmalltalk: [rcvr sqrt])]
ifFalse: [self unPop: 1]!
Item was added:
+ ----- Method: InterpreterProxy>>getDeferDisplayUpdates (in category 'special objects') -----
+ getDeferDisplayUpdates
+ ^false!
Item was changed:
----- Method: NewspeakInterpreterSimulator>>incrementByteCount (in category 'interpreter shell') -----
incrementByteCount
(byteCount := byteCount + 1) = breakCount ifTrue:
[self doOrDefer: [self changed: #byteCountText].
self halt].
byteCount \\ 1000 = 0 ifTrue:
[self doOrDefer: [self changed: #byteCountText].
+ self forceInterruptCheck]!
- self forceInterruptCheck.
- byteCount \\ 10000 = 0 ifTrue: [self fullDisplayUpdate]]!
Item was added:
+ ----- Method: Object>>isInterpreterPlugin (in category '*VMMaker-translation support') -----
+ isInterpreterPlugin
+ ^false!
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:
+ baseFrameReturn
+ bereaveAllMarriedContextsForSnapshotFlushingExternalPrimitivesIf:
- on:do: "from the debugger"
- makeBaseFrameFor:
- quickFetchInteger:ofObject:
- frameOfMarriedContext:
- objCouldBeClassObj:
- isMarriedOrWidowedContext:
- shortPrint:
bytecodePrimAt
bytecodePrimAtPut
+ bytesOrInt:growTo:
+ ceBaseFrameReturn:
+ checkIsStillMarriedContext:currentFP:
+ checkedIntegerValueOf:
+ cogMethodDoesntLookKosher:
commonAt:
commonAtPut:
+ commonVariable:at:put:cacheIndex:
- loadFloatOrIntFrom:
- positive32BitValueOf:
- primitiveExternalCall
- checkedIntegerValueOf:
- bytecodePrimAtPut
- commonAtPut:
- primitiveVMParameter
- checkIsStillMarriedContext:currentFP:
- displayBitsOf:Left:Top:Right:Bottom:
- fetchStackPointerOf:
- primitiveContextAt
- primitiveContextAtPut
- subscript:with:storing:format:
- printContext:
compare31or32Bits:equal:
+ digitBitLogic:with:opIndex:
- signed64BitValueOf:
- primDigitMultiply:negative:
digitLength:
+ displayBitsOf:Left:Top:Right:Bottom:
+ ensureContextHasBytecodePC:
+ externalInstVar:ofContext:
+ fetchIntOrFloat:ofObject:
+ fetchIntOrFloat:ofObject:ifNil:
+ fetchStackPointerOf:
- isNegativeIntegerValueOf:
- magnitude64BitValueOf:
- primitiveMakePoint
- primitiveAsCharacter
- primitiveInputSemaphore
- baseFrameReturn
- primitiveExternalCall
- primDigitCompare:
- isLiveContext:
- numPointerSlotsOf:
fileValueOf:
+ frameOfMarriedContext:
+ functionForPrimitiveExternalCall:
+ genSpecialSelectorArithmetic
+ genSpecialSelectorComparison
+ inlineCacheTagForInstance:
+ instVar:ofContext:
+ isCogMethodReference:
+ isLiveContext:
+ isMarriedOrWidowedContext:
+ isNegativeIntegerValueOf:
+ isNormalized:
loadBitBltDestForm
- fetchIntOrFloat:ofObject:ifNil:
- fetchIntOrFloat:ofObject:
loadBitBltSourceForm
+ loadFloatOrIntFrom:
loadPoint:from:
+ magnitude64BitValueOf:
+ makeBaseFrameFor:
+ numPointerSlotsOf:
+ objCouldBeClassObj:
+ on:do: "from the debugger"
+ positive32BitValueOf:
- primDigitAdd:
- primDigitSubtract:
positive64BitValueOf:
+ primDigitAdd:
+ primDigitBitShiftMagnitude:
+ primDigitCompare:
- digitBitLogic:with:opIndex:
- signed32BitValueOf:
- isNormalized:
primDigitDiv:negative:
+ primDigitMultiply:negative:
+ primDigitSubtract:
+ primitiveAllInstances
+ primitiveAsCharacter
+ primitiveContextAt
+ primitiveContextAtPut
+ primitiveExternalCall
+ primitiveFileSetPosition
+ primitiveFileTruncate DoIt
+ primitiveForwardSignalToSemaphore
+ primitiveGrowMemoryByAtLeast
+ primitiveInputSemaphore
+ primitiveMakePoint
- 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
+ primitiveVMParameter
+ printContext:
+ quickFetchInteger:ofObject:
+ shortPrint:
+ shortPrintOop:
+ signed32BitValueOf:
+ signed64BitValueOf:
+ subscript:with:storing:format:
+ unlockSurfaces) includes: sel) ifFalse:
- bereaveAllMarriedContextsForSnapshotFlushingExternalPrimitivesIf:
- primitiveForwardSignalToSemaphore) includes: sel) ifFalse:
[self halt].
^super isIntegerObject: oop!
Item was removed:
- ----- Method: Spur32BitMMLECoSimulator>>runLeakCheckerForFullGC:excludeUnmarkedNewSpaceObjs: (in category 'debug support') -----
- runLeakCheckerForFullGC: fullGCFlag excludeUnmarkedNewSpaceObjs: excludeUnmarkedNewSpaceObjs
- (fullGCFlag
- ifTrue: [self leakCheckFullGC]
- ifFalse: [self leakCheckNewSpaceGC]) ifTrue:
- [coInterpreter transcript nextPutAll: 'leak-checking...'; flush].
- ^super runLeakCheckerForFullGC: fullGCFlag excludeUnmarkedNewSpaceObjs: excludeUnmarkedNewSpaceObjs!
Item was added:
+ ----- Method: Spur32BitMMLECoSimulator>>runLeakCheckerForFullGC:excludeUnmarkedNewSpaceObjs:classIndicesShouldBeValid: (in category 'debug support') -----
+ runLeakCheckerForFullGC: fullGCFlag excludeUnmarkedNewSpaceObjs: excludeUnmarkedNewSpaceObjs classIndicesShouldBeValid: classIndicesShouldBeValid
+ (fullGCFlag
+ ifTrue: [self leakCheckFullGC]
+ ifFalse: [self leakCheckNewSpaceGC]) ifTrue:
+ [coInterpreter transcript nextPutAll: 'leak-checking...'; flush].
+ ^super
+ runLeakCheckerForFullGC: fullGCFlag
+ excludeUnmarkedNewSpaceObjs: excludeUnmarkedNewSpaceObjs
+ classIndicesShouldBeValid: classIndicesShouldBeValid!
Item was changed:
----- Method: Spur32BitMMLESimulator>>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:
+ baseFrameReturn
+ bereaveAllMarriedContextsForSnapshotFlushingExternalPrimitivesIf:
- on:do: "from the debugger"
- makeBaseFrameFor:
- quickFetchInteger:ofObject:
- frameOfMarriedContext:
- objCouldBeClassObj:
- isMarriedOrWidowedContext:
- shortPrint:
bytecodePrimAt
bytecodePrimAtPut
+ bytesOrInt:growTo:
+ ceBaseFrameReturn:
+ checkIsStillMarriedContext:currentFP:
+ checkedIntegerValueOf:
+ cogMethodDoesntLookKosher:
commonAt:
commonAtPut:
+ commonVariable:at:put:cacheIndex:
- loadFloatOrIntFrom:
- positive32BitValueOf:
- primitiveExternalCall
- checkedIntegerValueOf:
- bytecodePrimAtPut
- commonAtPut:
- primitiveVMParameter
- checkIsStillMarriedContext:currentFP:
- displayBitsOf:Left:Top:Right:Bottom:
- fetchStackPointerOf:
- primitiveContextAt
- primitiveContextAtPut
- subscript:with:storing:format:
- printContext:
compare31or32Bits:equal:
+ digitBitLogic:with:opIndex:
- signed64BitValueOf:
- primDigitMultiply:negative:
digitLength:
+ displayBitsOf:Left:Top:Right:Bottom:
+ ensureContextHasBytecodePC:
+ externalInstVar:ofContext:
+ fetchIntOrFloat:ofObject:
+ fetchIntOrFloat:ofObject:ifNil:
+ fetchStackPointerOf:
- isNegativeIntegerValueOf:
- magnitude64BitValueOf:
- primitiveMakePoint
- primitiveAsCharacter
- primitiveInputSemaphore
- baseFrameReturn
- primitiveExternalCall
- primDigitCompare:
- isLiveContext:
- numPointerSlotsOf:
fileValueOf:
+ frameOfMarriedContext:
+ functionForPrimitiveExternalCall:
+ genSpecialSelectorArithmetic
+ genSpecialSelectorComparison
+ inlineCacheTagForInstance:
+ instVar:ofContext:
+ isCogMethodReference:
+ isLiveContext:
+ isMarriedOrWidowedContext:
+ isNegativeIntegerValueOf:
+ isNormalized:
loadBitBltDestForm
- fetchIntOrFloat:ofObject:ifNil:
- fetchIntOrFloat:ofObject:
loadBitBltSourceForm
+ loadFloatOrIntFrom:
loadPoint:from:
+ magnitude64BitValueOf:
+ makeBaseFrameFor:
+ numPointerSlotsOf:
+ objCouldBeClassObj:
+ on:do: "from the debugger"
+ positive32BitValueOf:
- primDigitAdd:
- primDigitSubtract:
positive64BitValueOf:
+ primDigitAdd:
+ primDigitBitShiftMagnitude:
+ primDigitCompare:
- digitBitLogic:with:opIndex:
- signed32BitValueOf:
- isNormalized:
primDigitDiv:negative:
+ primDigitMultiply:negative:
+ primDigitSubtract:
+ primitiveAllInstances
+ primitiveAsCharacter
+ primitiveContextAt
+ primitiveContextAtPut
+ primitiveExternalCall
+ primitiveFileSetPosition
+ primitiveFileTruncate DoIt
+ primitiveForwardSignalToSemaphore
+ primitiveGrowMemoryByAtLeast
+ primitiveInputSemaphore
+ primitiveMakePoint
- bytesOrInt:growTo:
primitiveNewMethod
- isCogMethodReference:
- functionForPrimitiveExternalCall:
- genSpecialSelectorArithmetic
- genSpecialSelectorComparison
- ensureContextHasBytecodePC:
- instVar:ofContext:
- ceBaseFrameReturn:
- inlineCacheTagForInstance:
primitiveObjectAtPut
+ primitiveSizeInBytesOfInstance
+ primitiveVMParameter
+ printContext:
+ quickFetchInteger:ofObject:
+ shortPrint:
+ shortPrintOop:
+ signed32BitValueOf:
+ signed64BitValueOf:
+ subscript:with:storing:format:
+ unlockSurfaces) includes: sel) ifFalse:
- commonVariable:at:put:cacheIndex:
- primDigitBitShiftMagnitude:
- externalInstVar:ofContext:
- primitiveGrowMemoryByAtLeast
- primitiveFileSetPosition
- bereaveAllMarriedContextsForSnapshotFlushingExternalPrimitivesIf:
- shortPrintOop:) includes: sel) ifFalse:
[self halt].
^super isIntegerObject: oop!
Item was removed:
- ----- Method: Spur32BitMMLESimulator>>runLeakCheckerForFullGC:excludeUnmarkedNewSpaceObjs: (in category 'debug support') -----
- runLeakCheckerForFullGC: fullGCFlag excludeUnmarkedNewSpaceObjs: excludeUnmarkedNewSpaceObjs
- (fullGCFlag
- ifTrue: [self leakCheckFullGC]
- ifFalse: [self leakCheckNewSpaceGC]) ifTrue:
- [coInterpreter transcript nextPutAll: 'leak-checking...'; flush].
- ^super runLeakCheckerForFullGC: fullGCFlag excludeUnmarkedNewSpaceObjs: excludeUnmarkedNewSpaceObjs!
Item was added:
+ ----- Method: Spur32BitMMLESimulator>>runLeakCheckerForFullGC:excludeUnmarkedNewSpaceObjs:classIndicesShouldBeValid: (in category 'debug support') -----
+ runLeakCheckerForFullGC: fullGCFlag excludeUnmarkedNewSpaceObjs: excludeUnmarkedNewSpaceObjs classIndicesShouldBeValid: classIndicesShouldBeValid
+ (fullGCFlag
+ ifTrue: [self leakCheckFullGC]
+ ifFalse: [self leakCheckNewSpaceGC]) ifTrue:
+ [coInterpreter transcript nextPutAll: 'leak-checking...'; flush].
+ ^super
+ runLeakCheckerForFullGC: fullGCFlag
+ excludeUnmarkedNewSpaceObjs: excludeUnmarkedNewSpaceObjs
+ classIndicesShouldBeValid: classIndicesShouldBeValid!
Item was changed:
----- Method: SpurMemoryManager>>allocateBytes:classIndex: (in category 'allocation') -----
allocateBytes: numBytes classIndex: classIndex
"Allocate an object of numBytes. Answer nil if no available memory.
classIndex must be that of a byte class (e.g. ByteString).
The object is *NOT FILLED*."
self assert: (coInterpreter addressCouldBeClassObj: (self classAtIndex: classIndex)).
self assert: (self instSpecOfClass: (self classAtIndex: classIndex)) = self firstByteFormat.
^self
allocateSlots: (numBytes + self bytesPerSlot - 1 // self bytesPerSlot)
+ format: (self byteFormatForNumBytes: numBytes)
- format: self firstByteFormat + (self bytesPerSlot - numBytes bitAnd: self bytesPerSlot - 1)
classIndex: classIndex!
Item was removed:
- ----- Method: SpurMemoryManager>>checkHeapIntegrity: (in category 'debug support') -----
- checkHeapIntegrity: excludeUnmarkedNewSpaceObjs
- "Perform an integrity/leak check using the heapMap. Assume
- clearLeakMapAndMapAccessibleObjects has set a bit at each
- object's header. Scan all objects in the heap checking that every
- pointer points to a header. Scan the rootTable, remapBuffer and
- extraRootTable checking that every entry is a pointer to a header.
- Check that the number of roots is correct and that all rootTable
- entries have their rootBit set. Answer if all checks pass."
- | ok numRememberedRootsInHeap |
- <inline: false>
- ok := true.
- numRememberedRootsInHeap := 0.
- self allHeapEntitiesDo:
- [:obj| | containsYoung fieldOop classIndex classOop |
- ((self isFreeObject: obj)
- or: [(self isYoungObject: obj) and: [(self isMarked: obj) not and: [excludeUnmarkedNewSpaceObjs]]]) ifFalse:
- [containsYoung := false.
- (self isRemembered: obj) ifTrue:
- [numRememberedRootsInHeap := numRememberedRootsInHeap + 1.
- (scavenger isInRememberedSet: obj) ifFalse:
- [coInterpreter print: 'remembered object '; printHex: obj; print: ' is not in remembered table'; cr.
- self eek.
- ok := false]].
- (self isForwarded: obj)
- ifTrue:
- [fieldOop := self fetchPointer: 0 ofMaybeForwardedObject: obj.
- (heapMap heapMapAtWord: (self pointerForOop: fieldOop)) = 0 ifTrue:
- [coInterpreter print: 'object leak in forwarder '; printHex: obj; print: ' to unmapped '; printHex: fieldOop; cr.
- self eek.
- ok := false].
- (self isYoung: fieldOop) ifTrue:
- [containsYoung := true]]
- ifFalse:
- [classOop := self classOrNilAtIndex: (classIndex := self classIndexOf: obj).
- (classOop = nilObj
- and: [(self isHiddenObj: obj) not]) ifTrue:
- [coInterpreter print: 'object leak in '; printHex: obj; print: ' invalid class index '; printHex: classIndex; print: ' -> '; print: (classOop ifNil: ['nil'] ifNotNil: ['nilObj']); cr.
- self eek.
- ok := false].
- self baseHeaderSize to: (self lastPointerOf: obj) by: BytesPerOop do:
- [:ptr|
- fieldOop := self longAt: obj + ptr.
- (self isNonImmediate: fieldOop) ifTrue:
- [| fi |
- fi := ptr - self baseHeaderSize / self wordSize.
- (fieldOop bitAnd: self wordSize - 1) ~= 0
- ifTrue:
- [coInterpreter print: 'misaligned oop in '; printHex: obj; print: ' @ '; printNum: fi; print: ' = '; printHex: fieldOop; cr.
- self eek.
- ok := false]
- ifFalse:
- [(heapMap heapMapAtWord: (self pointerForOop: fieldOop)) = 0 ifTrue:
- [coInterpreter print: 'object leak in '; printHex: obj; print: ' @ '; printNum: fi; print: ' = '; printHex: fieldOop; cr.
- self eek.
- ok := false].
- "don't be misled by CogMethods; they appear to be young, but they're not"
- ((self isYoung: fieldOop)
- and: [self oop: fieldOop isGreaterThanOrEqualTo: newSpaceStart]) ifTrue:
- [containsYoung := true]]]]].
- (containsYoung and: [(self isYoung: obj) not]) ifTrue:
- [(self isRemembered: obj) ifFalse:
- [coInterpreter print: 'unremembered object '; printHex: obj; print: ' contains young oop(s)'; cr.
- self eek.
- ok := false]]]].
- numRememberedRootsInHeap ~= scavenger rememberedSetSize ifTrue:
- [coInterpreter
- print: 'root count mismatch. #heap roots ';
- printNum: numRememberedRootsInHeap;
- print: '; #roots ';
- printNum: scavenger rememberedSetSize;
- cr.
- self eek.
- "But the system copes with overflow..."
- self flag: 'no support for remembered set overflow yet'.
- "ok := rootTableOverflowed and: [needGCFlag]"].
- scavenger rememberedSetWithIndexDo:
- [:obj :i|
- (obj bitAnd: self wordSize - 1) ~= 0
- ifTrue:
- [coInterpreter print: 'misaligned oop in remembered set @ '; printNum: i; print: ' = '; printHex: obj; cr.
- self eek.
- ok := false]
- ifFalse:
- [(heapMap heapMapAtWord: (self pointerForOop: obj)) = 0
- ifTrue:
- [coInterpreter print: 'object leak in remembered set @ '; printNum: i; print: ' = '; printHex: obj; cr.
- self eek.
- ok := false]
- ifFalse:
- [(self isYoung: obj) ifTrue:
- [coInterpreter print: 'non-root in remembered set @ '; printNum: i; print: ' = '; printHex: obj; cr.
- self eek.
- ok := false]]]].
- 1 to: remapBufferCount do:
- [:ri| | obj |
- obj := remapBuffer at: ri.
- (obj bitAnd: self wordSize - 1) ~= 0
- ifTrue:
- [coInterpreter print: 'misaligned remapRoot @ '; printNum: ri; print: ' = '; printHex: obj; cr.
- self eek.
- ok := false]
- ifFalse:
- [(heapMap heapMapAtWord: (self pointerForOop: obj)) = 0 ifTrue:
- [coInterpreter print: 'object leak in remapRoots @ '; printNum: ri; print: ' = '; printHex: obj; cr.
- self eek.
- ok := false]]].
- 1 to: extraRootCount do:
- [:ri| | obj |
- obj := (extraRoots at: ri) at: 0.
- (obj bitAnd: self wordSize - 1) ~= 0
- ifTrue:
- [coInterpreter print: 'misaligned extraRoot @ '; printNum: ri; print: ' => '; printHex: obj; cr.
- self eek.
- ok := false]
- ifFalse:
- [(heapMap heapMapAtWord: (self pointerForOop: obj)) = 0 ifTrue:
- [coInterpreter print: 'object leak in extraRoots @ '; printNum: ri; print: ' => '; printHex: obj; cr.
- self eek.
- ok := false]]].
- ^ok!
Item was added:
+ ----- Method: SpurMemoryManager>>checkHeapIntegrity:classIndicesShouldBeValid: (in category 'debug support') -----
+ checkHeapIntegrity: excludeUnmarkedNewSpaceObjs classIndicesShouldBeValid: classIndicesShouldBeValid
+ "Perform an integrity/leak check using the heapMap. Assume
+ clearLeakMapAndMapAccessibleObjects has set a bit at each
+ object's header. Scan all objects in the heap checking that every
+ pointer points to a header. Scan the rootTable, remapBuffer and
+ extraRootTable checking that every entry is a pointer to a header.
+ Check that the number of roots is correct and that all rootTable
+ entries have their rootBit set. Answer if all checks pass."
+ | ok numRememberedRootsInHeap |
+ <inline: false>
+ ok := true.
+ numRememberedRootsInHeap := 0.
+ self allHeapEntitiesDo:
+ [:obj| | containsYoung fieldOop classIndex classOop |
+ ((self isFreeObject: obj)
+ or: [(self isYoungObject: obj) and: [(self isMarked: obj) not and: [excludeUnmarkedNewSpaceObjs]]]) ifFalse:
+ [containsYoung := false.
+ (self isRemembered: obj) ifTrue:
+ [numRememberedRootsInHeap := numRememberedRootsInHeap + 1.
+ (scavenger isInRememberedSet: obj) ifFalse:
+ [coInterpreter print: 'remembered object '; printHex: obj; print: ' is not in remembered table'; cr.
+ self eek.
+ ok := false]].
+ (self isForwarded: obj)
+ ifTrue:
+ [fieldOop := self fetchPointer: 0 ofMaybeForwardedObject: obj.
+ (heapMap heapMapAtWord: (self pointerForOop: fieldOop)) = 0 ifTrue:
+ [coInterpreter print: 'object leak in forwarder '; printHex: obj; print: ' to unmapped '; printHex: fieldOop; cr.
+ self eek.
+ ok := false].
+ (self isYoung: fieldOop) ifTrue:
+ [containsYoung := true]]
+ ifFalse:
+ [classOop := self classOrNilAtIndex: (classIndex := self classIndexOf: obj).
+ (classIndicesShouldBeValid
+ and: [classOop = nilObj
+ and: [(self isHiddenObj: obj) not]]) ifTrue:
+ [coInterpreter print: 'object leak in '; printHex: obj; print: ' invalid class index '; printHex: classIndex; print: ' -> '; print: (classOop ifNil: ['nil'] ifNotNil: ['nilObj']); cr.
+ self eek.
+ ok := false].
+ self baseHeaderSize to: (self lastPointerOf: obj) by: BytesPerOop do:
+ [:ptr|
+ fieldOop := self longAt: obj + ptr.
+ (self isNonImmediate: fieldOop) ifTrue:
+ [| fi |
+ fi := ptr - self baseHeaderSize / self wordSize.
+ (fieldOop bitAnd: self wordSize - 1) ~= 0
+ ifTrue:
+ [coInterpreter print: 'misaligned oop in '; printHex: obj; print: ' @ '; printNum: fi; print: ' = '; printHex: fieldOop; cr.
+ self eek.
+ ok := false]
+ ifFalse:
+ [(heapMap heapMapAtWord: (self pointerForOop: fieldOop)) = 0 ifTrue:
+ [coInterpreter print: 'object leak in '; printHex: obj; print: ' @ '; printNum: fi; print: ' = '; printHex: fieldOop; cr.
+ self eek.
+ ok := false].
+ "don't be misled by CogMethods; they appear to be young, but they're not"
+ ((self isYoung: fieldOop)
+ and: [self oop: fieldOop isGreaterThanOrEqualTo: newSpaceStart]) ifTrue:
+ [containsYoung := true]]]]].
+ (containsYoung and: [(self isYoung: obj) not]) ifTrue:
+ [(self isRemembered: obj) ifFalse:
+ [coInterpreter print: 'unremembered object '; printHex: obj; print: ' contains young oop(s)'; cr.
+ self eek.
+ ok := false]]]].
+ numRememberedRootsInHeap ~= scavenger rememberedSetSize ifTrue:
+ [coInterpreter
+ print: 'root count mismatch. #heap roots ';
+ printNum: numRememberedRootsInHeap;
+ print: '; #roots ';
+ printNum: scavenger rememberedSetSize;
+ cr.
+ self eek.
+ "But the system copes with overflow..."
+ self flag: 'no support for remembered set overflow yet'.
+ "ok := rootTableOverflowed and: [needGCFlag]"].
+ scavenger rememberedSetWithIndexDo:
+ [:obj :i|
+ (obj bitAnd: self wordSize - 1) ~= 0
+ ifTrue:
+ [coInterpreter print: 'misaligned oop in remembered set @ '; printNum: i; print: ' = '; printHex: obj; cr.
+ self eek.
+ ok := false]
+ ifFalse:
+ [(heapMap heapMapAtWord: (self pointerForOop: obj)) = 0
+ ifTrue:
+ [coInterpreter print: 'object leak in remembered set @ '; printNum: i; print: ' = '; printHex: obj; cr.
+ self eek.
+ ok := false]
+ ifFalse:
+ [(self isYoung: obj) ifTrue:
+ [coInterpreter print: 'non-root in remembered set @ '; printNum: i; print: ' = '; printHex: obj; cr.
+ self eek.
+ ok := false]]]].
+ 1 to: remapBufferCount do:
+ [:ri| | obj |
+ obj := remapBuffer at: ri.
+ (obj bitAnd: self wordSize - 1) ~= 0
+ ifTrue:
+ [coInterpreter print: 'misaligned remapRoot @ '; printNum: ri; print: ' = '; printHex: obj; cr.
+ self eek.
+ ok := false]
+ ifFalse:
+ [(heapMap heapMapAtWord: (self pointerForOop: obj)) = 0 ifTrue:
+ [coInterpreter print: 'object leak in remapRoots @ '; printNum: ri; print: ' = '; printHex: obj; cr.
+ self eek.
+ ok := false]]].
+ 1 to: extraRootCount do:
+ [:ri| | obj |
+ obj := (extraRoots at: ri) at: 0.
+ (obj bitAnd: self wordSize - 1) ~= 0
+ ifTrue:
+ [coInterpreter print: 'misaligned extraRoot @ '; printNum: ri; print: ' => '; printHex: obj; cr.
+ self eek.
+ ok := false]
+ ifFalse:
+ [(heapMap heapMapAtWord: (self pointerForOop: obj)) = 0 ifTrue:
+ [coInterpreter print: 'object leak in extraRoots @ '; printNum: ri; print: ' => '; printHex: obj; cr.
+ self eek.
+ ok := false]]].
+ ^ok!
Item was added:
+ ----- Method: SpurMemoryManager>>fullDisplayUpdate (in category 'simulation only') -----
+ fullDisplayUpdate
+ "hack around the CoInterpreter/ObjectMemory split refactoring"
+ <doNotGenerate>
+ ^coInterpreter fullDisplayUpdate!
Item was changed:
----- Method: SpurMemoryManager>>globalGarbageCollect (in category 'gc - global') -----
globalGarbageCollect
self runLeakCheckerForFullGC: true.
self assert: self validObjStacks.
self assert: (self isEmptyObjStack: markStack).
self assert: (self isEmptyObjStack: weaklingStack).
self markObjects.
self nilUnmarkedWeaklingSlots.
self freeUnmarkedObjectsAndSortAndCoalesceFreeSpace.
+ self runLeakCheckerForFullGC: true excludeUnmarkedNewSpaceObjs: true classIndicesShouldBeValid: false.
- self runLeakCheckerForFullGC: true excludeUnmarkedNewSpaceObjs: true.
self compact.
self eliminateAndFreeForwarders.
self assert: self validObjStacks.
self assert: (self isEmptyObjStack: markStack).
self assert: (self isEmptyObjStack: weaklingStack).
self assert: self allObjectsUnmarked.
self runLeakCheckerForFullGC: true!
Item was changed:
----- Method: SpurMemoryManager>>runLeakCheckerForFullGC: (in category 'debug support') -----
runLeakCheckerForFullGC: fullGCFlag
+ ^self runLeakCheckerForFullGC: fullGCFlag excludeUnmarkedNewSpaceObjs: false classIndicesShouldBeValid: true!
- ^self runLeakCheckerForFullGC: fullGCFlag excludeUnmarkedNewSpaceObjs: false!
Item was removed:
- ----- Method: SpurMemoryManager>>runLeakCheckerForFullGC:excludeUnmarkedNewSpaceObjs: (in category 'debug support') -----
- runLeakCheckerForFullGC: fullGCFlag excludeUnmarkedNewSpaceObjs: excludeUnmarkedNewSpaceObjs
- <inline: false>
- (fullGCFlag
- ifTrue: [self leakCheckFullGC]
- ifFalse: [self leakCheckNewSpaceGC]) ifTrue:
- [fullGCFlag
- ifTrue: [coInterpreter reverseDisplayFrom: 0 to: 7]
- ifFalse: [coInterpreter reverseDisplayFrom: 8 to: 15].
- self clearLeakMapAndMapAccessibleObjects.
- self assert: (self checkHeapIntegrity: excludeUnmarkedNewSpaceObjs).
- self assert: coInterpreter checkInterpreterIntegrity.
- self assert: coInterpreter checkStackIntegrity.
- self assert: (coInterpreter checkCodeIntegrity: fullGCFlag)]!
Item was added:
+ ----- Method: SpurMemoryManager>>runLeakCheckerForFullGC:excludeUnmarkedNewSpaceObjs:classIndicesShouldBeValid: (in category 'debug support') -----
+ runLeakCheckerForFullGC: fullGCFlag excludeUnmarkedNewSpaceObjs: excludeUnmarkedNewSpaceObjs classIndicesShouldBeValid: classIndicesShouldBeValid
+ <inline: false>
+ (fullGCFlag
+ ifTrue: [self leakCheckFullGC]
+ ifFalse: [self leakCheckNewSpaceGC]) ifTrue:
+ [fullGCFlag
+ ifTrue: [coInterpreter reverseDisplayFrom: 0 to: 7]
+ ifFalse: [coInterpreter reverseDisplayFrom: 8 to: 15].
+ self clearLeakMapAndMapAccessibleObjects.
+ self assert: (self checkHeapIntegrity: excludeUnmarkedNewSpaceObjs classIndicesShouldBeValid: classIndicesShouldBeValid).
+ self assert: coInterpreter checkInterpreterIntegrity.
+ self assert: coInterpreter checkStackIntegrity.
+ self assert: (coInterpreter checkCodeIntegrity: fullGCFlag)]!
Item was added:
+ ----- Method: StackInterpreter>>getDeferDisplayUpdates (in category 'simulation support') -----
+ getDeferDisplayUpdates
+ <doNotGenerate>
+ ^deferDisplayUpdates!
Item was changed:
----- Method: StackInterpreter>>positive64BitIntegerFor: (in category 'primitive support') -----
positive64BitIntegerFor: integerValue
+ <var: 'integerValue' type: #sqLong>
+ "Answer a Large Positive Integer object for the given integer value. N.B. will *not* cause a GC."
- <var: 'integerValue' type: 'sqLong'>
| newLargeInteger highWord sz |
- "N.B. will *not* cause a GC.
- integerValue is interpreted as POSITIVE, e.g. as the result of Bitmap>at:."
highWord := self cCode: 'integerValue >> 32' inSmalltalk: [integerValue >> 32]. "shift is coerced to usqInt otherwise"
highWord = 0 ifTrue:[^self positive32BitIntegerFor: integerValue].
sz := 5.
(highWord := highWord >> 8) = 0 ifFalse:[sz := sz + 1].
(highWord := highWord >> 8) = 0 ifFalse:[sz := sz + 1].
(highWord := highWord >> 8) = 0 ifFalse:[sz := sz + 1].
newLargeInteger := objectMemory
eeInstantiateSmallClassIndex: ClassLargePositiveIntegerCompactIndex
format: (objectMemory byteFormatForNumBytes: sz)
numSlots: 8 / objectMemory bytesPerSlot.
objectMemory
storeByte: 7 ofObject: newLargeInteger withValue: (integerValue >> 56 bitAnd: 16rFF);
storeByte: 6 ofObject: newLargeInteger withValue: (integerValue >> 48 bitAnd: 16rFF);
storeByte: 5 ofObject: newLargeInteger withValue: (integerValue >> 40 bitAnd: 16rFF);
storeByte: 4 ofObject: newLargeInteger withValue: (integerValue >> 32 bitAnd: 16rFF);
storeByte: 3 ofObject: newLargeInteger withValue: (integerValue >> 24 bitAnd: 16rFF);
storeByte: 2 ofObject: newLargeInteger withValue: (integerValue >> 16 bitAnd: 16rFF);
storeByte: 1 ofObject: newLargeInteger withValue: (integerValue >> 8 bitAnd: 16rFF);
storeByte: 0 ofObject: newLargeInteger withValue: (integerValue ">> 0" bitAnd: 16rFF).
^newLargeInteger
!
Item was changed:
----- Method: StackInterpreter>>signed32BitIntegerFor: (in category 'primitive support') -----
signed32BitIntegerFor: integerValue
+ "Answer a full 32 bit integer object for the given integer value."
- "Return a full 32 bit integer object for the given integer value"
| newLargeInteger value largeClass |
<inline: false>
(objectMemory isIntegerValue: integerValue) ifTrue:
[^objectMemory integerObjectOf: integerValue].
+ integerValue < 0
+ ifTrue: [largeClass := ClassLargeNegativeIntegerCompactIndex.
+ value := 0 - integerValue]
+ ifFalse: [largeClass := ClassLargePositiveIntegerCompactIndex.
+ value := integerValue].
+ newLargeInteger := objectMemory
+ eeInstantiateSmallClassIndex: largeClass
+ format: (objectMemory byteFormatForNumBytes: 4)
+ numSlots: 1.
- objectMemory hasSpurMemoryManagerAPI
- ifTrue:
- [integerValue < 0
- ifTrue: [largeClass := ClassLargeNegativeIntegerCompactIndex.
- value := 0 - integerValue]
- ifFalse: [largeClass := ClassLargePositiveIntegerCompactIndex.
- value := integerValue].
- objectMemory allocateBytes: 4 classIndex: largeClass]
- ifFalse:
- [integerValue < 0
- ifTrue: [largeClass := objectMemory classLargeNegativeInteger.
- value := 0 - integerValue]
- ifFalse: [largeClass := objectMemory classLargePositiveInteger.
- value := integerValue].
- newLargeInteger := objectMemory eeInstantiateClass: largeClass indexableSize: 4].
objectMemory storeByte: 3 ofObject: newLargeInteger withValue: ((value >> 24) bitAnd: 16rFF).
objectMemory storeByte: 2 ofObject: newLargeInteger withValue: ((value >> 16) bitAnd: 16rFF).
objectMemory storeByte: 1 ofObject: newLargeInteger withValue: ((value >> 8) bitAnd: 16rFF).
objectMemory storeByte: 0 ofObject: newLargeInteger withValue: (value bitAnd: 16rFF).
^newLargeInteger!
Item was changed:
----- Method: StackInterpreter>>signed64BitIntegerFor: (in category 'primitive support') -----
signed64BitIntegerFor: integerValue
- "Return a Large Integer object for the given integer value"
- | newLargeInteger magnitude largeClass intValue highWord sz |
- <inline: false>
<var: 'integerValue' type: #sqLong>
+ "Answer a Large Integer object for the given integer value. N.B. will *not* cause a GC."
+ | newLargeInteger magnitude largeClass highWord sz |
+ <inline: false>
<var: 'magnitude' type: #sqLong>
<var: 'highWord' type: #usqInt>
integerValue < 0
+ ifTrue:[ largeClass := ClassLargeNegativeIntegerCompactIndex.
- ifTrue:[ largeClass := objectMemory classLargeNegativeInteger.
magnitude := 0 - integerValue]
+ ifFalse:[ largeClass := ClassLargePositiveIntegerCompactIndex.
- ifFalse:[ largeClass := objectMemory classLargePositiveInteger.
magnitude := integerValue].
"Make sure to handle the most -ve value correctly. 0 - most -ve = most -ve and most -ve - 1
is +ve. Alas the simple (negative or: [integerValue - 1 < 0]) fails with contemporary gcc and icc
versions with optimization and sometimes without. The shift works on all, touch wood."
(magnitude <= 16r7FFFFFFF
and: [integerValue >= 0
or: [0 ~= (self cCode: [integerValue << 1]
inSmalltalk: [integerValue << 1 bitAnd: (1 << 64) - 1])]]) ifTrue:
[^self signed32BitIntegerFor: integerValue].
highWord := magnitude >> 32.
highWord = 0
ifTrue:[sz := 4]
ifFalse:
[sz := 5.
(highWord := highWord >> 8) = 0 ifFalse:[sz := sz + 1].
(highWord := highWord >> 8) = 0 ifFalse:[sz := sz + 1].
(highWord := highWord >> 8) = 0 ifFalse:[sz := sz + 1]].
+ newLargeInteger := objectMemory
+ eeInstantiateSmallClassIndex: largeClass
+ format: (objectMemory byteFormatForNumBytes: sz)
+ numSlots: sz + 3 // objectMemory bytesPerSlot.
+ sz > 4 ifTrue:
+ [objectMemory
+ storeByte: 7 ofObject: newLargeInteger withValue: (magnitude >> 56 bitAnd: 16rFF);
+ storeByte: 6 ofObject: newLargeInteger withValue: (magnitude >> 48 bitAnd: 16rFF);
+ storeByte: 5 ofObject: newLargeInteger withValue: (magnitude >> 40 bitAnd: 16rFF);
+ storeByte: 4 ofObject: newLargeInteger withValue: (magnitude >> 32 bitAnd: 16rFF)].
+ objectMemory
+ storeByte: 3 ofObject: newLargeInteger withValue: (magnitude >> 24 bitAnd: 16rFF);
+ storeByte: 2 ofObject: newLargeInteger withValue: (magnitude >> 16 bitAnd: 16rFF);
+ storeByte: 1 ofObject: newLargeInteger withValue: (magnitude >> 8 bitAnd: 16rFF);
+ storeByte: 0 ofObject: newLargeInteger withValue: (magnitude ">> 0" bitAnd: 16rFF).
- newLargeInteger := objectMemory instantiateClass: largeClass indexableSize: sz.
- 0 to: sz-1 do: [:i |
- intValue := (magnitude >> (i * 8)) bitAnd: 255.
- objectMemory storeByte: i ofObject: newLargeInteger withValue: intValue].
^newLargeInteger!
Item was changed:
StackInterpreterPrimitives subclass: #StackInterpreterSimulator
+ instanceVariableNames: 'bootstrapping byteCount breakCount sendCount printSends printReturns traceOn myBitBlt displayForm filesOpen imageName pluginList mappedPluginEntries quitBlock transcript displayView printFrameAtEachStep printBytecodeAtEachStep systemAttributes startMicroseconds externalSemaphoreSignalRequests externalSemaphoreSignalResponses extSemTabSize atEachStepBlock disableBooleanCheat performFilters eventQueue assertVEPAES'
- instanceVariableNames: 'bootstrapping byteCount breakCount sendCount printSends printReturns traceOn myBitBlt displayForm filesOpen imageName pluginList mappedPluginEntries quitBlock transcript displayView printFrameAtEachStep printBytecodeAtEachStep systemAttributes startMicroseconds externalSemaphoreSignalRequests externalSemaphoreSignalResponses extSemTabSize atEachStepBlock disableBooleanCheat performFilters eventQueue'
classVariableNames: ''
poolDictionaries: ''
category: 'VMMaker-InterpreterSimulation'!
!StackInterpreterSimulator commentStamp: 'eem 9/3/2013 11:05' prior: 0!
This class defines basic memory access and primitive simulation so that the StackInterpreter can run simulated in the Squeak environment. It also defines a number of handy object viewing methods to facilitate pawing around in the object memory.
To see the thing actually run, you could (after backing up this image and changes), execute
(StackInterpreterSimulator new openOn: Smalltalk imageName) test
((StackInterpreterSimulator newWithOptions: #(NewspeakVM true MULTIPLEBYTECODESETS true))
openOn: 'ns101.image') test
and be patient both to wait for things to happen, and to accept various things that may go wrong depending on how large or unusual your image may be. We usually do this with a small and simple benchmark image.
Here's an example of what Eliot uses to launch the simulator in a window. The bottom-right window has a menu packed with useful stuff:
| vm |
vm := StackInterpreterSimulator newWithOptions: #().
vm openOn: '/Users/eliot/Squeak/Squeak4.4/trunk44.image'.
vm setBreakSelector: #&.
vm openAsMorph; run!
Item was changed:
----- Method: StackInterpreterSimulator>>fullDisplayUpdate (in category 'debug support') -----
fullDisplayUpdate
- "Preserve self successful when call asynchronously from Simulator"
| primFailCodeValue |
+ self break.
primFailCodeValue := primFailCode.
self initPrimCall.
super fullDisplayUpdate.
primFailCode := primFailCodeValue!
Item was changed:
----- Method: StackInterpreterSimulator>>incrementByteCount (in category 'interpreter shell') -----
incrementByteCount
(byteCount := byteCount + 1) = breakCount ifTrue:
[self doOrDefer: [self changed: #byteCountText].
self halt].
byteCount \\ 1000 = 0 ifTrue:
[self doOrDefer: [self changed: #byteCountText].
+ self forceInterruptCheck]!
- self forceInterruptCheck.
- byteCount \\ 1000 = 0 ifTrue: [self fullDisplayUpdate]] "tty. denominator was 10000 before event forwarding. Refactor me."!
Item was changed:
----- Method: StackInterpreterSimulator>>initialize (in category 'initialization') -----
initialize
"Initialize the StackInterpreterSimulator when running the interpreter
inside Smalltalk. The primary responsibility of this method is to allocate
Smalltalk Arrays for variables that will be declared as statically-allocated
global arrays in the translated code."
bootstrapping := false.
transcript := Transcript.
objectMemory ifNil:
[objectMemory := self class objectMemoryClass simulatorClass new].
objectMemory coInterpreter: self.
"Note: we must initialize ConstMinusOne differently for simulation,
due to the fact that the simulator works only with +ve 32-bit values"
ConstMinusOne := objectMemory integerObjectOf: -1.
methodCache := Array new: MethodCacheSize.
atCache := Array new: AtCacheTotalSize.
self flushMethodCache.
gcSemaphoreIndex := 0.
externalSemaphoreSignalRequests := externalSemaphoreSignalResponses := #().
externalPrimitiveTable := CArrayAccessor on: (Array new: MaxExternalPrimitiveTableSize).
externalPrimitiveTableFirstFreeIndex := 0.
primitiveTable := self class primitiveTable copy.
mappedPluginEntries := OrderedCollection new.
objectMemory hasSpurMemoryManagerAPI
ifTrue:
[primitiveAccessorDepthTable := Array new: primitiveTable size.
pluginList := {}.
self loadNewPlugin: '']
ifFalse:
[pluginList := {'' -> self }].
desiredNumStackPages := desiredEdenBytes := 0.
"This is initialized on loading the image, but convenient for testing stack page values..."
numStackPages := self defaultNumStackPages.
startMicroseconds := Time totalSeconds * 1000000.
"initialize InterpreterSimulator variables used for debugging"
byteCount := 0.
sendCount := 0.
+ quitBlock := [^self].
- quitBlock := [^ self].
traceOn := true.
printSends := printReturns := printFrameAtEachStep := printBytecodeAtEachStep := false.
myBitBlt := BitBltSimulator new setInterpreter: self.
displayForm := 'Display has not yet been installed' asDisplayText form.
eventQueue := SharedQueue new.
suppressHeartbeatFlag := false.
systemAttributes := Dictionary new.
extSemTabSize := 256.
+ disableBooleanCheat := false.
+ assertVEPAES := true. "a flag so the assertValidExecutionPointers in run can be turned off for simulation speed"!
- disableBooleanCheat := false!
Item was changed:
----- Method: StackInterpreterSimulator>>ioRelinquishProcessorForMicroseconds: (in category 'I/O primitive support') -----
ioRelinquishProcessorForMicroseconds: microseconds
"In the simulator give an indication that we're idling and check for input."
Display reverse: (0 at 0 extent: 16 at 16).
Sensor peekEvent ifNotNil:
[self forceInterruptCheck].
Processor activeProcess == Project uiProcess ifTrue:
[World doOneCycle].
microseconds >= 1000
ifTrue: [(Delay forMilliseconds: microseconds + 999 // 1000) wait]
+ ifFalse: [Processor yield].
+ "And increase the byteCount form which the microsecond clock is derived..."
+ byteCount := byteCount + microseconds - 1.
+ self incrementByteCount!
- ifFalse: [Processor yield]!
Item was removed:
- ----- Method: StackInterpreterSimulator>>primitiveScreenSize (in category 'I/O primitives') -----
- primitiveScreenSize
- | size |
- size := self desiredDisplayExtent min: 800 at 640.
- self pop: 1 thenPush: (self makePointwithxValue: size x yValue: size y)!
Item was changed:
----- Method: StackInterpreterSimulator>>run (in category 'testing') -----
run
"Just run"
quitBlock := [displayView ifNotNil:
[displayView containingWindow ifNotNil:
[:topWindow|
((World submorphs includes: topWindow)
and: [UIManager default confirm: 'close?']) ifTrue:
[topWindow delete]]].
^self].
self initStackPages.
self loadInitialContext.
self internalizeIPandSP.
self fetchNextBytecode.
[true] whileTrue:
+ [assertVEPAES ifTrue: [self assertValidExecutionPointers].
- [self assertValidExecutionPointers.
atEachStepBlock value. "N.B. may be nil"
self dispatchOn: currentBytecode in: BytecodeTable.
self incrementByteCount].
localIP := localIP - 1.
"undo the pre-increment of IP before returning"
self externalizeIPandSP!
Item was changed:
----- Method: StackInterpreterSimulator>>utilitiesMenu: (in category 'UI') -----
utilitiesMenu: aMenuMorph
aMenuMorph
add: 'toggle transcript' action: #toggleTranscript;
add: 'clone VM' action: #cloneSimulation;
addLine;
add: 'print ext head frame' action: #printExternalHeadFrame;
add: 'print int head frame' action: #printHeadFrame;
add: 'short print ext frame & callers' action: [self shortPrintFrameAndCallers: framePointer];
add: 'short print int frame & callers' action: [self shortPrintFrameAndCallers: localFP];
add: 'long print ext frame & callers' action: [self printFrameAndCallers: framePointer SP: stackPointer];
add: 'long print int frame & callers' action: [self printFrameAndCallers: localFP SP: localSP];
add: 'print frame...' action: [(self promptHex: 'print frame') ifNotNil: [:fp| self printFrame: fp]];
add: 'print call stack' action: #printCallStack;
add: 'print stack call stack' action: #printStackCallStack;
add: 'print call stack of...' action: [(self promptHex: 'context or process oop') ifNotNil: [:obj| self printCallStackOf: obj]];
add: 'print call stack of frame...' action: [(self promptHex: 'frame') ifNotNil: [:fp| self printCallStackFP: fp]];
add: 'print all stacks' action: #printAllStacks;
add: 'write back local ptrs' action: [stackPointer := localSP. framePointer := localFP. instructionPointer := localIP.
self writeBackHeadFramePointers];
add: 'print prim trace log' action: #dumpPrimTraceLog;
addLine;
add: 'print oop...' action: [(self promptHex: 'print oop') ifNotNil: [:oop| self printOop: oop]];
add: 'long print oop...' action: [(self promptHex: 'print oop') ifNotNil: [:oop| self longPrintOop: oop]];
addLine;
add: 'inspect object memory' target: objectMemory action: #inspect;
add: 'inspect interpreter' action: #inspect;
addLine;
add: 'set break count...' action: [|s| s := UIManager default request: 'break count (dec)'.
s notEmpty ifTrue: [breakCount := Integer readFrom: s readStream]];
add: 'set break selector...' action: [|s| s := UIManager default request: 'break selector'.
s notEmpty ifTrue: [self setBreakSelector: s]];
+ add: 'turn valid exec ptrs assert o', (assertVEPAES ifTrue: ['ff'] ifFalse: ['n']) action: [assertVEPAES := assertVEPAES not];
add: (printSends
ifTrue: ['no print sends']
ifFalse: ['print sends'])
action: [self ensureDebugAtEachStepBlock.
printSends := printSends not];
"currently printReturns does nothing"
"add: (printReturns
ifTrue: ['no print returns']
ifFalse: ['print returns'])
action: [self ensureDebugAtEachStepBlock.
printReturns := printReturns not];"
add: (printBytecodeAtEachStep
ifTrue: ['no print bytecode each bytecode']
ifFalse: ['print bytecode each bytecode'])
action: [self ensureDebugAtEachStepBlock.
printBytecodeAtEachStep := printBytecodeAtEachStep not];
add: (printFrameAtEachStep
ifTrue: ['no print frame each bytecode']
ifFalse: ['print frame each bytecode'])
action: [self ensureDebugAtEachStepBlock.
printFrameAtEachStep := printFrameAtEachStep not].
^aMenuMorph!
More information about the Vm-dev
mailing list