[Vm-dev] VM Maker: VMMaker.oscog-eem.2316.mcz
commits at source.squeak.org
commits at source.squeak.org
Tue Jan 16 00:14:57 UTC 2018
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.2316.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.2316
Author: eem
Time: 15 January 2018, 4:14:43.133915 pm
UUID: b5317016-c2af-4ae7-a955-972b82812610
Ancestors: VMMaker.oscog-eem.2315
Interpreter: Fix bad bug in reverseDisplayFrom:to: feedback from the leak checker. The displayBits are not uopdated soon enough after a compaction and objects may be overwritten. So refactor postGCAction: to extract postGCUpdateDisplayBits which is also used by reverseDisplayFrom:to: to obtain up-to-date bits.
Interpreter Simulator:
Fix snapshot write with a 64-bit memory.
Make the globalSessionID (& thisSessionID in InterpreterProxy) a 32-bit quantity always. Thse were using SmallInteger>>maxVal with the assumption that SmallIntegers are less than 32-bits.
Rewrite primitiveDeferDisplayUpdates to invoke indirectly ioForceDisplayUpdate, and implement ioForceDisplayUpdate to allow the display to refresh, hence curing the lack of display update in the StackInterpreter simulator, and allowing the removal of CogVMSimulator>>primitiveDeferDisplayUpdates.
Spur Simulator:
Speed up the leak checker by about a factor of two by removing the bounds checking versions of fetchPointer:ofObject: in the simulator subclasses for the duration, and by using bitShift: instead of << in addressAfter:
Socket Plugin SImulator:
Maintain the resolver's status correctly, instead of the broken deferal to the host's NetNameResolver. This way the simulated image actually initializes itself.
SecurityPlugin simulator:
Answer true to ioCanRenameImage
=============== Diff against VMMaker.oscog-eem.2315 ===============
Item was changed:
----- Method: CogVMSimulator>>ioLoadFunction:From: (in category 'plugin support') -----
ioLoadFunction: functionString From: pluginString
"Load and return the requested function from a module"
| firstTime plugin fnSymbol |
firstTime := false.
fnSymbol := functionString asSymbol.
transcript
cr;
show: '(', byteCount printString, ') Looking for ', functionString, ' in ',
(pluginString isEmpty ifTrue:['vm'] ifFalse:[pluginString]).
+ (breakSelector notNil
+ and: [(self str: pluginString n: breakSelector cmp: pluginString size) = 0
+ or: [(self str: functionString n: breakSelector cmp: functionString size) = 0]]) ifTrue:
+ [self halt: functionString].
- functionString = breakSelector ifTrue: [self halt: breakSelector].
plugin := pluginList
detect:[:any| any key = pluginString asString]
ifNone:
[firstTime := true.
self loadNewPlugin: pluginString].
plugin ifNil:
[firstTime ifTrue: [transcript cr; show: 'Failed ... primitive not in plugin'].
^0].
plugin := plugin value.
mappedPluginEntries doWithIndex:
[:pluginAndName :index|
((pluginAndName at: 1) == plugin
and:[(pluginAndName at: 2) == fnSymbol]) ifTrue:
[^index]].
(plugin respondsTo: fnSymbol) ifFalse:
[firstTime ifTrue: [transcript cr; show: 'Failed ... primitive not in plugin'].
^0].
mappedPluginEntries addLast: (Array
with: plugin
with: fnSymbol
with: [plugin perform: fnSymbol. self]).
"Transcript show: ' ... okay'."
transcript cr.
^ mappedPluginEntries size!
Item was changed:
----- Method: CogVMSimulator>>ioLoadFunction:From:AccessorDepthInto: (in category 'plugin support') -----
ioLoadFunction: functionString From: pluginString AccessorDepthInto: accessorDepthPtr
"Load and return the requested function from a module.
Assign the accessor depth through accessorDepthPtr.
N.B. The actual code lives in platforms/Cross/vm/sqNamedPrims.h"
| firstTime plugin fnSymbol |
firstTime := false.
fnSymbol := functionString asSymbol.
transcript
cr;
show: '(', byteCount printString, ') Looking for ', functionString, ' in ',
(pluginString isEmpty ifTrue:['vm'] ifFalse:[pluginString]).
(breakSelector notNil
+ and: [(self str: pluginString n: breakSelector cmp: pluginString size) = 0
+ or: [(self str: functionString n: breakSelector cmp: functionString size) = 0]]) ifTrue:
- and: [(self str: functionString n: breakSelector cmp: functionString size) = 0]) ifTrue:
[self halt: functionString].
plugin := pluginList
detect: [:any| any key = pluginString asString]
ifNone:
[firstTime := true.
self loadNewPlugin: pluginString].
plugin ifNil:
[firstTime ifTrue: [transcript cr; show: 'Failed ... primitive not in plugin'].
^0].
plugin := plugin value.
mappedPluginEntries doWithIndex:
[:pluginAndName :index|
((pluginAndName at: 1) == plugin
and:[(pluginAndName at: 2) == fnSymbol]) ifTrue:
[firstTime ifTrue: [transcript show: ' ... okay'; cr].
accessorDepthPtr at: 0 put: (pluginAndName at: 4).
^index]].
firstTime ifTrue: [transcript cr; show: 'Failed ... primitive not in plugin'].
transcript cr.
^0!
Item was removed:
- ----- Method: CogVMSimulator>>primitiveDeferDisplayUpdates (in category 'I/O primitives') -----
- primitiveDeferDisplayUpdates
- | oldDeferDisplayUpdates |
- oldDeferDisplayUpdates := deferDisplayUpdates.
- super primitiveDeferDisplayUpdates.
- oldDeferDisplayUpdates ~= deferDisplayUpdates ifTrue:
- [self fullDisplayUpdate]!
Item was changed:
----- Method: InterpreterProxy>>getThisSessionID (in category 'other') -----
getThisSessionID
"Answer a session identifier which represents the current instance of Squeak.
The identifier is expected to be unique among all instances of Squeak on a
network at any point in time."
[thisSessionID = 0]
whileTrue:
+ [thisSessionID := (Random new next * (SmallInteger maxVal min: 16rFFFFFFFF)) asInteger].
+ ^ thisSessionID!
- [thisSessionID := (Random new next * SmallInteger maxVal) asInteger].
- ^ thisSessionID
- !
Item was added:
+ ----- Method: SecurityPlugin>>ioCanRenameImage (in category 'simulation') -----
+ ioCanRenameImage
+ <doNotGenerate>
+ ^true!
Item was changed:
SocketPlugin subclass: #SocketPluginSimulator
+ instanceVariableNames: 'openSocketHandles externalSemaphores hostSocketToSimSocketMap simSocketToHostSocketMap fakeAddressCounter resolverSemaphoreIndex ipv6support resolverStatus'
+ classVariableNames: 'ResolverBusy ResolverError ResolverReady ResolverUninitialized'
- instanceVariableNames: 'openSocketHandles externalSemaphores hostSocketToSimSocketMap simSocketToHostSocketMap fakeAddressCounter resolverSemaphoreIndex ipv6support'
- classVariableNames: ''
poolDictionaries: ''
category: 'VMMaker-InterpreterSimulation'!
Item was added:
+ ----- Method: SocketPluginSimulator class>>initialize (in category 'class initialization') -----
+ initialize
+ ResolverUninitialized := 0. "network is not initialized"
+ ResolverReady := 1. "resolver idle, last request succeeded"
+ ResolverBusy := 2. "lookup in progress"
+ ResolverError := 3. "resolver idle, last request failed"!
Item was changed:
----- Method: SocketPluginSimulator>>socketInit (in category 'initialize-release') -----
socketInit
openSocketHandles := Set new.
externalSemaphores := Set new.
hostSocketToSimSocketMap := Dictionary new.
simSocketToHostSocketMap := Dictionary new.
fakeAddressCounter := 16r50C4E70. "Socket, if you squint at it right..."
"Set all the security functions to zero so simulation does't need to work fully."
sDSAfn := sHSAfn := sCCTPfn := sCCLOPfn := sCCSOTfn := 0.
"for now..."
ipv6support := false.
+ resolverStatus := ResolverUninitialized.
^true!
Item was changed:
----- Method: SocketPluginSimulator>>sqNetworkInit: (in category 'simulation') -----
sqNetworkInit: resolverSemaIndex
"Simply assume the network is initialized."
(NetNameResolver classPool at: #HaveNetwork) ifFalse:
[NetNameResolver initializeNetwork].
resolverSemaphoreIndex
ifNil: [resolverSemaphoreIndex := resolverSemaIndex]
ifNotNil: [self assert: resolverSemaphoreIndex = resolverSemaIndex].
+ resolverStatus := ResolverReady.
^0!
Item was changed:
----- Method: SocketPluginSimulator>>sqResolverStartName:Lookup: (in category 'simulation') -----
sqResolverStartName: aCArray Lookup: size
"For now don't simulate the implicit semaphore."
+ | hostName |
- | hostName busy |
- busy := NetNameResolver classPool at: #ResolverBusy.
hostName := self st: (String new: size) rn: aCArray cpy: size.
NetNameResolver primStartLookupOfName: hostName.
resolverSemaphoreIndex ifNotNil:
+ [| status |
+ resolverStatus := ResolverBusy.
+ [[(status := NetNameResolver primNameResolverStatus) = resolverStatus] whileTrue:
- [[[NetNameResolver primNameResolverStatus = busy] whileTrue:
[(Delay forSeconds: 1) wait].
+ resolverStatus := status.
+ interpreterProxy signalSemaphoreWithIndex: resolverSemaphoreIndex] fork]!
- interpreterProxy signalSemaphoreWithIndex: resolverSemaphoreIndex] fork]
- !
Item was changed:
----- Method: SocketPluginSimulator>>sqResolverStatus (in category 'simulation') -----
sqResolverStatus
+ ^resolverStatus!
- ^NetNameResolver primNameResolverStatus!
Item was added:
+ ----- Method: SocketPluginSimulator>>sqSocketAbortConnection: (in category 'simulation') -----
+ sqSocketAbortConnection: socketHandleCArray
+ ^[Socket basicNew
+ primSocketAbortConnection: ((self hostSocketHandleFromSimSocketHandle: socketHandleCArray) ifNil: [^false])]
+ on: SocketPrimitiveFailed
+ do: [:ex|
+ interpreterProxy primitiveFail.
+ false]!
Item was added:
+ ----- Method: SocketPluginSimulator>>sqSocketCloseConnection: (in category 'simulation') -----
+ sqSocketCloseConnection: socketHandleCArray
+ ^[Socket basicNew
+ primSocketCloseConnection: ((self hostSocketHandleFromSimSocketHandle: socketHandleCArray) ifNil: [^false])]
+ on: SocketPrimitiveFailed
+ do: [:ex|
+ interpreterProxy primitiveFail.
+ false]!
Item was added:
+ ----- Method: Spur32BitMMLESimulator>>checkHeapIntegrity:classIndicesShouldBeValid: (in category 'debug support') -----
+ checkHeapIntegrity: excludeUnmarkedObjs classIndicesShouldBeValid: classIndicesShouldBeValid
+ "Almost all of the time spent in SourMemoryManager>>checkHeapIntegrity:classIndicesShouldBeValid: used to go into the asserts in fetchPointer:ofObject: in the simulator class overrides.
+ Since we know here the indices used are valid we temporarily remove them to claw back that poerformance."
+ ^self withSimulatorFetchPointerMovedAsideDo:
+ [super checkHeapIntegrity: excludeUnmarkedObjs classIndicesShouldBeValid: classIndicesShouldBeValid]!
Item was changed:
----- Method: Spur32BitMemoryManager>>addressAfter: (in category 'object enumeration') -----
addressAfter: objOop
"Answer the address immediately following an object."
<returnTypeC: #usqInt>
| numSlots |
numSlots := self rawNumSlotsOf: objOop.
numSlots = 0 ifTrue: [^objOop + self allocationUnit + self baseHeaderSize].
numSlots = self numSlotsMask ifTrue:
[numSlots := self rawOverflowSlotsOf: objOop].
+ ^objOop + self baseHeaderSize + (numSlots + (numSlots bitAnd: 1) bitShift: self shiftForWord)!
- ^objOop + self baseHeaderSize + (numSlots + (numSlots bitAnd: 1) << self shiftForWord)!
Item was added:
+ ----- Method: Spur64BitMMLECoSimulator>>checkHeapIntegrity:classIndicesShouldBeValid: (in category 'debug support') -----
+ checkHeapIntegrity: excludeUnmarkedObjs classIndicesShouldBeValid: classIndicesShouldBeValid
+ "Almost all of the time spent in SourMemoryManager>>checkHeapIntegrity:classIndicesShouldBeValid: used to go into the asserts in fetchPointer:ofObject: in the simulator class overrides.
+ Since we know here the indices used are valid we temporarily remove them to claw back that poerformance."
+ ^self withSimulatorFetchPointerMovedAsideDo:
+ [super checkHeapIntegrity: excludeUnmarkedObjs classIndicesShouldBeValid: classIndicesShouldBeValid]!
Item was added:
+ ----- Method: Spur64BitMMLESimulator>>checkHeapIntegrity:classIndicesShouldBeValid: (in category 'debug support') -----
+ checkHeapIntegrity: excludeUnmarkedObjs classIndicesShouldBeValid: classIndicesShouldBeValid
+ "Almost all of the time spent in SourMemoryManager>>checkHeapIntegrity:classIndicesShouldBeValid: used to go into the asserts in fetchPointer:ofObject: in the simulator class overrides.
+ Since we know here the indices used are valid we temporarily remove them to claw back that poerformance."
+ ^self withSimulatorFetchPointerMovedAsideDo:
+ [super checkHeapIntegrity: excludeUnmarkedObjs classIndicesShouldBeValid: classIndicesShouldBeValid]!
Item was changed:
----- Method: Spur64BitMemoryManager>>addressAfter: (in category 'object enumeration') -----
addressAfter: objOop
"Answer the address immediately following an object."
<returnTypeC: #usqInt>
| numSlots |
numSlots := self rawNumSlotsOf: objOop.
numSlots = 0 ifTrue: [^objOop + self allocationUnit + self baseHeaderSize].
numSlots = self numSlotsMask ifTrue:
[numSlots := self rawOverflowSlotsOf: objOop].
+ ^objOop + self baseHeaderSize + (numSlots bitShift: self shiftForWord)!
- ^objOop + self baseHeaderSize + (numSlots << self shiftForWord)!
Item was changed:
----- Method: SpurMemoryManager>>checkHeapIntegrity:classIndicesShouldBeValid: (in category 'debug support') -----
checkHeapIntegrity: excludeUnmarkedObjs classIndicesShouldBeValid: classIndicesShouldBeValid
"Perform an integrity/leak check using the heapMap. Assume clearLeakMapAndMapAccessibleObjects
has set a bit at each (non-free) object's header. Scan all objects in the heap checking that every
pointer points to a header. Scan the rememberedSet, remapBuffer and extraRootTable checking
that every entry is a pointer to a header. Check that the number of roots is correct and that all
rememberedSet entries have their isRemembered: flag set. Answer if all checks pass."
| ok numRememberedObjectsInHeap |
<inline: false>
+ self cCode: []
+ inSmalltalk:
+ ["Almost all of the time spent here used to go into the asserts in fetchPointer:ofObject: in the
+ simulator class overrides. Since we know here the indices used are valid we temporarily
+ remove them to claw back that performance."
+ (self class whichClassIncludesSelector: #fetchPointer:ofObject:) ~= SpurMemoryManager ifTrue:
+ [^self withSimulatorFetchPointerMovedAsideDo:
+ [self checkHeapIntegrity: excludeUnmarkedObjs
+ classIndicesShouldBeValid: classIndicesShouldBeValid]]].
ok := true.
numRememberedObjectsInHeap := 0.
0 to: self numFreeLists - 1 do:
[:i|
(freeLists at: i) ~= 0 ifTrue:
[(heapMap heapMapAtWord: (self pointerForOop: (freeLists at: i))) ~= 0 ifTrue:
[coInterpreter print: 'leak in free list '; printNum: i; print: ' to non-free '; printHex: (freeLists at: i); cr.
self eek.
ok := false]]].
"Excuse the duplication but performance is at a premium and we avoid
some tests by splitting the newSpace and oldSpace enumerations."
self allNewSpaceEntitiesDo:
[:obj| | fieldOop classIndex classOop |
(self isFreeObject: obj)
ifTrue:
[coInterpreter print: 'young object '; printHex: obj; print: ' is free'; cr.
self eek.
ok := false]
ifFalse:
[((self isMarked: obj) not and: [excludeUnmarkedObjs]) ifFalse:
[(self isRemembered: obj) ifTrue:
[coInterpreter print: 'young object '; printHex: obj; print: ' is remembered'; 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]]
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].
0 to: (self numPointerSlotsOf: obj) - 1 do:
[:fi|
fieldOop := self fetchPointer: fi ofObject: obj.
(self isNonImmediate: fieldOop) ifTrue:
[(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]]]]]].
self allOldSpaceEntitiesDo:
[:obj| | containsYoung fieldOop classIndex classOop |
(self isFreeObject: obj)
ifTrue:
[(heapMap heapMapAtWord: (self pointerForOop: obj)) ~= 0 ifTrue:
[coInterpreter print: 'leak in free chunk '; printHex: obj; print: ' is mapped?!! '; cr.
self eek.
ok := false].
fieldOop := self fetchPointer: self freeChunkNextIndex ofFreeChunk: obj.
(fieldOop ~= 0
and: [(heapMap heapMapAtWord: (self pointerForOop: obj)) ~= 0]) ifTrue:
[coInterpreter print: 'leak in free chunk '; printHex: obj; print: ' @ 0 = '; printHex: fieldOop; print: ' is mapped'; cr.
self eek.
ok := false].
(self isLargeFreeObject: obj) ifTrue:
[self freeChunkParentIndex to: self freeChunkLargerIndex do:
[:fi|
fieldOop := self fetchPointer: fi ofFreeChunk: obj.
(fieldOop ~= 0
and: [(heapMap heapMapAtWord: (self pointerForOop: obj)) ~= 0]) ifTrue:
[coInterpreter print: 'leak in free chunk '; printHex: obj; print: ' @ '; printNum: fi; print: ' = '; printHex: fieldOop; print: ' is mapped'; cr.
self eek.
ok := false].]]]
ifFalse:
[(excludeUnmarkedObjs and: [(self isMarked: obj)not]) ifTrue: [] ifFalse: [
containsYoung := false.
(self isRemembered: obj) ifTrue:
[numRememberedObjectsInHeap := numRememberedObjectsInHeap + 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 isReallyYoung: fieldOop) ifTrue:
[containsYoung := true]]
ifFalse:
[classOop := self classOrNilAtIndex: (classIndex := self classIndexOf: obj).
(classIndicesShouldBeValid
and: [classOop = nilObj
and: [classIndex > self lastClassIndexPun]]) 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].
0 to: (self numPointerSlotsOf: obj) - 1 do:
[:fi|
fieldOop := self fetchPointer: fi ofObject: obj.
(self isNonImmediate: fieldOop) ifTrue:
[(self 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 isReallyYoung: fieldOop) ifTrue:
[containsYoung := true]]]].
containsYoung ifTrue:
[(self isRemembered: obj) ifFalse:
[coInterpreter print: 'unremembered object '; printHex: obj; print: ' contains young oop(s)'; cr.
self eek.
ok := false]]]]].
numRememberedObjectsInHeap ~= scavenger rememberedSetSize ifTrue:
[coInterpreter
print: 'root count mismatch. #heap roots ';
printNum: numRememberedObjectsInHeap;
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]]]].
self objStack: mournQueue do:
[:i :page| | obj |
obj := self fetchPointer: i ofObject: page.
(obj bitAnd: self wordSize - 1) ~= 0
ifTrue:
[coInterpreter print: 'misaligned oop in mournQueue @ '; printNum: i; print: ' in '; printHex: page; print: ' = '; printHex: obj; cr.
self eek.
ok := false]
ifFalse:
[(excludeUnmarkedObjs and: [(self isMarked: obj) not]) ifFalse:
[(heapMap heapMapAtWord: (self pointerForOop: obj)) = 0 ifTrue:
[coInterpreter print: 'object leak in mournQueue @ '; printNum: i; print: ' in '; printHex: page; 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>>withSimulatorFetchPointerMovedAsideDo: (in category 'debug support') -----
+ withSimulatorFetchPointerMovedAsideDo: aBlock
+ "For performance, remove the simulator implementation of fetchPointer:ofObject:
+ while aBlock is running and answer the block's result."
+ | theMethod |
+ theMethod := self class lookupSelector: #fetchPointer:ofObject:.
+ self deny: (theMethod isNil or: [theMethod methodClass == SpurMemoryManager]).
+ theMethod methodClass basicRemoveSelector: #fetchPointer:ofObject:.
+ ^aBlock ensure:
+ [theMethod methodClass
+ basicAddSelector: #fetchPointer:ofObject:
+ withMethod: theMethod]!
Item was changed:
----- Method: SpurSegmentManager>>writeSegment:nextSegment:toFile: (in category 'snapshot') -----
writeSegment: segment nextSegment: nextSegment toFile: aBinaryStream
"Write the segment contents, the size of and the distance to the next segment to aBinaryStream."
<var: 'segment' type: #'SpurSegmentInfo *'>
<var: 'nextSegment' type: #'SpurSegmentInfo *'>
<var: 'aBinaryStream' type: #sqImageFile>
| pier1 pier2 firstSavedBridgeWord secondSavedBridgeWord nWritten |
<var: 'firstSavedBridgeWord' type: #usqLong>
<var: 'secondSavedBridgeWord' type: #usqLong>
pier1 := segment segLimit - manager bridgeSize.
pier2 := pier1 + manager baseHeaderSize.
self assert: (self isValidSegmentBridge: (self bridgeFor: segment)).
self assert: (manager startOfObject: (self bridgeFor: segment)) = pier1.
"Temporarily change the bridge to bridge to the next non-empty segment.
The first double word of the bridge includes the bridge size in slots, and
hence specifies the distance to the next segment. The following double
word is replaced by the size of the next segment, or 0 if there isn't one."
firstSavedBridgeWord := manager long64At: pier1.
secondSavedBridgeWord := manager long64At: pier2.
self bridgeFrom: segment to: nextSegment.
manager
long64At: pier2
put: (nextSegment ifNil: [0] ifNotNil: [nextSegment segSize]).
nWritten := self cCode:
[self
sq: segment segStart asVoidPointer
Image: 1
File: segment segSize
Write: aBinaryStream]
inSmalltalk:
+ [| bytesPerElement |
+ bytesPerElement := manager memory bytesPerElement.
+ aBinaryStream
+ next: segment segSize / bytesPerElement
- [aBinaryStream
- next: segment segSize / 4
putAll: manager memory
+ startingAt: segment segStart / bytesPerElement + 1.
- startingAt: segment segStart / 4 + 1.
segment segSize].
manager
long64At: pier1 put: firstSavedBridgeWord;
long64At: pier2 put: secondSavedBridgeWord.
^nWritten!
Item was added:
+ ----- Method: StackInterpreter>>displayBits (in category 'simulation') -----
+ displayBits
+ <doNotGenerate>
+ ^displayBits!
Item was changed:
----- Method: StackInterpreter>>initializeInterpreter: (in category 'initialization') -----
initializeInterpreter: bytesToShift
"Initialize Interpreter state before starting execution of a new image."
interpreterProxy := self sqGetInterpreterProxy.
self dummyReferToProxy.
objectMemory initializeObjectMemory: bytesToShift.
self checkAssumedCompactClasses.
self initializeExtraClassInstVarIndices.
method := newMethod := objectMemory nilObject.
self cCode: '' inSmalltalk:
[breakSelectorLength ifNil:
[breakSelectorLength := objectMemory minSmallInteger]].
methodDictLinearSearchLimit := 8.
self initialCleanup.
LowcodeVM ifTrue: [ self setupNativeStack ].
profileSemaphore := profileProcess := profileMethod := objectMemory nilObject.
interruptKeycode := 2094. "cmd-. as used for Mac but no other OS"
[globalSessionID = 0] whileTrue:
[globalSessionID := self
cCode: [(self time: #NULL) + self ioMSecs]
+ inSmalltalk: [(Random new next * (SmallInteger maxVal min: 16rFFFFFFFF)) asInteger]].
- inSmalltalk: [(Random new next * SmallInteger maxVal) asInteger]].
metaAccessorDepth := -2.
super initializeInterpreter: bytesToShift!
Item was changed:
----- Method: StackInterpreter>>postGCAction: (in category 'object memory support') -----
postGCAction: gcModeArg
"Signal the gc semaphore, and inform the display subsystem if the display bitmap has moved."
self signalSemaphoreWithIndex: gcSemaphoreIndex.
+ self postGCUpdateDisplayBits!
- objectMemory hasSpurMemoryManagerAPI ifFalse:
- [| displayObj bitsOop bitsNow |
- displayObj := objectMemory splObj: TheDisplay.
- ((objectMemory isPointers: displayObj)
- and: [(objectMemory lengthOf: displayObj) >= 4
- and: [objectMemory isWordsOrBytes: (bitsOop := objectMemory fetchPointer: 0 ofObject: displayObj)]]) ifTrue:
- [bitsNow := self cCode: [objectMemory firstIndexableField: bitsOop]
- inSmalltalk: [(objectMemory firstIndexableField: bitsOop) asInteger].
- displayBits ~= bitsNow ifTrue:
- [displayBits := bitsNow.
- self ioNoteDisplayChanged: displayBits width: displayWidth height: displayHeight depth: displayDepth]]]!
Item was added:
+ ----- Method: StackInterpreter>>postGCUpdateDisplayBits (in category 'object memory support') -----
+ postGCUpdateDisplayBits
+ "Update the displayBits after a GC may have moved it.
+ Answer if the displayBits appear valid"
+ <inline: false>
+ | displayObj bitsOop bitsNow |
+ displayObj := objectMemory splObj: TheDisplay.
+ ((objectMemory isPointers: displayObj)
+ and: [(objectMemory lengthOf: displayObj) >= 4
+ and: [objectMemory isWordsOrBytes: (bitsOop := objectMemory fetchPointer: 0 ofObject: displayObj)]]) ifFalse:
+ [^false].
+
+ (objectMemory hasSpurMemoryManagerAPI
+ and: [objectMemory isPinned: bitsOop]) ifFalse:
+ [bitsNow := self cCode: [objectMemory firstIndexableField: bitsOop]
+ inSmalltalk: [(objectMemory firstIndexableField: bitsOop) asInteger].
+ displayBits ~= bitsNow ifTrue:
+ [displayBits := bitsNow.
+ self ioNoteDisplayChanged: displayBits width: displayWidth height: displayHeight depth: displayDepth]].
+ ^true!
Item was changed:
----- Method: StackInterpreter>>reverseDisplayFrom:to: (in category 'I/O primitive support') -----
reverseDisplayFrom: startIndex to: endIndex
"Reverse the given range of Display pixels, rounded to whole word boundary.
Used to give feedback during VM activities such as garbage collection when debugging.
It is assumed that the given word range falls entirely within the first line of the Display."
| wordStartIndex wordEndIndex primFailCodeValue |
+ self postGCUpdateDisplayBits ifFalse:
+ [^self].
(displayBits = 0 or: [(objectMemory isImmediate: displayBits asInteger) or: [displayDepth <= 0]]) ifTrue: [^nil].
wordStartIndex := (startIndex max: 0) * displayDepth // 32.
wordEndIndex := (endIndex min: displayWidth) * displayDepth // 32.
displayBits asInteger + (wordStartIndex * 4) to: displayBits asInteger + (wordEndIndex * 4) by: 4 do:
[:ptr | | reversed |
reversed := (objectMemory long32At: ptr) bitXor: 16rFFFFFFFF.
objectMemory long32At: ptr put: reversed].
primFailCodeValue := primFailCode.
self initPrimCall.
self updateDisplayLeft: 0 Top: 0 Right: displayWidth Bottom: 1.
self ioForceDisplayUpdate.
primFailCode := primFailCodeValue!
Item was changed:
----- Method: StackInterpreterPrimitives>>primitiveDeferDisplayUpdates (in category 'I/O primitives') -----
primitiveDeferDisplayUpdates
"Set or clear the flag that controls whether modifications of
+ the Display object are propagated to the underlying
+ platform's screen."
- the Display object are propagated to the underlying
- platform's screen."
| flag |
flag := self stackTop.
flag = objectMemory trueObject
ifTrue: [deferDisplayUpdates := true]
+ ifFalse:
+ [flag = objectMemory falseObject
- ifFalse: [flag = objectMemory falseObject
ifTrue: [deferDisplayUpdates := false]
+ ifFalse: [^self primitiveFail]].
+ self cCode: [] inSmalltalk: [self fullDisplayUpdate].
+ self pop: 1!
- ifFalse: [self primitiveFail]].
- self successful
- ifTrue: [self pop: 1]!
Item was changed:
----- Method: StackInterpreterSimulator>>ioForceDisplayUpdate (in category 'other primitives') -----
ioForceDisplayUpdate
+ "This assumes morphic"
+ World doOneCycle!
- "no-op"!
Item was changed:
----- Method: StackInterpreterSimulator>>printSends (in category 'debug printing') -----
printSends
+ ^printSends or: [printBytecodeAtEachStep]!
- ^printSends!
More information about the Vm-dev
mailing list