[Vm-dev] VM Maker: VMMaker.oscog-eem.561.mcz
commits at source.squeak.org
commits at source.squeak.org
Thu Dec 12 22:39:50 UTC 2013
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.561.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.561
Author: eem
Time: 12 December 2013, 2:36:45.762 pm
UUID: 13467880-93b9-4137-9bbc-7ebfd22436ab
Ancestors: VMMaker.oscog-eem.560
Fix swizzling of Spur objStacks on start-up. Spur now snapshots
and resumes. Beef up the objStack asserts and printing to identify
my prior malfeasance.
Add some interpreter proxy plumbing to SpurMemoryManager.
Simplify StackInterpreter>>arrayValueOf: (isWordsOrBytes:
already filters-out immediates).
Change ensureMultiThreadingOverridesAreUpToDate to the new
trunk initPattern:return: from initPattern:notifying:return:. If this
bites you just implement initPattern:return: on Parser supplying nil
as the thing to notify.
=============== Diff against VMMaker.oscog-eem.560 ===============
Item was changed:
----- Method: CogVMSimulator>>ensureMultiThreadingOverridesAreUpToDate (in category 'initialization') -----
ensureMultiThreadingOverridesAreUpToDate
"Make sure the CoInterpreterMT switch methods are implemented. These methods select
between CoInterpreterMT's implementation or CoInterpreter's implementation depending
on cogThreadManager being non-nil or nil respectively. i.e. they allow us to use this one
simulator class to simulate for both CoInterpreterMT and CoInterpreter."
| thisClass me mtInterpreterClass |
thisClass := thisContext methodClass.
mtInterpreterClass := thisClass superclass.
me := thisClass name, '>>', thisContext method selector.
"We want override switches for everything implemented by CoInterpreter
and CoInterpreterMT that is either not implemented by CogVMSimulator
or already implemented by CogVMSimulator as an override switch."
(mtInterpreterClass selectors select:
[:sel|
(mtInterpreterClass superclass whichClassIncludesSelector: sel) notNil
and: [(thisClass organization categoryOfElement: sel)
ifNil: [true]
ifNotNil: [:cat| cat == #'multi-threading simulation switch']]])
do: [:sel| | argNames desiredSource |
argNames := Parser new
initPattern: (mtInterpreterClass sourceCodeAt: sel)
- notifying: nil
return: [:pattern| pattern second].
desiredSource := String streamContents:
[:str|
argNames isEmpty
ifTrue: [str nextPutAll: sel]
ifFalse:
[sel keywords with: argNames do:
[:kw :arg| str nextPutAll: kw; space; nextPutAll: arg; space].
str skip: -1].
str
crtab;
nextPutAll: '"This method includes or excludes ', mtInterpreterClass name, ' methods as required.';
crtab;
nextPutAll: ' Auto-generated by ', me, '"';
cr;
crtab;
nextPutAll: '^self perform: ';
store: sel;
crtab: 2;
nextPutAll: 'withArguments: {'.
argNames
do: [:arg| str nextPutAll: arg]
separatedBy: [str nextPut: $.; space].
str
nextPut: $};
crtab: 2;
nextPutAll: 'inSuperclass: (cogThreadManager ifNil: [';
print: mtInterpreterClass superclass;
nextPutAll: '] ifNotNil: [';
print: mtInterpreterClass;
nextPutAll: '])'].
desiredSource ~= (thisClass sourceCodeAt: sel ifAbsent: ['']) asString ifTrue:
[((thisClass includesSelector: sel)
and: [(thisClass compiledMethodAt: sel) messages includesAnyOf: #(halt halt:)])
ifTrue: [self transcript cr; nextPutAll: 'WARNING, because of halts, not generating '; nextPutAll: desiredSource; cr; flush]
ifFalse: [thisClass compile: desiredSource classified: #'multi-threading simulation switch']]].
"Make sure obsolete CoInterpreterMT switch methods are deleted."
((thisContext methodClass organization listAtCategoryNamed: #'multi-threading simulation switch') select:
[:sel| (mtInterpreterClass whichClassIncludesSelector: sel) isNil]) do:
[:sel| thisClass removeSelector: sel]!
Item was changed:
----- Method: Spur32BitMMLECoSimulator>>isIntegerObject: (in category 'object testing') -----
isIntegerObject: oop
"This list records the valid senders of isIntegerObject: as we replace uses of
isIntegerObject: by isImmediate: where appropriate."
| sel |
sel := thisContext sender method selector.
(#( DoIt
DoItIn:
on:do: "from the debugger"
makeBaseFrameFor:
quickFetchInteger:ofObject:
frameOfMarriedContext:
objCouldBeClassObj:
isMarriedOrWidowedContext:
shortPrint:
bytecodePrimAt
bytecodePrimAtPut
commonAt:
commonAtPut:
loadFloatOrIntFrom:
positive32BitValueOf:
primitiveExternalCall
checkedIntegerValueOf:
bytecodePrimAtPut
commonAtPut:
primitiveVMParameter
checkIsStillMarriedContext:currentFP:
displayBitsOf:Left:Top:Right:Bottom:
fetchStackPointerOf:
primitiveContextAt
primitiveContextAtPut
subscript:with:storing:format:
printContext:
compare31or32Bits:equal:
signed64BitValueOf:
primDigitMultiply:negative:
digitLength:
isNegativeIntegerValueOf:
magnitude64BitValueOf:
primitiveMakePoint
primitiveAsCharacter
primitiveInputSemaphore
baseFrameReturn
primitiveExternalCall
primDigitCompare:
isLiveContext:
numPointerSlotsOf:
fileValueOf:
loadBitBltDestForm
fetchIntOrFloat:ofObject:ifNil:
fetchIntOrFloat:ofObject:
loadBitBltSourceForm
loadPoint:from:
primDigitAdd:
primDigitSubtract:
positive64BitValueOf:
digitBitLogic:with:opIndex:
signed32BitValueOf:
isNormalized:
primDigitDiv:negative:
bytesOrInt:growTo:
primitiveNewMethod
isCogMethodReference:
functionForPrimitiveExternalCall:
genSpecialSelectorArithmetic
genSpecialSelectorComparison
ensureContextHasBytecodePC:
instVar:ofContext:
ceBaseFrameReturn:
inlineCacheTagForInstance:
primitiveObjectAtPut
commonVariable:at:put:cacheIndex:
primDigitBitShiftMagnitude:
externalInstVar:ofContext:
primitiveGrowMemoryByAtLeast
primitiveFileSetPosition
cogMethodDoesntLookKosher:
shortPrintOop:
primitiveSizeInBytesOfInstance
+ bereaveAllMarriedContextsForSnapshotFlushingExternalPrimitivesIf:
+ primitiveForwardSignalToSemaphore) includes: sel) ifFalse:
- bereaveAllMarriedContextsForSnapshotFlushingExternalPrimitivesIf:) includes: sel) ifFalse:
[self halt].
^super isIntegerObject: oop!
Item was added:
+ ----- Method: SpurMemoryManager>>arrayValueOf: (in category 'simulation only') -----
+ arrayValueOf: arrayOop
+ "hack around the CoInterpreter/ObjectMemory split refactoring"
+ <doNotGenerate>
+ ^coInterpreter arrayValueOf: arrayOop!
Item was added:
+ ----- Method: SpurMemoryManager>>getThisSessionID (in category 'simulation only') -----
+ getThisSessionID
+ "hack around the CoInterpreter/ObjectMemory split refactoring"
+ <doNotGenerate>
+ ^coInterpreter getThisSessionID!
Item was changed:
----- Method: SpurMemoryManager>>isValidObjStackPage:myIndex:firstPage: (in category 'obj stacks') -----
isValidObjStackPage: objStackPage myIndex: myx firstPage: isFirstPage
"Answer if the obj stack at stackRootIndex is valid."
+ | page freeOrNextPage index |
- | freeOrNextPage index |
<inline: false>
(self isValidObjStackPage: objStackPage myIndex: myx) ifFalse:
[^false].
freeOrNextPage := self fetchPointer: ObjStackFreex ofObject: objStackPage.
[freeOrNextPage ~= 0] whileTrue:
[isFirstPage ifFalse:
[objStackInvalidBecause := 'free page on other than first page'.
invalidObjStackPage := objStackPage.
^false].
+ freeOrNextPage = (self fetchPointer: ObjStackNextx ofObject: objStackPage) ifTrue:
+ [objStackInvalidBecause := 'free page = next page'.
+ invalidObjStackPage := freeOrNextPage.
+ ^false].
(self isValidObjStackPage: freeOrNextPage myIndex: myx) ifFalse:
[objStackInvalidBecause := self stretch: objStackInvalidBecause cat: ', on next page'.
^false].
+ page := self fetchPointer: ObjStackFreex ofObject: freeOrNextPage.
+ (page = freeOrNextPage
+ or: [page = objStackPage]) ifTrue:
+ [objStackInvalidBecause := 'circularity in free page list'.
+ invalidObjStackPage := page.
+ ^false].
+ freeOrNextPage := page].
- freeOrNextPage := self fetchPointer: ObjStackFreex ofObject: freeOrNextPage].
isFirstPage ifTrue:
[(myx between: self classTableRootSlots and: self classTableRootSlots + self hiddenRootSlots - 1) ifFalse:
[objStackInvalidBecause := 'myx out of range'.
invalidObjStackPage := objStackPage.
^false].
(self fetchPointer: myx ofObject: hiddenRootsObj) = objStackPage ifFalse:
[objStackInvalidBecause := 'firstPage is not root'.
invalidObjStackPage := objStackPage.
^false]].
index := self fetchPointer: ObjStackTopx ofObject: objStackPage.
(index between: 0 and: ObjStackLimit) ifFalse:
[objStackInvalidBecause := 'bad topx'.
invalidObjStackPage := objStackPage.
^false].
freeOrNextPage := self fetchPointer: ObjStackNextx ofObject: objStackPage.
+ freeOrNextPage = 0 ifTrue:
+ [^true].
+ freeOrNextPage = objStackPage ifTrue:
+ [objStackInvalidBecause := 'circularity in objStack page list'.
+ invalidObjStackPage := objStackPage.
+ ^false].
+ ^self isValidObjStackPage: freeOrNextPage myIndex: myx firstPage: false!
- ^freeOrNextPage = 0
- or: [self isValidObjStackPage: freeOrNextPage myIndex: myx firstPage: false]!
Item was changed:
----- Method: SpurMemoryManager>>printObjStackPage:myIndex:pageType: (in category 'obj stacks') -----
printObjStackPage: objStackPage myIndex: myx pageType: pageType
+ | freeOrNextPage page isFirstPage isNextPage isFreePage |
- | freeOrNextPage isFirstPage isNextPage isFreePage |
<inline: false>
isFirstPage := pageType = ObjStackMyx.
isNextPage := pageType = ObjStackNextx.
isFreePage := pageType = ObjStackFreex.
self printObjStackPage: objStackPage
myIndex: myx
tag: (isFirstPage ifTrue: ['head'] ifFalse: [isFreePage ifTrue: ['free'] ifFalse: ['next']]).
(isFirstPage or: [isNextPage]) ifTrue:
[coInterpreter tab; print: 'topx: '; printNum: (self fetchPointer: ObjStackTopx ofObject: objStackPage); print: ' next: '; printHex: (self fetchPointer: ObjStackNextx ofObject: objStackPage).
isFirstPage ifTrue:
[coInterpreter print: ' free: '; printHex: (self fetchPointer: ObjStackFreex ofObject: objStackPage)].
coInterpreter cr].
+ isFirstPage ifTrue:
+ [freeOrNextPage := self fetchPointer: ObjStackFreex ofObject: objStackPage.
+ [freeOrNextPage ~= 0] whileTrue:
+ [self printObjStackPage: freeOrNextPage myIndex: myx pageType: ObjStackFreex.
+ page := self fetchPointer: ObjStackFreex ofObject: freeOrNextPage.
+ (page = freeOrNextPage
+ or: [page = objStackPage]) ifTrue:
+ [coInterpreter print: 'circularity in free page list!!!!'; cr.
+ page := 0].
+ freeOrNextPage := page]].
- freeOrNextPage := self fetchPointer: ObjStackFreex ofObject: objStackPage.
- [freeOrNextPage ~= 0] whileTrue:
- [self printObjStackPage: freeOrNextPage myIndex: myx pageType: ObjStackFreex.
- freeOrNextPage := self fetchPointer: ObjStackFreex ofObject: freeOrNextPage].
freeOrNextPage := self fetchPointer: ObjStackNextx ofObject: objStackPage.
freeOrNextPage ~= 0 ifTrue:
[self printObjStackPage: freeOrNextPage myIndex: myx pageType: ObjStackNextx]!
Item was changed:
----- Method: SpurMemoryManager>>swizzleObjStackAt: (in category 'obj stacks') -----
swizzleObjStackAt: objStackRootIndex
"On load, swizzle the pointers in an obj stack. Answer the obj stack's oop."
+ | firstPage page stackOrNil index field |
- | firstPage stackOrNil index field |
firstPage := stackOrNil := self fetchPointer: objStackRootIndex ofObject: hiddenRootsObj.
stackOrNil = nilObj ifTrue:
[^stackOrNil].
[self assert: (self numSlotsOfAny: stackOrNil) = ObjStackPageSlots.
self assert: (self fetchPointer: ObjStackMyx ofObject: stackOrNil) = objStackRootIndex.
"There are four fixed slots in an obj stack, and a Topx of 0 indicates empty, so
if there were 5 slots in an oop stack, full would be 2, and the last 0-rel index is 4.
Hence the last index is topx + fixed slots - 1, or topx + ObjStackNextx"
index := (self fetchPointer: ObjStackTopx ofObject: stackOrNil) + ObjStackNextx.
"swizzle fields including ObjStackNextx and leave field containing the next link."
[field := self fetchPointer: index ofObject: stackOrNil.
(field = 0 or: [self isImmediate: field]) ifFalse:
[field := segmentManager swizzleObj: field.
+ self storePointer: index ofObjStack: stackOrNil withValue: field].
- self storePointer: ObjStackNextx ofObjStack: stackOrNil withValue: field].
(index := index - 1) > ObjStackMyx] whileTrue.
(stackOrNil := field) ~= 0] whileTrue.
+ (stackOrNil := self fetchPointer: ObjStackFreex ofObject: firstPage) ~= 0 ifTrue:
+ [[page := self fetchPointer: ObjStackFreex ofObject: stackOrNil.
+ page ~= 0] whileTrue:
+ [field := segmentManager swizzleObj: page.
+ self storePointer: ObjStackFreex ofObjStack: stackOrNil withValue: field.
+ stackOrNil := field]].
+ (stackOrNil := self fetchPointer: ObjStackNextx ofObject: firstPage) ~= 0 ifTrue:
+ [[page := self fetchPointer: ObjStackNextx ofObject: stackOrNil.
+ page ~= 0] whileTrue:
+ [field := segmentManager swizzleObj: page.
+ self storePointer: ObjStackNextx ofObjStack: stackOrNil withValue: field.
+ stackOrNil := field]].
- [stackOrNil := self fetchPointer: ObjStackFreex ofObject: firstPage.
- stackOrNil ~= 0] whileTrue:
- [field := segmentManager swizzleObj: stackOrNil.
- self storePointer: ObjStackFreex ofObjStack: firstPage withValue: field.
- firstPage := field].
self assert: (self isValidObjStackAt: objStackRootIndex).
^self fetchPointer: objStackRootIndex ofObject: hiddenRootsObj!
Item was changed:
----- Method: StackInterpreter>>arrayValueOf: (in category 'utilities') -----
arrayValueOf: arrayOop
"Return the address of first indexable field of resulting array object, or fail if
the instance variable does not contain an indexable bytes or words object."
"Note: May be called by translated primitive code."
<returnTypeC: #'void *'>
+ (objectMemory isWordsOrBytes: arrayOop) ifTrue:
- ((objectMemory isNonIntegerObject: arrayOop)
- and: [objectMemory isWordsOrBytes: arrayOop]) ifTrue:
[^self cCoerceSimple: (self pointerForOop: arrayOop + BaseHeaderSize) to: #'void *'].
self primitiveFail!
More information about the Vm-dev
mailing list