[Vm-dev] VM Maker: VMMaker.oscog-eem.586.mcz
commits at source.squeak.org
commits at source.squeak.org
Mon Jan 20 22:09:20 UTC 2014
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.586.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.586
Author: eem
Time: 20 January 2014, 2:05:39.966 pm
UUID: 2c68c161-bd12-4db4-b213-3643a7f7506a
Ancestors: VMMaker.oscog-eem.585
Spur (in simulating Newspeak bootstrap):
Fix GC of classes, piggy-backing on classTableBitmap. So rename
expungeDuplicateClasses to expungeDuplicateAndUnmarkedClasses:.
Add some asserts to check that entries in the classTable are classes.
Revise class table become management. Don't include methods in
"unforwarded zone". Hence add followObjField:ofObject: & fix bug
in fixFollowedField:ofObject:withInitialValue:.
Add a read barrier to fetching newMethod from a method dictionary.
Add a read barrier to fetching a method dictionary from a class.
Fix assert in addNewMethodToCache: to spot forwarded newMethod.
Make primitiveFileDelete simulate.
Copy Conterpreter's systemAttributes support to
StackInterpreterSimulator (so it can simulate the Newspeak bootstrap).
Don't inline any of the methods into fullGC.
Nuke unused ObjectMemory>>enterIntoClassTable:.
=============== Diff against VMMaker.oscog-eem.585 ===============
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]).
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:
+ [firstTime ifTrue: [transcript show: ' ... okay'; cr].
- [firstTime ifTrue: [transcript cr; show: ' ... okay'].
accessorDepthPtr at: 0 put: (pluginAndName at: 4).
^index]].
firstTime ifTrue: [transcript cr; show: 'Failed ... primitive not in plugin'].
^0!
Item was changed:
----- Method: FilePlugin>>primitiveFileDelete (in category 'file primitives') -----
primitiveFileDelete
| namePointer nameIndex nameSize okToDelete |
<var: 'nameIndex' type: 'char *'>
<export: true>
namePointer := interpreterProxy stackValue: 0.
(interpreterProxy isBytes: namePointer)
ifFalse: [^ interpreterProxy primitiveFail].
nameIndex := interpreterProxy firstIndexableField: namePointer.
nameSize := interpreterProxy byteSizeOf: namePointer.
"If the security plugin can be loaded, use it to check for permission.
If not, assume it's ok"
sCDFfn ~= 0
+ ifTrue: [okToDelete := self cCode: ' ((sqInt (*)(char *, sqInt))sCDFfn)(nameIndex, nameSize)' inSmalltalk: [true].
- ifTrue: [okToDelete := self cCode: ' ((sqInt (*)(char *, sqInt))sCDFfn)(nameIndex, nameSize)'.
okToDelete
ifFalse: [^ interpreterProxy primitiveFail]].
self
sqFileDeleteName: nameIndex
Size: nameSize.
interpreterProxy failed
ifFalse: [interpreterProxy pop: 1]!
Item was removed:
- ----- Method: ObjectMemory>>enterIntoClassTable: (in category 'forward compatibility') -----
- enterIntoClassTable: aBehavior
- "The old ObjectMemory should never be called upon to enter anything into the class table.
- Alas 0 is a valid identityhash in the Squeak V3 objrep so primitiveBehaviorHash may
- ask to enter into the table a class with a 0 id hash. SImply ignore the request."
- ^0!
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:
on:do: "from the debugger"
makeBaseFrameFor:
quickFetchInteger:ofObject:
frameOfMarriedContext:
objCouldBeClassObj:
isMarriedOrWidowedContext:
shortPrint:
bytecodePrimAt
bytecodePrimAtPut
commonAt:
commonAtPut:
loadFloatOrIntFrom:
positive32BitValueOf:
primitiveExternalCall
checkedIntegerValueOf:
bytecodePrimAtPut
commonAtPut:
primitiveVMParameter
checkIsStillMarriedContext:currentFP:
displayBitsOf:Left:Top:Right:Bottom:
fetchStackPointerOf:
primitiveContextAt
primitiveContextAtPut
subscript:with:storing:format:
printContext:
compare31or32Bits:equal:
signed64BitValueOf:
primDigitMultiply:negative:
digitLength:
isNegativeIntegerValueOf:
magnitude64BitValueOf:
primitiveMakePoint
primitiveAsCharacter
primitiveInputSemaphore
baseFrameReturn
primitiveExternalCall
primDigitCompare:
isLiveContext:
numPointerSlotsOf:
fileValueOf:
loadBitBltDestForm
fetchIntOrFloat:ofObject:ifNil:
fetchIntOrFloat:ofObject:
loadBitBltSourceForm
loadPoint:from:
primDigitAdd:
primDigitSubtract:
positive64BitValueOf:
digitBitLogic:with:opIndex:
signed32BitValueOf:
isNormalized:
primDigitDiv:negative:
bytesOrInt:growTo:
primitiveNewMethod
isCogMethodReference:
functionForPrimitiveExternalCall:
genSpecialSelectorArithmetic
genSpecialSelectorComparison
ensureContextHasBytecodePC:
instVar:ofContext:
ceBaseFrameReturn:
inlineCacheTagForInstance:
primitiveObjectAtPut
commonVariable:at:put:cacheIndex:
primDigitBitShiftMagnitude:
externalInstVar:ofContext:
primitiveGrowMemoryByAtLeast
primitiveFileSetPosition
+ bereaveAllMarriedContextsForSnapshotFlushingExternalPrimitivesIf:
+ shortPrintOop:) includes: sel) ifFalse:
- bereaveAllMarriedContextsForSnapshotFlushingExternalPrimitivesIf:) includes: sel) ifFalse:
[self halt].
^super isIntegerObject: oop!
Item was changed:
----- Method: SpurMemoryManager>>classAtIndex:put: (in category 'class table') -----
classAtIndex: classIndex put: objOop
"for become & GC of classes"
| classTablePage |
self assert: (classIndex <= self tagMask or: [classIndex >= self arrayClassIndexPun]).
+ self assert: (objOop = nilObj
+ or: [(self rawHashBitsOf: objOop) = classIndex
+ and: [coInterpreter objCouldBeClassObj: objOop]]).
- self assert: (objOop = nilObj or: [(self rawHashBitsOf: objOop) = classIndex]).
classTablePage := self fetchPointer: classIndex >> self classTableMajorIndexShift
ofObject: hiddenRootsObj.
classTablePage = nilObj ifTrue:
[self error: 'attempt to add class to empty page'].
^self
storePointer: (classIndex bitAnd: self classTableMinorIndexMask)
ofObject: classTablePage
withValue: objOop!
Item was changed:
----- Method: SpurMemoryManager>>classForClassTag: (in category 'interpreter access') -----
classForClassTag: classIndex
+ self assert: classIndex ~= self isForwardedObjectClassIndexPun.
^self classAtIndex: classIndex!
Item was changed:
----- Method: SpurMemoryManager>>compact (in category 'compaction') -----
compact
"We'd like to use exact fit followed by best fit, but best-fit is complex to implement
and potentially expensive. So just use exactFit followed, if necessary, by first-fit."
+ <inline: false>
self exactFitCompact.
highestObjects usedSize > 0 ifTrue:
[self firstFitCompact]!
Item was changed:
----- Method: SpurMemoryManager>>doBecome:and:copyHash: (in category 'become implementation') -----
doBecome: obj1 and: obj2 copyHash: copyHashFlag
"Inner dispatch for two-way become"
| o1ClassIndex o2ClassIndex |
copyHashFlag ifFalse:
["in-lined
+ classIndex := (self isInClassTable: obj) ifTrue: [self rawHashBitsOf: obj] ifFalse: [0]
- clasIndex := (self isInClassTable: obj) ifTrue: [self rawHashBitsOf: obj] ifFalse: [0]
for speed."
o1ClassIndex := self rawHashBitsOf: obj1.
(o1ClassIndex ~= 0 and: [(self classAtIndex: o1ClassIndex) ~= obj1]) ifTrue:
[o1ClassIndex := 0].
o2ClassIndex := self rawHashBitsOf: obj2.
(o2ClassIndex ~= 0 and: [(self classAtIndex: o2ClassIndex) ~= obj2]) ifTrue:
[o2ClassIndex := 0]].
(self numSlotsOf: obj1) = (self numSlotsOf: obj2)
ifTrue:
[self inPlaceBecome: obj1 and: obj2 copyHashFlag: copyHashFlag]
ifFalse:
[self outOfPlaceBecome: obj1 and: obj2 copyHashFlag: copyHashFlag].
"if copyHashFlag then nothing changes, since hashes were also swapped."
copyHashFlag ifTrue:
[^self].
"if copyHash is false then the classTable entries must be updated."
o1ClassIndex ~= 0
ifTrue:
[o2ClassIndex ~= 0
ifTrue: "both were in the table; just swap entries"
[| tmp |
tmp := self classAtIndex: o1ClassIndex.
self classAtIndex: o1ClassIndex put: obj2.
self classAtIndex: o2ClassIndex put: tmp]
ifFalse: "o2 wasn't in the table; put it there"
[| newObj2 |
newObj2 := self followForwarded: obj2.
self assert: (self rawHashBitsOf: newObj2) = 0.
self setHashBitsOf: newObj2 to: o1ClassIndex.
self classAtIndex: o1ClassIndex put: newObj2]]
ifFalse:
[o2ClassIndex ~= 0 ifTrue:
[| newObj1 |
newObj1 := self followForwarded: obj1.
self assert: (self rawHashBitsOf: newObj1) = 0.
self setHashBitsOf: newObj1 to: o2ClassIndex.
self classAtIndex: o2ClassIndex put: newObj1]]!
Item was added:
+ ----- Method: SpurMemoryManager>>expungeDuplicateAndUnmarkedClasses: (in category 'class table') -----
+ expungeDuplicateAndUnmarkedClasses: expungeUnmarked
+ "Bits have been set in the classTableBitmap corresponding to
+ used classes. Any class in the class table that does not have a
+ bit set has no instances with that class index. However, becomeForward:
+ can create duplicate entries, and these duplicate entries
+ a) won't have a bit set on load (because there are no forwarders on load),
+ b) wont match their identityHash.
+ So expunge duplicates by eliminating unmarked entries that don't occur at
+ their identityHash.
+ Further, any class in the table that is unmarked will also not have a bit set so
+ eliminate unmarked classes using the bitmap too."
+ 1 to: numClassTablePages - 1 do: "Avoid expunging the puns by not scanning the 0th page."
+ [:i| | classTablePage |
+ "optimize scan by only scanning bitmap in regions that have pages."
+ classTablePage := self fetchPointer: i ofObject: hiddenRootsObj.
+ classTablePage ~= nilObj ifTrue:
+ [i << self classTableMajorIndexShift
+ to: i << self classTableMajorIndexShift + self classTableMinorIndexMask
+ by: 8
+ do: [:majorBitIndex| | byteIndex byte classIndex classOrNil |
+ "optimize scan by scanning a byte of indices (8 indices) at a time"
+ byteIndex := majorBitIndex / BitsPerByte.
+ byte := classTableBitmap at: byteIndex.
+ byte ~= 255 ifTrue:
+ [0 to: 7 do:
+ [:minorBitIndex|
+ (byte noMask: 1 << minorBitIndex) ifTrue:
+ [classIndex := majorBitIndex + minorBitIndex.
+ classOrNil := self fetchPointer: (classIndex bitAnd: self classTableMinorIndexMask)
+ ofObject: classTablePage.
+ self assert: (self classAtIndex: classIndex) = classOrNil.
+ self assert: (classOrNil = nilObj or: [coInterpreter addressCouldBeClassObj: classOrNil]).
+ "only remove a class if it is at a duplicate entry or it is unmarked and we're expunging unmarked classes."
+ (classOrNil ~= nilObj
+ and: [(expungeUnmarked and: [(self isMarked: classOrNil) not])
+ or: [(self rawHashBitsOf: classOrNil) ~= classIndex]]) ifTrue:
+ [self storePointerUnchecked: (classIndex bitAnd: self classTableMinorIndexMask)
+ ofObject: classTablePage
+ withValue: nilObj.
+ "but if it is marked, it should still be in the table at its correct index."
+ self assert: ((expungeUnmarked and: [(self isMarked: classOrNil) not])
+ or: [(self classAtIndex: (self rawHashBitsOf: classOrNil)) = classOrNil]).
+ "If the removed class is before the classTableIndex, set the
+ classTableIndex to point to the empty slot so as to reuse it asap."
+ classIndex < classTableIndex ifTrue:
+ [classTableIndex := classIndex]]]]]]]]!
Item was removed:
- ----- Method: SpurMemoryManager>>expungeDuplicateClasses (in category 'class table') -----
- expungeDuplicateClasses
- "Bits have been set in the classTableBitmap corresponding to
- used classes. Any class in the class table that does not have a
- bit set has no instances with that class index. However, becomeForward:
- can create duplicate entries, and these duplicate entries
- a) won't have a bit set on load (because there are no forwarders on load),
- b) wont match their identityHash.
- So expunge duplicates by eliminating unmarked entries that don't occur at
- their identityHash."
- 1 to: numClassTablePages - 1 do:
- [:i| | classTablePage |
- "optimize scan by only scanning bitmap in regions that have pages."
- classTablePage := self fetchPointer: i ofObject: hiddenRootsObj.
- classTablePage ~= nilObj ifTrue:
- [i << self classTableMajorIndexShift
- to: i << self classTableMajorIndexShift + self classTableMinorIndexMask
- by: 8
- do: [:majorBitIndex| | byteIndex byte classIndex classOrNil |
- "optimize scan by scanning a byte of indices (8 indices) at a time"
- byteIndex := majorBitIndex / BitsPerByte.
- byte := classTableBitmap at: byteIndex.
- byte ~= 255 ifTrue:
- [0 to: 7 do:
- [:minorBitIndex|
- (byte noMask: 1 << minorBitIndex) ifTrue:
- [classIndex := majorBitIndex + minorBitIndex.
- classOrNil := self fetchPointer: (classIndex bitAnd: self classTableMinorIndexMask)
- ofObject: classTablePage.
- self assert: (self classAtIndex: classIndex) = classOrNil.
- "only remove a class if it is at a duplicate entry"
- (classOrNil ~= nilObj
- and: [(self rawHashBitsOf: classOrNil) ~= classIndex]) ifTrue:
- [self storePointerUnchecked: (classIndex bitAnd: self classTableMinorIndexMask)
- ofObject: classTablePage
- withValue: nilObj.
- "but it should still be in the table at its correct index."
- self assert: ((self classAtIndex: (self rawHashBitsOf: classOrNil)) = classOrNil)]]]]]]]!
Item was changed:
----- Method: SpurMemoryManager>>fixFollowedField:ofObject:withInitialValue: (in category 'forwarding') -----
fixFollowedField: fieldIndex ofObject: anObject withInitialValue: initialValue
"Private helper for followField:ofObject: to avoid code duplication for rare case."
<inline: false>
| objOop |
self assert: (self isOopForwarded: initialValue).
+ objOop := self followForwarded: initialValue.
- objOop := self followForwarded: objOop.
self storePointer: fieldIndex ofObject: anObject withValue: objOop.
^objOop!
Item was added:
+ ----- Method: SpurMemoryManager>>followObjField:ofObject: (in category 'forwarding') -----
+ followObjField: fieldIndex ofObject: anObject
+ "Make sure the obj at fieldIndex in anObject is not forwarded (follow the
+ forwarder there-in if so). Answer the (possibly followed) obj at fieldIndex."
+ | objOop |
+ objOop := self fetchPointer: fieldIndex ofObject: anObject.
+ self assert: (self isNonImmediate: objOop).
+ (self isForwarded: objOop) ifTrue:
+ [objOop := self fixFollowedField: fieldIndex ofObject: anObject withInitialValue: objOop].
+ ^objOop!
Item was changed:
----- Method: SpurMemoryManager>>freeUnmarkedObjectsAndSortAndCoalesceFreeSpace (in category 'gc - global') -----
freeUnmarkedObjectsAndSortAndCoalesceFreeSpace
"Sweep all of old space, freeing unmarked objects, coalescing free chunks, and sorting free space.
Small free chunks are sorted in address order on each small list head. Large free chunks
are sorted on the sortedFreeChunks list. Record as many of the highest objects as there
is room for in highestObjects, a circular buffer, for the use of exactFitCompact. Use
unused eden space for highestObjects. If highestObjects does not wrap, store 0
at highestObjects last. Record the lowest free object in firstFreeChunk. Let the
segmentManager mark which segments contain pinned objects via notePinned:."
| lastLargeFree lastHighest highestObjectsWraps sortedFreeChunks |
+ <inline: false>
<var: #lastHighest type: #usqInt>
self checkFreeSpace.
scavenger forgetUnmarkedRememberedObjects.
segmentManager prepareForGlobalSweep."for notePinned:"
"for sorting free space throw away the list heads, rebuilding them for small free chunks below."
self resetFreeListHeads.
highestObjects initializeStart: freeStart limit: scavenger eden limit.
lastHighest := highestObjects start - self wordSize. "a.k.a. freeStart - wordSize"
highestObjectsWraps := 0.
self assert: highestObjects limit - highestObjects start // self wordSize >= 1024.
firstFreeChunk := sortedFreeChunks := lastLargeFree := 0.
"Note that if we were truly striving for performance we could split the scan into
two phases, one up to the first free object and one after, which would remove
the need to test firstFreeChunk when filling highestObjects."
self allOldSpaceEntitiesForCoalescingDo:
[:o|
(self isMarked: o)
ifTrue: "forwarders should have been followed in markAndTrace:"
[self assert: (self isForwarded: o) not.
self setIsMarkedOf: o to: false. "this will unmark bridges. undo the damage in notePinned:"
(self isPinned: o) ifTrue:
[segmentManager notePinned: o].
firstFreeChunk ~= 0 ifTrue:
[false "conceptually...: "
ifTrue: [highestObjects addLast: o]
ifFalse: "but we inline so we can use the local lastHighest"
[(lastHighest := lastHighest + self wordSize) >= highestObjects limit ifTrue:
[highestObjectsWraps := highestObjectsWraps + 1.
lastHighest := highestObjects start].
self longAt: lastHighest put: o]]]
ifFalse: "unmarked; two cases, an unreachable object or a free chunk."
[| here limit next |
self assert: (self isRemembered: o) not. "scavenger should have cleared this above"
here := o.
limit := endOfMemory - self bridgeSize.
next := self objectAfter: here limit: limit.
[next = limit or: [self isMarked: next]] whileFalse: "coalescing; rare case"
[self assert: (self isRemembered: o) not.
statCoalesces := statCoalesces + 1.
here := self coalesce: here and: next.
next := self objectAfter: here limit: limit].
firstFreeChunk = 0 ifTrue:
[firstFreeChunk := here].
(self isLargeFreeObject: here)
ifTrue:
[self setFree: here.
lastLargeFree = 0
ifTrue: [sortedFreeChunks := lastLargeFree := here]
ifFalse:
[self storePointer: self freeChunkNextAddressIndex
ofFreeChunk: lastLargeFree
withValue: here].
lastLargeFree := here]
ifFalse:
[self freeSmallObject: here]]].
highestObjects last: lastHighest.
highestObjectsWraps ~= 0 ifTrue:
[highestObjects first: (lastHighest + self wordSize >= highestObjects limit
ifTrue: [highestObjects start]
ifFalse: [lastHighest + self wordSize])].
lastLargeFree ~= 0 ifTrue:
[self storePointer: self freeChunkNextAddressIndex ofFreeChunk: lastLargeFree withValue: 0].
totalFreeOldSpace := self reverseSmallListHeads.
totalFreeOldSpace := totalFreeOldSpace + (self rebuildFreeTreeFrom: sortedFreeChunks).
self checkFreeSpace.
self touch: highestObjectsWraps!
Item was changed:
----- Method: SpurMemoryManager>>markObjects (in category 'gc - global') -----
markObjects
+ <inline: false>
"Mark all accessible objects."
"If the incremental collector is running mark bits may be set; stop it and clear them if necessary."
self ensureAllMarkBitsAreZero.
self ensureAdequateClassTableBitmap.
self initializeUnscannedEphemerons.
self initializeMarkStack.
self initializeWeaklingStack.
self markAccessibleObjects.
+ self expungeDuplicateAndUnmarkedClasses: true!
- self expungeDuplicateClasses!
Item was changed:
----- Method: SpurMemoryManager>>postBecomeOrCompactScanClassTable: (in category 'become implementation') -----
postBecomeOrCompactScanClassTable: effectsFlags
"Scan the class table post-become (iff a pointer object or compiled method was becommed),
or post-compact.
Note that one-way become can cause duplications in the class table.
When can these be eliminated? We use the classTableBitmap to mark classTable entries
(not the classes themselves, since marking a class doesn't help in knowing if its index is used).
On image load, and during incrememtal scan-mark and full GC, classIndices are marked.
We can somehow avoid following classes from the classTable until after this mark phase."
self assert: self validClassTableRootPages.
+ (effectsFlags anyMask: BecamePointerObjectFlag"+BecameCompiledMethodFlag") ifFalse: [^self].
- (effectsFlags anyMask: BecamePointerObjectFlag+BecameCompiledMethodFlag) ifFalse: [^self].
0 to: numClassTablePages - 1 do:
[:i| | page |
page := self fetchPointer: i ofObject: hiddenRootsObj.
self assert: (self isForwarded: page) not.
0 to: (self numSlotsOf: page) - 1 do:
[:j| | classOrNil |
classOrNil := self fetchPointer: j ofObject: page.
classOrNil ~= nilObj ifTrue:
[(self isForwarded: classOrNil) ifTrue:
[classOrNil := self followForwarded: classOrNil.
self storePointer: j ofObject: page withValue: classOrNil].
self scanClassPostBecome: classOrNil effects: effectsFlags]]]!
Item was changed:
----- Method: SpurMemoryManager>>reInitializeClassTablePostLoad: (in category 'class table') -----
reInitializeClassTablePostLoad: hiddenRoots
self hiddenRootsObj: hiddenRoots.
+ self expungeDuplicateAndUnmarkedClasses: false!
- self expungeDuplicateClasses!
Item was changed:
----- Method: SpurMemoryManager>>scanClassPostBecome:effects: (in category 'become implementation') -----
scanClassPostBecome: startClassObj effects: becomeEffects
"Scan a class in the class table post-become. Make sure the superclass
chain contains no forwarding pointers, and that the method dictionaries
+ are not forwarded either. N.B. we don't follow methods or their
+ methodClassAssociations since we can't guarantee that forwarders
+ to compiled methods are not stored in method dictionaries via at:put:
+ and so have to cope with forwarding pointers to compiled methods
+ in method dictionaries anyway. Instead the [Co]Interpreter must
+ follow forwarders when fetching from method dictionaries and follow
+ forwarders on become in the method cache and method zone."
- are not forwarded either, and that methoidClassAssociations in methods
- are not followed either."
+ | classObj obj |
+ "Algorithm depends on this to terminate loop at root of superclass chain."
- | classObj obj obj2 |
- "Algorithm depend on this to terminate loop at root of superclass chain."
self assert: (self rawHashBitsOf: nilObj) ~= 0.
+ self assert: (becomeEffects anyMask: BecamePointerObjectFlag). "otherwise why bother?"
- self assert: (becomeEffects anyMask: BecamePointerObjectFlag+BecameCompiledMethodFlag). "otherwise why bother?"
classObj := startClassObj.
+ [obj := self followObjField: MethodDictionaryIndex ofObject: classObj.
+ "Solving the becommed method stored into a method dictionary object issue is
+ easy; just have a read barrier on fetching the method. But solving the read barrier
+ for selectors is more difficult (because selectors are currently not read, just their
+ oops. For now punt on the issue and simply follow all selectors on become"
+ self flag: 'need to fix the selector and methodDictionary issue'.
+ true
+ ifTrue: [self followForwardedObjectFields: obj toDepth: 0]
+ ifFalse: [self followObjField: MethodArrayIndex ofObject: obj].
+ obj := self followObjField: SuperclassIndex ofObject: classObj.
+ "If the superclass has an identityHash then either it is nil, or is in the class table.
+ Tail recurse."
+ (self rawHashBitsOf: obj) = 0] whileTrue:
- [obj := self fetchPointer: MethodDictionaryIndex ofObject: classObj.
- self assert: (self isNonImmediate: obj).
- (self isForwarded: obj) ifTrue:
- [obj := self followForwarded: obj.
- self storePointer: MethodDictionaryIndex ofObject: classObj withValue: obj].
- obj2 := self fetchPointer: MethodArrayIndex ofObject: obj.
- self assert: (self isNonImmediate: obj2).
- (self isForwarded: obj2) ifTrue:
- [obj2 := self followForwarded: obj2.
- self storePointer: MethodArrayIndex ofObject: obj withValue: obj2].
- "Only need to follow pointers in MethodArray if we've became any compiled methods..."
- (becomeEffects anyMask: BecameCompiledMethodFlag) ifTrue:
- [self followForwardedObjectFields: obj2 toDepth: 0].
- "But the methodClassAssociations there-in need to be followed if we've done any pointer becomes."
- (becomeEffects anyMask: BecamePointerObjectFlag) ifTrue:
- [0 to: (self numSlotsOf: obj2) - 1 do:
- [:i|
- obj := self fetchPointer: i ofObject: obj2.
- (self isOopCompiledMethod: obj2) ifTrue:
- [coInterpreter followNecessaryForwardingInMethod: obj2]]].
-
- obj := self fetchPointer: SuperclassIndex ofObject: classObj.
- self assert: (self isNonImmediate: obj).
- (self isForwarded: obj) ifTrue:
- [obj := self followForwarded: obj.
- self storePointer: SuperclassIndex ofObject: classObj withValue: obj].
-
- "If the superclass has an identityHash then either it is nil, or is in the class table.
- Tail recurse."
- (self rawHashBitsOf: obj) = 0] whileTrue:
["effectively self scanClassPostBecome: obj"
classObj := obj]!
Item was changed:
----- Method: StackInterpreter>>addNewMethodToCache: (in category 'method lookup cache') -----
addNewMethodToCache: classObj
"Add the given entry to the method cache.
The policy is as follows:
Look for an empty entry anywhere in the reprobe chain.
If found, install the new entry there.
If not found, then install the new entry at the first probe position
and delete the entries in the rest of the reprobe chain.
This has two useful purposes:
If there is active contention over the first slot, the second
or third will likely be free for reentry after ejection.
Also, flushing is good when reprobe chains are getting full."
| probe hash primitiveIndex |
<inline: false>
hash := messageSelector bitXor: (objectMemory classTagForClass: classObj). "drop low-order zeros from addresses (if classObj not classTag)"
(objectMemory isOopCompiledMethod: newMethod)
ifTrue:
[primitiveIndex := self primitiveIndexOf: newMethod.
primitiveFunctionPointer := self functionPointerFor: primitiveIndex inClass: classObj]
ifFalse:
+ [self assert: ((objectMemory isNonImmediate: newMethod)
+ and: [objectMemory isForwarded: newMethod]) not.
+ primitiveFunctionPointer := #primitiveInvokeObjectAsMethod].
- [primitiveFunctionPointer := #primitiveInvokeObjectAsMethod].
0 to: CacheProbeMax-1 do:
[:p | probe := (hash >> p) bitAnd: MethodCacheMask.
(methodCache at: probe + MethodCacheSelector) = 0 ifTrue:
["Found an empty entry -- use it"
methodCache at: probe + MethodCacheSelector put: messageSelector.
methodCache at: probe + MethodCacheClass put: (objectMemory classTagForClass: classObj).
methodCache at: probe + MethodCacheMethod put: newMethod.
methodCache at: probe + MethodCachePrimFunction put: (self cCoerce: primitiveFunctionPointer to: #long).
lastMethodCacheProbeWrite := probe. "this for primitiveExternalMethod"
^self]].
"OK, we failed to find an entry -- install at the first slot..."
probe := hash bitAnd: MethodCacheMask. "first probe"
methodCache at: probe + MethodCacheSelector put: messageSelector.
methodCache at: probe + MethodCacheClass put: (objectMemory classTagForClass: classObj).
methodCache at: probe + MethodCacheMethod put: newMethod.
methodCache at: probe + MethodCachePrimFunction put: (self cCoerce: primitiveFunctionPointer to: #long).
lastMethodCacheProbeWrite := probe. "this for primitiveExternalMethod"
"...and zap the following entries"
1 to: CacheProbeMax-1 do:
[:p | probe := (hash >> p) bitAnd: MethodCacheMask.
methodCache at: probe + MethodCacheSelector put: 0]!
Item was changed:
----- Method: StackInterpreter>>implicitReceiverFor:mixin:implementing: (in category 'newspeak bytecode support') -----
implicitReceiverFor: rcvr mixin: mixin implementing: selector
"This is used to implement the innards of the pushImplicitReceiverBytecode,
used for implicit receiver sends in NS2/NS3. Find the nearest lexically-enclosing
implementation of selector by searching up the static chain of anObject,
starting at mixin's application. This is an iterative implementation derived from
<ContextPart> implicitReceiverFor: obj <Object>
withMixin: mixin <Mixin>
implementing: selector <Symbol> ^<Object>"
<api>
<option: #NewspeakVM>
| mixinApplication dictionary found |
messageSelector := selector. "messageSelector is an implicit parameter of lookupMethodInDictionary:"
mixinApplication := self
findApplicationOfTargetMixin: mixin
startingAtBehavior: (objectMemory fetchClassOf: rcvr).
mixinApplication = objectMemory nilObject ifTrue:
[^rcvr].
+ dictionary := objectMemory followObjField: MethodDictionaryIndex ofObject: mixinApplication.
- dictionary := objectMemory fetchPointer: MethodDictionaryIndex ofObject: mixinApplication.
found := self lookupMethodInDictionary: dictionary.
found ifFalse:
[| implicitReceiverOrNil theMixin |
theMixin := objectMemory fetchPointer: MixinIndex ofObject: mixinApplication.
implicitReceiverOrNil := self nextImplicitReceiverFor: (objectMemory
fetchPointer: EnclosingObjectIndex
ofObject: mixinApplication)
withMixin: (objectMemory
fetchPointer: EnclosingMixinIndex
ofObject: theMixin).
implicitReceiverOrNil ~= objectMemory nilObject ifTrue:
[^implicitReceiverOrNil]].
^rcvr!
Item was changed:
----- Method: StackInterpreter>>lookupMethodInClass: (in category 'message sending') -----
lookupMethodInClass: class
| currentClass dictionary found |
<inline: false>
self assert: (self addressCouldBeClassObj: class).
currentClass := class.
[currentClass ~= objectMemory nilObject]
whileTrue:
+ [dictionary := objectMemory followObjField: MethodDictionaryIndex ofObject: currentClass.
- [dictionary := objectMemory fetchPointer: MethodDictionaryIndex ofObject: currentClass.
dictionary = objectMemory nilObject ifTrue:
["MethodDict pointer is nil (hopefully due a swapped out stub)
-- raise exception #cannotInterpret:."
self createActualMessageTo: class.
messageSelector := objectMemory splObj: SelectorCannotInterpret.
self sendBreakpoint: messageSelector receiver: nil.
^self lookupMethodInClass: (self superclassOf: currentClass)].
found := self lookupMethodInDictionary: dictionary.
found ifTrue: [^currentClass].
currentClass := self superclassOf: currentClass].
"Could not find #doesNotUnderstand: -- unrecoverable error."
messageSelector = (objectMemory splObj: SelectorDoesNotUnderstand) ifTrue:
[self error: 'Recursive not understood error encountered'].
"Cound not find a normal message -- raise exception #doesNotUnderstand:"
self createActualMessageTo: class.
messageSelector := objectMemory splObj: SelectorDoesNotUnderstand.
self sendBreak: messageSelector + BaseHeaderSize
point: (objectMemory lengthOf: messageSelector)
receiver: nil.
^self lookupMethodInClass: class!
Item was changed:
----- Method: StackInterpreter>>lookupMethodInDictionary: (in category 'message sending') -----
lookupMethodInDictionary: dictionary
"This method lookup tolerates integers as Dictionary keys to support
execution of images in which Symbols have been compacted out."
| length index mask wrapAround nextSelector methodArray |
<inline: true>
<asmLabel: false>
length := objectMemory fetchWordLengthOf: dictionary.
mask := length - SelectorStart - 1.
"Use linear search on small dictionaries; its cheaper.
Also the limit can be set to force linear search of all dictionaries, which supports the
booting of images that need rehashing (e.g. because a tracer has generated an image
with different hashes but hasn't rehashed it yet.)"
mask <= methodDictLinearSearchLimit ifTrue:
[index := 0.
[index <= mask] whileTrue:
[nextSelector := objectMemory fetchPointer: index + SelectorStart ofObject: dictionary.
nextSelector = messageSelector ifTrue:
[methodArray := objectMemory fetchPointer: MethodArrayIndex ofObject: dictionary.
+ newMethod := objectMemory followField: index ofObject: methodArray.
- newMethod := objectMemory fetchPointer: index ofObject: methodArray.
^true].
index := index + 1].
^false].
index := SelectorStart + (mask bitAnd: ((objectMemory isImmediate: messageSelector)
ifTrue: [objectMemory integerValueOf: messageSelector]
ifFalse: [objectMemory hashBitsOf: messageSelector])).
"It is assumed that there are some nils in this dictionary, and search will
stop when one is encountered. However, if there are no nils, then wrapAround
will be detected the second time the loop gets to the end of the table."
wrapAround := false.
[true] whileTrue:
[nextSelector := objectMemory fetchPointer: index ofObject: dictionary.
+ nextSelector = objectMemory nilObject ifTrue: [^false].
- nextSelector = objectMemory nilObject ifTrue: [^ false].
nextSelector = messageSelector ifTrue:
[methodArray := objectMemory fetchPointer: MethodArrayIndex ofObject: dictionary.
+ newMethod := objectMemory followField: index - SelectorStart ofObject: methodArray.
- newMethod := objectMemory fetchPointer: index - SelectorStart ofObject: methodArray.
^true].
index := index + 1.
index = length ifTrue:
[wrapAround ifTrue: [^false].
wrapAround := true.
index := SelectorStart]].
^false "for Slang"!
Item was changed:
----- Method: StackInterpreter>>lookupMethodNoMNUEtcInClass: (in category 'callback support') -----
lookupMethodNoMNUEtcInClass: class
"Lookup messageSelector in class. Answer 0 on success. Answer the splObj: index
for the error selector to use on failure rather than performing MNU processing etc."
| currentClass dictionary |
<inline: true>
currentClass := class.
[currentClass ~= objectMemory nilObject] whileTrue:
+ [dictionary := objectMemory followObjField: MethodDictionaryIndex ofObject: currentClass.
- [dictionary := objectMemory fetchPointer: MethodDictionaryIndex ofObject: currentClass.
dictionary = objectMemory nilObject ifTrue:
[lkupClass := self superclassOf: currentClass.
^SelectorCannotInterpret].
(self lookupMethodInDictionary: dictionary) ifTrue:
[self addNewMethodToCache: class.
^0].
currentClass := self superclassOf: currentClass].
lkupClass := class.
^SelectorDoesNotUnderstand!
Item was changed:
----- Method: StackInterpreter>>nextImplicitReceiverFor:withMixin: (in category 'newspeak bytecode support') -----
nextImplicitReceiverFor: anObject withMixin: mixin
"This is used to implement the innards of the pushImplicitReceiverBytecode,
used for implicit receiver sends in NS2/NS3. Find the nearest lexically-enclosing
implementation of selector by searching up the static chain of anObject,
starting at mixin's application. This is an iterative implementation derived from
<ContextPart> nextImplicitReceiverFor: obj <Object>
withMixin: mixin <Mixin>
implementing: selector <Symbol> ^<Object>"
| implicitReceiver mixinApplication theMixin targetMixin dictionary found |
implicitReceiver := anObject.
targetMixin := mixin.
[(targetMixin = objectMemory nilObject "or: [implicitReceiver = objectMemory nilObject]") ifTrue:
[^objectMemory nilObject].
mixinApplication := self findApplicationOfTargetMixin: targetMixin
startingAtNonMetaClass: (objectMemory fetchClassOf: implicitReceiver).
mixinApplication = objectMemory nilObject ifTrue:
[^objectMemory nilObject].
+ dictionary := objectMemory followObjField: MethodDictionaryIndex ofObject: mixinApplication.
- dictionary := objectMemory fetchPointer: MethodDictionaryIndex ofObject: mixinApplication.
found := self lookupMethodInDictionary: dictionary.
found]
whileFalse:
[implicitReceiver := objectMemory fetchPointer: EnclosingObjectIndex ofObject: mixinApplication.
theMixin := objectMemory fetchPointer: MixinIndex ofObject: mixinApplication.
theMixin = objectMemory nilObject ifTrue:
[^objectMemory nilObject].
targetMixin := objectMemory fetchPointer: EnclosingMixinIndex ofObject: theMixin].
^implicitReceiver!
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'
- instanceVariableNames: 'bootstrapping byteCount breakCount sendCount printSends printReturns traceOn myBitBlt displayForm filesOpen imageName pluginList mappedPluginEntries quitBlock transcript displayView printFrameAtEachStep printBytecodeAtEachStep startMicroseconds externalSemaphoreSignalRequests externalSemaphoreSignalResponses extSemTabSize atEachStepBlock disableBooleanCheat'
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>>createActualMessageTo: (in category 'debugging traps') -----
createActualMessageTo: class
+ "false
+ ifTrue:
+ [(self stringOf: messageSelector) = 'run:with:in:' ifTrue:
+ [self halt]]
+ ifFalse:
+ [self halt: (self stringOf: messageSelector)]."
- "self halt: (self stringOf: messageSelector)."
^super createActualMessageTo: class!
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.
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.
primitiveAccessorDepthTable := objectMemory hasSpurMemoryManagerAPI ifTrue:
[self class primitiveAccessorDepthTable].
pluginList := {'' -> self }.
mappedPluginEntries := OrderedCollection new.
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].
traceOn := true.
printSends := printReturns := printFrameAtEachStep := printBytecodeAtEachStep := false.
myBitBlt := BitBltSimulator new setInterpreter: self.
transcript := Transcript.
displayForm := 'Display has not yet been installed' asDisplayText form.
suppressHeartbeatFlag := false.
+ systemAttributes := Dictionary new.
extSemTabSize := 256.
disableBooleanCheat := false!
Item was changed:
----- Method: StackInterpreterSimulator>>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]).
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:
+ [firstTime ifTrue: [transcript show: ' ... okay'; cr].
- [firstTime ifTrue: [transcript cr; show: ' ... okay'].
accessorDepthPtr at: 0 put: (pluginAndName at: 4).
^index]].
firstTime ifTrue: [transcript cr; show: 'Failed ... primitive not in plugin'].
^0!
Item was added:
+ ----- Method: StackInterpreterSimulator>>preBecomeAction (in category 'object memory support') -----
+ preBecomeAction
+ "((objectMemory instVarNamed: 'becomeEffectsFlags') anyMask: BecameCompiledMethodFlag) ifTrue:
+ [self halt]."
+ super preBecomeAction!
Item was changed:
----- Method: StackInterpreterSimulator>>primitiveExecuteMethodArgsArray (in category 'control primitives') -----
primitiveExecuteMethodArgsArray
+ "self halt: thisContext selector."
+ (objectMemory isOopCompiledMethod: self stackTop) ifFalse:
+ [self halt].
- self halt: thisContext selector.
^super primitiveExecuteMethodArgsArray!
Item was changed:
----- Method: StackInterpreterSimulator>>primitiveGetAttribute (in category 'other primitives') -----
primitiveGetAttribute
"Fetch the system attribute with the given integer ID. The result is a string, which will be empty if the attribute is not defined."
+ | index s attribute |
+ index := self stackIntegerValue: 0.
- | attr s attribute |
- attr := self stackIntegerValue: 0.
self successful ifTrue: [
+ attribute := systemAttributes at: index ifAbsent: [Smalltalk getSystemAttribute: index].
- attribute := Smalltalk getSystemAttribute: attr.
attribute ifNil: [ ^self primitiveFail ].
s := objectMemory instantiateClass: (objectMemory splObj: ClassByteString) indexableSize: attribute size.
1 to: attribute size do: [ :i |
objectMemory storeByte: i-1 ofObject: s withValue: (attribute at: i) asciiValue].
self pop: 2. "rcvr, attr"
self push: s]!
Item was added:
+ ----- Method: StackInterpreterSimulator>>systemAttributes (in category 'simulation only') -----
+ systemAttributes
+ ^systemAttributes!
More information about the Vm-dev
mailing list