[Vm-dev] VM Maker: VMMaker.oscog-eem.1013.mcz
commits at source.squeak.org
commits at source.squeak.org
Fri Jan 9 19:59:36 UTC 2015
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.1013.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.1013
Author: eem
Time: 9 January 2015, 11:58:14.867 am
UUID: 04aee5a6-0821-468f-be83-9f4a10199c94
Ancestors: VMMaker.oscog-eem.1012
Spur: Get following of the saved and caller contexts
in base frames correct in followForwardingPointersInStackZone:
General:
Bow to the inevitable and add eassert: for those
expensive asserts you just can't let go of.
=============== Diff against VMMaker.oscog-eem.1012 ===============
Item was changed:
----- Method: CCodeGenerator>>isAssertSelector: (in category 'inlining') -----
isAssertSelector: selector
+ ^#(assert: asserta: assert:l: asserta:l: deny: eassert:) includes: selector!
- ^#(assert: asserta: assert:l: asserta:l: deny:) includes: selector!
Item was changed:
----- Method: CoInterpreter>>followForwardingPointersInStackZone: (in category 'object memory support') -----
followForwardingPointersInStackZone: theBecomeEffectsFlags
"Spur's become: is lazy, turning the becommed object into a forwarding object to the other.
The read-barrier is minimised by arranging that forwarding pointers will fail a method cache
probe, since notionally objects' internals are accessed only via sending messages to them,
the exception is primitives that access the internals of the non-receiver argument(s).
To avoid a read barrier on inst var fetch we scan the receivers in the stack zone and follow
any forwarded ones. This is way cheaper than scanning all of memory as in the old become."
| theIPPtr |
<inline: false>
<var: #thePage type: #'StackPage *'>
<var: #theSP type: #'char *'>
<var: #theFP type: #'char *'>
<var: #callerFP type: #'char *'>
<var: #theIPPtr type: #usqInt>
(theBecomeEffectsFlags anyMask: BecameCompiledMethodFlag) ifTrue:
[(objectMemory isForwarded: method) ifTrue:
[theIPPtr := instructionPointer - method.
method := objectMemory followForwarded: method.
instructionPointer := method + theIPPtr].
(objectMemory isForwarded: newMethod) ifTrue:
[newMethod := objectMemory followForwarded: newMethod]].
self assert: stackPage ~= 0.
0 to: numStackPages - 1 do:
[:i| | thePage theSP theFP callerFP oop offset |
thePage := stackPages stackPageAt: i.
thePage isFree ifFalse:
[theSP := thePage headSP.
theFP := thePage headFP.
"Skip the instruction pointer on top of stack of inactive pages."
thePage = stackPage
ifTrue: [theIPPtr := 0]
ifFalse:
[theIPPtr := theSP asUnsignedInteger.
theSP := theSP + objectMemory wordSize].
[self assert: (thePage addressIsInPage: theFP).
self assert: (theIPPtr = 0 or: [thePage addressIsInPage: theIPPtr asVoidPointer]).
offset := self frameStackedReceiverOffset: theFP.
oop := stackPages longAt: theFP + offset.
(objectMemory isOopForwarded: oop) ifTrue:
[stackPages
longAt: theFP + offset
put: (objectMemory followForwarded: oop)].
((self frameHasContext: theFP)
and: [(objectMemory isForwarded: (self frameContext: theFP))]) ifTrue:
[stackPages
longAt: theFP + FoxThisContext
put: (objectMemory followForwarded: (self frameContext: theFP))].
(self isMachineCodeFrame: theFP)
ifTrue:
[oop := stackPages longAt: theFP + FoxMFReceiver.
(objectMemory isOopForwarded: oop) ifTrue:
[stackPages
longAt: theFP + FoxMFReceiver
put: (objectMemory followForwarded: oop)].
oop := (self mframeHomeMethod: theFP) methodObject.
self assert: (objectMemory isForwarded: oop) not]
ifFalse:
[oop := stackPages longAt: theFP + FoxIFReceiver.
(objectMemory isOopForwarded: oop) ifTrue:
[stackPages
longAt: theFP + FoxIFReceiver
put: (objectMemory followForwarded: oop)].
oop := self iframeMethod: theFP.
(objectMemory isForwarded: oop) ifTrue:
[| newOop delta |
newOop := objectMemory followForwarded: oop.
delta := newOop - oop.
(theIPPtr ~= 0
and: [(stackPages longAt: theIPPtr) > oop]) ifTrue:
[stackPages
longAt: theIPPtr
put: (stackPages longAt: theIPPtr) + delta].
stackPages
longAt: theFP + FoxIFSavedIP
put: (stackPages longAt: theFP + FoxIFSavedIP) + delta.
stackPages
longAt: theFP + FoxMethod
put: (oop := newOop)]].
(callerFP := self frameCallerFP: theFP) ~= 0] whileTrue:
[theIPPtr := (theFP + FoxCallerSavedIP) asUnsignedInteger.
theFP := callerFP].
+ "And finally follow the saved context and the caller context."
+ theSP := thePage baseAddress - objectMemory wordSize.
- theSP := theFP + FoxCallerSavedIP + objectMemory wordSize.
[theSP <= thePage baseAddress] whileTrue:
[oop := stackPages longAt: theSP.
(objectMemory isForwarded: oop) ifTrue:
[stackPages longAt: theSP put: (objectMemory followForwarded: oop)].
theSP := theSP + objectMemory wordSize]]]!
Item was changed:
----- Method: Spur32BitMMLECoSimulator>>testObjStackDo (in category 'ad-hoc tests') -----
testObjStackDo
| size them seqA seqB seqC rs |
+ ExpensiveAsserts := true.
self initializeWeaklingStack; emptyObjStack: weaklingStack.
self assert: (self topOfObjStack: weaklingStack) isNil.
self assert: (self capacityOfObjStack: weaklingStack) >= ObjStackLimit.
seqA := (1 to: ObjStackLimit * 5 // 2) collect: [:i| self integerObjectOf: i].
seqA do: [:it| self noCheckPush: it onObjStack: weaklingStack].
them := Set new.
size := self objStack: weaklingStack from: 0 do: [:it| them add: it].
self assert: size = seqA size.
self assert: (them asSortedCollection asArray = seqA).
self assert: (self isValidObjStack: weaklingStack).
seqB := (ObjStackLimit * 5 // 2 + 1 to: ObjStackLimit * 10 // 2) collect: [:i| self integerObjectOf: i].
self assert: seqA size = seqB size.
rs := seqB readStream.
them := Set new.
size := self objStack: weaklingStack from: 0 do:
[:it|
them add: it.
self noCheckPush: rs next onObjStack: weaklingStack].
self assert: size = seqA size.
self assert: rs atEnd.
self objStack: weaklingStack from: size do:
[:it| them add: it].
seqC := (seqA, seqB) sort.
self assert: them asSortedCollection asArray = seqC!
Item was changed:
----- Method: Spur32BitMMLESimulator>>testObjStackDo (in category 'ad-hoc tests') -----
testObjStackDo
| size them seqA seqB seqC rs |
+ ExpensiveAsserts := true.
self initializeWeaklingStack; emptyObjStack: weaklingStack.
self assert: (self topOfObjStack: weaklingStack) isNil.
self assert: (self capacityOfObjStack: weaklingStack) >= ObjStackLimit.
seqA := (1 to: ObjStackLimit * 5 // 2) collect: [:i| self integerObjectOf: i].
seqA do: [:it| self noCheckPush: it onObjStack: weaklingStack].
them := Set new.
size := self objStack: weaklingStack from: 0 do: [:it| them add: it].
self assert: size = seqA size.
self assert: (them asSortedCollection asArray = seqA).
self assert: (self isValidObjStack: weaklingStack).
seqB := (ObjStackLimit * 5 // 2 + 1 to: ObjStackLimit * 10 // 2) collect: [:i| self integerObjectOf: i].
self assert: seqA size = seqB size.
rs := seqB readStream.
them := Set new.
size := self objStack: weaklingStack from: 0 do:
[:it|
them add: it.
self noCheckPush: rs next onObjStack: weaklingStack].
self assert: size = seqA size.
self assert: rs atEnd.
self objStack: weaklingStack from: size do:
[:it| them add: it].
seqC := (seqA, seqB) sort.
self assert: them asSortedCollection asArray = seqC!
Item was changed:
----- Method: SpurMemoryManager>>emptyObjStack: (in category 'obj stacks') -----
emptyObjStack: objStack
"Remove all the entries on the stack. Do so by setting Topx to 0
on the first page, and adding all subsequent pages to the free list."
| nextPage nextNextPage |
objStack = nilObj ifTrue:
[^self].
+ self eassert: (self isValidObjStack: objStack).
- self assert: (self isValidObjStack: objStack).
self storePointer: ObjStackTopx ofObjStack: objStack withValue: 0.
nextPage := self fetchPointer: ObjStackNextx ofObject: objStack.
[nextPage ~= 0] whileTrue:
[nextNextPage := self fetchPointer: ObjStackNextx ofObject: nextPage.
self storePointer: ObjStackFreex
ofObjStack: nextPage
withValue: (self fetchPointer: ObjStackFreex ofObject: objStack).
self storePointer: ObjStackNextx ofObjStack: nextPage withValue: 0.
self storePointer: ObjStackFreex ofObjStack: objStack withValue: nextPage.
nextPage := nextNextPage].
self storePointer: ObjStackNextx ofObjStack: objStack withValue: 0.
+ self eassert: (self isValidObjStack: objStack)!
- self assert: (self isValidObjStack: objStack)!
Item was changed:
----- Method: SpurMemoryManager>>isEmptyObjStack: (in category 'obj stacks') -----
isEmptyObjStack: objStack
objStack = nilObj ifTrue:
[^true].
+ self eassert: (self isValidObjStack: objStack).
- self assert: (self isValidObjStack: objStack).
^0 = (self fetchPointer: ObjStackTopx ofObject: objStack)
and: [0 = (self fetchPointer: ObjStackNextx ofObject: objStack)]!
Item was changed:
----- Method: SpurMemoryManager>>noCheckPush:onObjStack: (in category 'obj stacks') -----
noCheckPush: objOop onObjStack: objStack
"Push an element on an objStack. Split from push:onObjStack: for testing."
| topx |
+ self eassert: (self isValidObjStack: objStack).
- self assert: (self isValidObjStack: objStack).
self cCode: [] "for debugging markAndTrace: set (MarkStackRecord := OrderedCollection new)"
inSmalltalk:
[(self fetchPointer: ObjStackMyx ofObject: objStack) = MarkStackRootIndex ifTrue:
[MarkStackRecord ifNotNil: [MarkStackRecord addLast: {#push. objOop}]]].
topx := self fetchPointer: ObjStackTopx ofObject: objStack.
topx >= ObjStackLimit
ifTrue:
[self noCheckPush: objOop
onObjStack: (self ensureRoomOnObjStackAt: (self fetchPointer: ObjStackMyx ofObject: objStack))]
ifFalse:
[self storePointer: ObjStackFixedSlots + topx ofObjStack: objStack withValue: objOop.
self storePointer: ObjStackTopx ofObjStack: objStack withValue: topx + 1].
^objOop!
Item was changed:
----- Method: SpurMemoryManager>>objStack:from:do: (in category 'obj stacks') -----
objStack: objStack from: start do: aBlock
"Evaluate aBlock with all elements from start (0-relative) in objStack.
Answer the size of the stack *before* the enumeration commences.
This evaluates in top-of-stack-to-bottom order. N.B. this is also stable
if aBlock causes new elements to be added to the objStack, but
unstable if aBlock causes elements to be removed."
<inline: true>
| size objStackPage numToEnumerate |
+ self eassert: (self isValidObjStack: weaklingStack).
- self assert: (self isValidObjStack: weaklingStack).
size := self fetchPointer: ObjStackTopx ofObject: objStack.
objStackPage := self fetchPointer: ObjStackNextx ofObject: objStack.
[objStackPage ~= 0] whileTrue:
[size := size + ObjStackLimit.
self assert: (self fetchPointer: ObjStackTopx ofObject: objStackPage) = ObjStackLimit.
objStackPage := self fetchPointer: ObjStackNextx ofObject: objStackPage].
numToEnumerate := size - start.
objStackPage := objStack.
[numToEnumerate > 0] whileTrue:
[| numOnThisPage numToEnumerateOnThisPage topIndex |
numOnThisPage := self fetchPointer: ObjStackTopx ofObject: objStackPage.
numToEnumerateOnThisPage := numToEnumerate min: numOnThisPage.
topIndex := numOnThisPage + ObjStackFixedSlots - 1.
topIndex
to: topIndex - numToEnumerateOnThisPage + 1
by: -1
do: [:i|
self assert: (self isWeak: (self fetchPointer: i ofObject: objStackPage)).
aBlock value: (self fetchPointer: i ofObject: objStackPage)].
numToEnumerate := numToEnumerate - numToEnumerateOnThisPage.
objStackPage := self fetchPointer: ObjStackNextx ofObject: objStackPage].
^size!
Item was changed:
----- Method: SpurMemoryManager>>popObjStack: (in category 'obj stacks') -----
popObjStack: objStack
| topx top nextPage myx |
+ self eassert: (self isValidObjStack: objStack).
- self assert: (self isValidObjStack: objStack).
topx := self fetchPointer: ObjStackTopx ofObject: objStack.
topx = 0 ifTrue:
[self assert: (self fetchPointer: ObjStackNextx ofObject: objStack) = 0.
self cCode: [] "for debugging markAndTrace: set (MarkStackRecord := OrderedCollection new)"
inSmalltalk:
[(self fetchPointer: ObjStackMyx ofObject: objStack) = MarkStackRootIndex ifTrue:
[MarkStackRecord ifNotNil:
[MarkStackRecord addLast: {#EMPTY. nil}]]].
^nil].
topx := topx - 1.
top := self fetchPointer: topx + ObjStackFixedSlots ofObject: objStack.
self cCode: [] "for debugging markAndTrace: set (MarkStackRecord := OrderedCollection new)"
inSmalltalk:
[(self fetchPointer: ObjStackMyx ofObject: objStack) = MarkStackRootIndex ifTrue:
[MarkStackRecord ifNotNil:
[(MarkStackRecord last first = #push and: [MarkStackRecord last last = top])
ifTrue: [MarkStackRecord removeLast]
ifFalse: [MarkStackRecord addLast: {#pop. top}]]]].
self storePointer: ObjStackTopx ofObjStack: objStack withValue: topx.
(topx = 0
and: [(nextPage := self fetchPointer: ObjStackNextx ofObject: objStack) ~= 0])
ifTrue:
[self storePointer: ObjStackFreex ofObjStack: nextPage withValue: objStack.
self storePointer: ObjStackNextx ofObjStack: objStack withValue: 0.
myx := self fetchPointer: ObjStackMyx ofObject: objStack.
self updateRootOfObjStackAt: myx with: nextPage.
+ self eassert: (self isValidObjStack: nextPage)]
- self assert: (self isValidObjStack: nextPage)]
ifFalse:
+ [self eassert: (self isValidObjStack: objStack)].
- [self assert: (self isValidObjStack: objStack)].
^top!
Item was changed:
----- Method: StackInterpreter class>>mustBeGlobal: (in category 'translation') -----
mustBeGlobal: var
"Answer if a variable must be global and exported. Used for inst vars that are accessed from VM support code."
+ ^(super mustBeGlobal: var)
+ or: [(self objectMemoryClass mustBeGlobal: var)
- ^(self objectMemoryClass mustBeGlobal: var)
or: [(#('interpreterProxy' 'interpreterVersion' 'inIOProcessEvents'
'deferDisplayUpdates' 'extraVMMemory' 'showSurfaceFn'
'desiredNumStackPages' 'desiredEdenBytes'
'breakSelector' 'breakSelectorLength' 'sendTrace' 'checkAllocFiller'
'suppressHeartbeatFlag') includes: var)
or: [ "This allows slow machines to define bytecodeSetSelector as 0
to avoid the interpretation overhead."
+ MULTIPLEBYTECODESETS not and: [var = 'bytecodeSetSelector']]]]!
- MULTIPLEBYTECODESETS not and: [var = 'bytecodeSetSelector']]]!
Item was changed:
----- Method: StackInterpreter>>followForwardingPointersInStackZone: (in category 'object memory support') -----
followForwardingPointersInStackZone: theBecomeEffectsFlags
"Spur's become: is lazy, turning the becommed object into a forwarding object to the other.
The read-barrier is minimised by arranging that forwarding pointers will fail a method cache
probe, since notionally objects' internals are accessed only via sending messages to them,
the exception is primitives that access the internals of the non-receiver argument(s).
To avoid a read barrier on bytecode, literal and inst var fetch we scan the receivers and
methods in the stack zone and follow any forwarded ones. This is of course way cheaper
than scanning all of memory as in the old become."
| theIPPtr |
<inline: false>
<var: #thePage type: #'StackPage *'>
<var: #theSP type: #'char *'>
<var: #theFP type: #'char *'>
<var: #callerFP type: #'char *'>
<var: #theIPPtr type: #usqInt>
(theBecomeEffectsFlags anyMask: BecameCompiledMethodFlag) ifTrue:
[(objectMemory isForwarded: method) ifTrue:
[theIPPtr := instructionPointer - method.
method := objectMemory followForwarded: method.
instructionPointer := method + theIPPtr].
(objectMemory isForwarded: newMethod) ifTrue:
[newMethod := objectMemory followForwarded: newMethod]].
self assert: stackPage ~= 0.
0 to: numStackPages - 1 do:
[:i| | thePage theSP theFP callerFP theIP oop |
thePage := stackPages stackPageAt: i.
thePage isFree ifFalse:
[theSP := thePage headSP.
theFP := thePage headFP.
"Skip the instruction pointer on top of stack of inactive pages."
thePage = stackPage
ifTrue: [theIPPtr := 0]
ifFalse:
[theIPPtr := theSP asInteger.
theSP := theSP + objectMemory wordSize].
[self assert: (thePage addressIsInPage: theFP).
self assert: (theIPPtr = 0 or: [thePage addressIsInPage: theIPPtr asVoidPointer]).
oop := stackPages longAt: theFP + FoxReceiver.
(objectMemory isOopForwarded: oop) ifTrue:
[stackPages
longAt: theFP + FoxReceiver
put: (objectMemory followForwarded: oop)].
theIP := (theFP + (self frameStackedReceiverOffset: theFP)) asInteger. "reuse theIP; its just an offset here"
oop := stackPages longAt: theIP.
(objectMemory isOopForwarded: oop) ifTrue:
[stackPages
longAt: theIP
put: (objectMemory followForwarded: oop)].
((self frameHasContext: theFP)
and: [(objectMemory isForwarded: (self frameContext: theFP))]) ifTrue:
[stackPages
longAt: theFP + FoxThisContext
put: (objectMemory followForwarded: (self frameContext: theFP))].
oop := self frameMethod: theFP.
(objectMemory isForwarded: oop) ifTrue:
[| newOop delta |
newOop := objectMemory followForwarded: oop.
theIPPtr ~= 0 ifTrue:
[self assert: (stackPages longAt: theIPPtr) > (self frameMethod: theFP).
delta := newOop - oop.
stackPages
longAt: theIPPtr
put: (stackPages longAt: theIPPtr) + delta].
stackPages
longAt: theFP + FoxMethod
put: (oop := newOop)].
(callerFP := self frameCallerFP: theFP) ~= 0] whileTrue:
[theIPPtr := (theFP + FoxCallerSavedIP) asInteger.
theFP := callerFP].
+ "And finally follow the caller context."
+ self assert: theFP = thePage baseFP.
+ oop := self frameCallerContext: theFP.
+ (objectMemory isForwarded: oop) ifTrue:
+ [self frameCallerContext: theFP put: (objectMemory followForwarded: oop)]]]!
- theSP := theFP + FoxCallerContext. "a.k.a. FoxCallerSavedIP"
- [theSP <= thePage baseAddress] whileTrue:
- [oop := stackPages longAt: theSP.
- (objectMemory isForwarded: oop) ifTrue:
- [stackPages longAt: theSP put: (objectMemory followForwarded: oop)].
- theSP := theSP + objectMemory wordSize]]]!
Item was changed:
Object subclass: #VMClass
instanceVariableNames: ''
+ classVariableNames: 'DefaultBase ExpensiveAsserts'
- classVariableNames: 'DefaultBase'
poolDictionaries: 'VMBasicConstants VMObjectIndices'
category: 'VMMaker-Support'!
VMClass class
instanceVariableNames: 'timeStamp initializationOptions'!
!VMClass commentStamp: '<historical>' prior: 0!
I am an abstract superclass for all classes in the VM that want to maintain a source timeStamp.!
VMClass class
instanceVariableNames: 'timeStamp initializationOptions'!
Item was changed:
----- Method: VMClass class>>declareCVarsIn: (in category 'translation') -----
declareCVarsIn: aCCodeGenerator
+ "Declare any additional variables and/or add type declarations for existing variables."
+ aCCodeGenerator
+ var: #expensiveAsserts
+ declareC: 'char expensiveAsserts = 0'!
- "Declare any additional variables and/or add type declarations for existing variables."!
Item was changed:
----- Method: VMClass class>>initialize (in category 'initialization') -----
initialize
(Utilities classPool at: #CommonRequestStrings ifAbsent: []) ifNotNil:
[:commonRequestStringHolder|
(commonRequestStringHolder contents asString includesSubString: 'VMClass open') ifFalse:
+ [Utilities appendToCommonRequests: '-\VMMaker generateConfiguration\VMMaker generateAllConfigurationsUnderVersionControl\VMMaker generateAllSpurConfigurations\VMClass openCogMultiWindowBrowser\VMClass openObjectMemoriesInterpretersBrowser\VMClass openSpurMultiWindowBrowser' withCRs]].
+ ExpensiveAsserts := false!
- [Utilities appendToCommonRequests: '-\VMMaker generateConfiguration\VMMaker generateAllConfigurationsUnderVersionControl\VMMaker generateAllSpurConfigurations\VMClass openCogMultiWindowBrowser\VMClass openObjectMemoriesInterpretersBrowser\VMClass openSpurMultiWindowBrowser' withCRs]]!
Item was changed:
----- Method: VMClass class>>initializeWithOptions: (in category 'initialization') -----
initializeWithOptions: optionsDictionaryOrArray
"Initialize the receiver, typically initializing class variables. Initialize any class variables
whose names occur in optionsDictionary with the corresponding values there-in."
| optionsDictionary |
optionsDictionary := optionsDictionaryOrArray isArray
ifTrue: [Dictionary newFromPairs: optionsDictionaryOrArray]
ifFalse: [optionsDictionaryOrArray].
"This is necessary. e.g. if the receiver is CoInterpreterPrimitives,
it is still necessary to set the options in CoInterpreter. Otherwise,
some class in the chain may have stale options, and when building
the code generator, a stale ancilliary class may be computed."
(self withAllSuperclasses copyUpThrough: VMClass) do:
[:class|
+ class initializationOptions: optionsDictionary].
+
+ ExpensiveAsserts := optionsDictionary at: #ExpensiveAsserts ifAbsent: [false]!
- class initializationOptions: optionsDictionary]!
Item was added:
+ ----- Method: VMClass class>>mustBeGlobal: (in category 'translation') -----
+ mustBeGlobal: var
+ "Answer if a variable must be global and exported. Used for inst vars that are accessed from VM support code."
+
+ ^var = #expensiveAsserts!
Item was added:
+ ----- Method: VMClass>>eassert: (in category 'debug support') -----
+ eassert: aBooleanExpressionOrBlock
+ "This is for expensive asserts that we're only interested in checking in extremis.
+ For exampl,e now that Spur objStacks are debugged there's no benefit to evaluating
+ isValidObjStack: throguhout the mark loop because its damn slow."
+ <doNotGenerate>
+ ExpensiveAsserts ifTrue:
+ [aBooleanExpressionOrBlock value ifFalse:
+ [AssertionFailure signal: 'Assertion failed']]!
More information about the Vm-dev
mailing list