[Vm-dev] VM Maker: VMMaker.oscog-eem.452.mcz
commits at source.squeak.org
commits at source.squeak.org
Sat Oct 12 00:17:03 UTC 2013
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.452.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.452
Author: eem
Time: 11 October 2013, 5:12:29.833 pm
UUID: 1a0629f1-a8f6-4b4f-a0ab-0b93fe63cde0
Ancestors: VMMaker.oscog-eem.451
Add a configuration for a StackInterpreter+Spur VM.
Make StackInterpreter + Spur translateable:
- make BlockNode>>isPotentialCCaseLabelIn: not barf on
[self arrayFormat] -> [...] et al
- the usual class-side translation horrors added to
SpurMemoryManager and subclasses
- rename some args to avoid warnings about shadowing
- Move the sender selector checking in isIntegerObject: et al down
into the simulator subclasses.
Round the CogVMSimulators heapBase to allocationUnit so the
scavenger initializes correctly.
Eliminate the bogus second initialization of obejctMemory in
CogVMSimulator>>openOn:extraMemory:.
Fix the assert in checkIfValidObjectRef:pc:cogMethod: since open pic
linking can leave the selector unchanged in rare circumstances.
Replicate the clasas-side fixes for intializationOptions in
StackInterpreterSimulator in CogVMSimulator.
=============== Diff against VMMaker.oscog-eem.451 ===============
Item was removed:
- ----- Method: BlockNode>>isPotentialCCaseLabel (in category '*VMMaker-C translation') -----
- isPotentialCCaseLabel
- | stmt |
- statements size ~= 1 ifTrue: [^false].
- stmt := statements first.
- ^self isPotentialCCaseLabel: stmt!
Item was removed:
- ----- Method: BlockNode>>isPotentialCCaseLabel: (in category '*VMMaker-C translation') -----
- isPotentialCCaseLabel: stmt
- (stmt isVariableNode
- or: [stmt isLiteralNode
- and: [stmt isConstantNumber or: [stmt literalValue isSymbol]]]) ifTrue:
- [^true].
- stmt isMessageNode ifTrue:
- [(#(* + -) includes: stmt selector key) ifTrue:
- [^(self isPotentialCCaseLabel: stmt receiver)
- and: [self isPotentialCCaseLabel: stmt arguments first]].
- ^stmt selector key = #asSymbol
- and: [stmt receiver isLiteralNode
- and: [stmt receiver literalValue isSymbol]]].
- ^false!
Item was added:
+ ----- Method: BlockNode>>isPotentialCCaseLabel:in: (in category '*VMMaker-C translation') -----
+ isPotentialCCaseLabel: stmt in: aTMethod
+ (stmt isVariableNode
+ or: [stmt isLiteralNode
+ and: [stmt isConstantNumber or: [stmt literalValue isSymbol]]]) ifTrue:
+ [^true].
+ stmt isMessageNode ifTrue:
+ [| selector method |
+ selector := stmt selector key.
+ (#(* + -) includes: selector) ifTrue:
+ [^(self isPotentialCCaseLabel: stmt receiver in: aTMethod)
+ and: [self isPotentialCCaseLabel: stmt arguments first in: aTMethod]].
+
+ (selector = #asSymbol
+ and: [stmt receiver isLiteralNode
+ and: [stmt receiver literalValue isSymbol]]) ifTrue:
+ [^true].
+
+ (stmt arguments isEmpty
+ and: [method := (aTMethod definingClass whichClassIncludesSelector: selector) >> selector.
+ (method isQuick
+ or: [(method literalAt: 1) isInteger
+ and: [method numLiterals = 3]])
+ and: [(aTMethod definingClass basicNew perform: selector) isInteger]]) ifTrue:
+ [^true]].
+ ^false!
Item was added:
+ ----- Method: BlockNode>>isPotentialCCaseLabelIn: (in category '*VMMaker-C translation') -----
+ isPotentialCCaseLabelIn: aTMethod
+ | stmt |
+ statements size ~= 1 ifTrue: [^false].
+ stmt := statements first.
+ ^self isPotentialCCaseLabel: stmt in: aTMethod!
Item was changed:
----- Method: BraceNode>>asTranslatorNodeIn: (in category '*VMMaker-C translation') -----
asTranslatorNodeIn: aTMethod
"make a CCodeGenerator equivalent of me"
self assert: (elements allSatisfy:
[:elem|
elem isMessageNode
and: [elem selector key = #->
and: [elem receiver isBlockNode
and: [elem arguments first isBlockNode
+ and: [elem receiver isPotentialCCaseLabelIn: aTMethod]]]]]).
- and: [elem receiver isPotentialCCaseLabel]]]]]).
^TBraceCaseNode new
caseLabels: (elements collect: [:elem| elem receiver asTranslatorNodeIn: aTMethod]);
cases: (elements collect: [:elem| elem arguments first asTranslatorNodeIn: aTMethod]);
comment: comment!
Item was changed:
----- Method: CoInterpreter>>followForwardingPointersInStackZone: (in category 'object memory support') -----
+ followForwardingPointersInStackZone: theBecomeEffectsFlags
- followForwardingPointersInStackZone: becomeEffectsFlags
"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: #'char *'>
+ (theBecomeEffectsFlags anyMask: BecameCompiledMethodFlag) ifTrue:
- (becomeEffectsFlags 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.
theSP := theSP + BytesPerWord].
[self assert: (thePage addressIsInPage: theFP).
self assert: (theIPPtr = 0 or: [thePage addressIsInPage: theIPPtr]).
offset := theFP + (self frameStackedReceiverOffset: theFP).
oop := stackPages longAt: offset.
((objectMemory isNonImmediate: oop)
and: [(objectMemory isForwarded: oop)]) ifTrue:
[stackPages
longAt: 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 + FoxIFReceiver.
((objectMemory isNonImmediate: oop)
and: [(objectMemory isForwarded: oop)]) ifTrue:
[stackPages
longAt: theFP + FoxIFReceiver
put: (objectMemory followForwarded: oop)].
self assert: (objectMemory isForwarded: (self frameMethodObject: theFP)) not]
ifFalse:
[oop := stackPages longAt: theFP + FoxIFReceiver.
((objectMemory isNonImmediate: oop)
and: [(objectMemory isForwarded: oop)]) ifTrue:
[stackPages
longAt: theFP + FoxIFReceiver
put: (objectMemory followForwarded: oop)].
oop := self frameMethod: theFP.
(objectMemory isForwarded: oop) ifTrue:
[| delta |
delta := (objectMemory followForwarded: oop) - oop.
(theIPPtr ~= 0
and: [(stackPages longAt: theIPPtr) > (self frameMethod: theFP)]) ifTrue:
[stackPages
longAt: theIPPtr
put: (stackPages longAt: theIPPtr) + delta].
stackPages
longAt: theFP + FoxIFSavedIP
put: (stackPages longAt: theFP + FoxIFSavedIP) + delta.
stackPages
longAt: theFP + FoxMethod
put: (objectMemory followForwarded: oop)]].
self followNecessaryForwardingInMethod: (self frameMethod: theFP).
(callerFP := self frameCallerFP: theFP) ~= 0] whileTrue:
[theIPPtr := theFP + FoxCallerSavedIP.
theFP := callerFP]]]!
Item was changed:
----- Method: CoInterpreter>>postBecomeAction: (in category 'object memory support') -----
+ postBecomeAction: theBecomeEffectsFlags
- postBecomeAction: becomeEffectsFlags
"Clear the gcMode var and let the Cogit do its post GC checks."
+ super postBecomeAction: theBecomeEffectsFlags.
- super postBecomeAction: becomeEffectsFlags.
cogit cogitPostGCAction: gcMode.
lastCoggableInterpretedBlockMethod := lastUncoggableInterpretedBlockMethod := nil.
gcMode := 0!
Item was changed:
----- Method: CoInterpreterStackPages>>initializeStack:numSlots:pageSize: (in category 'initialization') -----
initializeStack: theStackPages numSlots: stackSlots pageSize: slotsPerPage
"Initialize the stack pages. In the C VM theStackPages will be alloca'ed memory to hold the
stack pages on the C stack. In the simulator they are housed in the memory between the
cogMethodZone and the heap."
<var: #theStackPages type: #'char *'>
<returnTypeC: #void>
| numPages page structStackPageSize pageStructBase count |
<var: #page type: #'StackPage *'>
<var: #pageStructBase type: #'char *'>
self cCode: []
inSmalltalk:
[self assert: objectMemory startOfMemory - coInterpreter cogCodeSize - coInterpreter methodCacheSize - coInterpreter primTraceLogSize - coInterpreter rumpCStackSize
+ = (stackSlots * BytesPerWord roundUpTo: objectMemory allocationUnit)].
- = (stackSlots * BytesPerWord)].
structStackPageSize := coInterpreter sizeof: InterpreterStackPage.
bytesPerPage := slotsPerPage * BytesPerWord.
numPages := coInterpreter numStkPages.
"Because stack pages grow down baseAddress is at the top of a stack page and so to avoid
subtracting BytesPerWord from baseAddress and lastAddress in the init loop below we simply
push the stackPage array up one word to avoid the overlap. This word is extraStackBytes."
pageStructBase := theStackPages + (numPages * bytesPerPage) + BytesPerWord.
pages := self cCode: [self cCoerceSimple: pageStructBase to: #'StackPage *']
inSmalltalk:
[pageMap := Dictionary new.
((0 to: numPages - 1) collect:
[:i|
InterpreterStackPage surrogateClass new
address: pageStructBase + (i * structStackPageSize)
simulator: coInterpreter
zoneBase: coInterpreter stackZoneBase
zoneLimit: objectMemory startOfMemory])
do: [:pageSurrogate|
pageMap at: pageSurrogate address put: pageSurrogate];
yourself].
"make sure there's enough headroom"
self assert: coInterpreter stackPageByteSize - coInterpreter stackLimitBytes - coInterpreter stackLimitOffset
>= coInterpreter stackPageHeadroom.
0 to: numPages - 1 do:
[:index|
page := self stackPageAt: index.
page
lastAddress: theStackPages + (index * bytesPerPage);
baseAddress: page lastAddress + bytesPerPage;
stackLimit: page baseAddress - coInterpreter stackLimitBytes;
realStackLimit: page stackLimit;
baseFP: 0;
nextPage: (self stackPageAt: (index = (numPages - 1) ifTrue: [0] ifFalse: [index + 1]));
prevPage: (self stackPageAt: (index = 0 ifTrue: [numPages - 1] ifFalse: [index - 1]))].
"Now compute stackBasePlus1 so that the pageIndexFor: call maps all addresses from
aPage baseAddress to aBase limitAddress + 1 to the same index (stacks grow down)"
stackBasePlus1 := (self cCoerceSimple: theStackPages to: #'char *') + 1.
self cCode: []
inSmalltalk:
[minStackAddress := theStackPages.
maxStackAddress := theStackPages + (numPages * bytesPerPage) + BytesPerWord - 1].
"The overflow limit is the amount of stack to retain when moving frames from an overflowing
stack to reduce thrashing. See stackOverflowOrEvent:mayContextSwitch:"
page := self stackPageAt: 0.
overflowLimit := page baseAddress - page realStackLimit * 3 // 5.
0 to: numPages - 1 do:
[:index|
page := self stackPageAt: index.
self assert: (self pageIndexFor: page baseAddress) == index.
self assert: (self pageIndexFor: page baseAddress - (slotsPerPage - 1 * BytesPerWord)) == index.
self assert: (self stackPageFor: page baseAddress) == page.
self assert: (self stackPageFor: page stackLimit) == page.
self cCode: []
inSmalltalk:
[| memIndex |
memIndex := index * slotsPerPage + 1. "this is memIndex in the block above"
self assert: (self memIndexFor: (self oopForPointer: page baseAddress))
== (memIndex + slotsPerPage - 1).
index < (numPages - 1) ifTrue:
[self assert: (self stackPageFor: page baseAddress + BytesPerWord) == (self stackPageAt: index + 1)]].
self assert: (page trace: -1) ~= 0 "for assert checking of the page tracing flags. -1 == invalid state"].
mostRecentlyUsedPage := self stackPageAt: 0.
page := mostRecentlyUsedPage.
count := 0.
[| theIndex |
count := count + 1.
theIndex := self pageIndexFor: page baseAddress.
self assert: (self stackPageAt: theIndex) == page.
self assert: (self pageIndexFor: page baseAddress) == theIndex.
self assert: (self pageIndexFor: page stackLimit) == theIndex.
self assert: (self pageIndexFor: page lastAddress + 1) == theIndex.
(page := page nextPage) ~= mostRecentlyUsedPage] whileTrue.
self assert: count == numPages.
self assert: self pageListIsWellFormed!
Item was changed:
----- Method: CogVMSimulator class>>initializeWithOptions:objectMemoryClass: (in category 'class initialization') -----
initializeWithOptions: optionsDictionaryOrArray objectMemoryClass: objectMemoryClassOrNil
"The relevant ObjectMemory, Interpreter and Cogit classes must be initialized in order.
This happens notionally every time we start the simulator,
but in fact happens when ever we instantiate a simulator."
| cogitClassOrName |
initializationOptions := optionsDictionaryOrArray isArray
ifTrue: [Dictionary newFromPairs: optionsDictionaryOrArray]
ifFalse: [optionsDictionaryOrArray].
(objectMemoryClassOrNil ifNil: [self objectMemoryClass])
initializeWithOptions: initializationOptions.
+ self initializeWithOptions: initializationOptions.
+
((initializationOptions at: #COGMTVM ifAbsent: [false])
ifTrue: [CoInterpreterMT]
ifFalse: [CoInterpreter])
initializeWithOptions: initializationOptions.
(initializationOptions includesKey: #Cogit) ifTrue:
[cogitClassOrName := initializationOptions at: #Cogit.
cogitClassOrName isSymbol ifTrue:
[cogitClassOrName := Smalltalk classNamed: cogitClassOrName].
CoInterpreter classPool at: #CogitClass put: cogitClassOrName].
(self cogitClass withAllSuperclasses copyUpTo: Cogit) reverseDo:
[:c| c initializeWithOptions: initializationOptions]!
Item was changed:
----- Method: CogVMSimulator class>>onObjectMemory:cogit:options: (in category 'instance creation') -----
onObjectMemory: anObjectMemory cogit: aCogit options: optionsDictionaryOrArray
+ | simulatorClass |
^self == CogVMSimulator
ifTrue:
+ [simulatorClass := SmalltalkImage current endianness == #big
- [self initializeWithOptions: optionsDictionaryOrArray
- objectMemoryClass: (anObjectMemory ifNotNil: [anObjectMemory class]).
- SmalltalkImage current endianness == #big
ifTrue: [self notYetImplemented]
+ ifFalse: [CogVMSimulatorLSB].
+ simulatorClass
+ initializeWithOptions: optionsDictionaryOrArray
+ objectMemoryClass: (anObjectMemory ifNotNil: [anObjectMemory class]).
+ simulatorClass
+ onObjectMemory: (anObjectMemory ifNil:
+ [self objectMemoryClass simulatorClass new])
+ cogit: aCogit
+ options: optionsDictionaryOrArray]
- ifFalse: [CogVMSimulatorLSB onObjectMemory: anObjectMemory cogit: aCogit options: optionsDictionaryOrArray]]
ifFalse:
[| sim |
- self initializeWithOptions: optionsDictionaryOrArray.
sim := self basicNew.
sim objectMemory: anObjectMemory.
sim cogit: aCogit.
sim initialize.
COGMTVM ifTrue: "Set via options"
[sim initializeThreadSupport; initialize].
sim]!
Item was changed:
----- Method: CogVMSimulator>>openOn:extraMemory: (in category 'initialization') -----
openOn: fileName extraMemory: extraBytes
"CogVMSimulator new openOn: 'clone.im' extraMemory: 100000"
| f version headerSize count heapSize oldBaseAddr bytesToShift swapBytes hdrNumStackPages
hdrEdenBytes hdrCogCodeSize stackZoneSize methodCacheSize headerFlags primTraceLogSize firstSegSize hdrMaxExtSemTabSize |
"open image file and read the header"
["begin ensure block..."
f := FileStream readOnlyFileNamed: fileName.
imageName := f fullName.
f binary.
version := self nextLongFrom: f. "current version: 16r1968 (=6504) vive la revolucion!!"
(self readableFormat: version)
ifTrue: [swapBytes := false]
ifFalse: [(version := objectMemory byteSwapped: version) = self imageFormatVersion
ifTrue: [swapBytes := true]
ifFalse: [self error: 'incomaptible image format']].
headerSize := self getLongFromFile: f swap: swapBytes.
heapSize := self getLongFromFile: f swap: swapBytes. "length of heap in file"
oldBaseAddr := self getLongFromFile: f swap: swapBytes. "object memory base address of image"
objectMemory specialObjectsOop: (self getLongFromFile: f swap: swapBytes).
objectMemory lastHash: (self getLongFromFile: f swap: swapBytes). "Should be loaded from, and saved to the image header"
savedWindowSize := self getLongFromFile: f swap: swapBytes.
headerFlags := self getLongFromFile: f swap: swapBytes.
self setImageHeaderFlagsFrom: headerFlags.
extraVMMemory := self getLongFromFile: f swap: swapBytes.
hdrNumStackPages := self getShortFromFile: f swap: swapBytes.
"4 stack pages is small. Should be able to run with as few as
three. 4 should be comfortable but slow. 8 is a reasonable
default. Can be changed via vmParameterAt: 43 put: n"
numStackPages := desiredNumStackPages ~= 0
ifTrue: [desiredNumStackPages]
ifFalse: [hdrNumStackPages = 0
ifTrue: [self defaultNumStackPages]
ifFalse: [hdrNumStackPages]].
desiredNumStackPages := hdrNumStackPages.
stackZoneSize := self computeStackZoneSize.
"This slot holds the size of the native method zone in 1k units. (pad to word boundary)."
hdrCogCodeSize := (self getShortFromFile: f swap: swapBytes) * 1024.
cogCodeSize := desiredCogCodeSize ~= 0
ifTrue: [desiredCogCodeSize]
ifFalse:
[hdrCogCodeSize = 0
ifTrue: [self defaultCogCodeSize]
ifFalse: [hdrCogCodeSize]].
desiredCogCodeSize := hdrCogCodeSize.
self assert: f position = 40.
hdrEdenBytes := self getLongFromFile: f swap: swapBytes.
objectMemory edenBytes: (desiredEdenBytes ~= 0
ifTrue: [desiredEdenBytes]
ifFalse:
[hdrEdenBytes = 0
ifTrue: [objectMemory defaultEdenBytes]
ifFalse: [hdrEdenBytes]]).
desiredEdenBytes := hdrEdenBytes.
hdrMaxExtSemTabSize := self getShortFromFile: f swap: swapBytes.
hdrMaxExtSemTabSize ~= 0 ifTrue:
[self setMaxExtSemSizeTo: hdrMaxExtSemTabSize].
"pad to word boundary. This slot can be used for anything else that will fit in 16 bits.
Preserve it to be polite to other VMs."
the2ndUnknownShort := self getShortFromFile: f swap: swapBytes.
self assert: f position = 48.
firstSegSize := self getLongFromFile: f swap: swapBytes.
objectMemory firstSegmentSize: firstSegSize.
"For Open PICs to be able to probe the method cache during
simulation the methodCache must be relocated to memory."
methodCacheSize := methodCache size * BytesPerWord.
primTraceLogSize := primTraceLog size * BytesPerWord.
"allocate interpreter memory. This list is in address order, low to high.
In the actual VM the stack zone exists on the C stack."
+ heapBase := (cogCodeSize
- heapBase := cogCodeSize
+ stackZoneSize
+ methodCacheSize
+ primTraceLogSize
+ + self rumpCStackSize) roundUpTo: objectMemory allocationUnit.
- + self rumpCStackSize.
objectMemory
setHeapBase: heapBase
memoryLimit: heapBase
+ heapSize
+ objectMemory newSpaceBytes
+ self interpreterAllocationReserveBytes
+ extraBytes
endOfMemory: heapBase + heapSize.
- objectMemory initialize.
self assert: cogCodeSize \\ 4 = 0.
self assert: objectMemory memoryLimit \\ 4 = 0.
self assert: self rumpCStackSize \\ 4 = 0.
"read in the image in bulk, then swap the bytes if necessary"
f position: headerSize.
objectMemory memory: ((cogit processor endianness == #little
ifTrue: [LittleEndianBitmap]
ifFalse: [Bitmap]) new: objectMemory memoryLimit // 4).
count := objectMemory readHeapFromImageFile: f dataBytes: heapSize.
count ~= heapSize ifTrue: [self halt].
]
ensure: [f close].
self moveMethodCacheToMemoryAt: cogCodeSize + stackZoneSize.
self movePrimTraceLogToMemoryAt: cogCodeSize + stackZoneSize + methodCacheSize.
self ensureImageFormatIsUpToDate: swapBytes.
bytesToShift := objectMemory memoryBaseForImageRead - oldBaseAddr. "adjust pointers for zero base address"
Utilities
informUser: 'Relocating object pointers...'
during: [self initializeInterpreter: bytesToShift].
self initializeCodeGenerator!
Item was changed:
----- Method: Cogit>>checkIfValidObjectRef:pc:cogMethod: (in category 'garbage collection') -----
checkIfValidObjectRef: annotation pc: mcpc cogMethod: cogMethod
<var: #mcpc type: #'char *'>
<var: #sendTable type: #'sqInt *'>
annotation = IsObjectReference ifTrue:
[| literal |
literal := backEnd literalBeforeFollowingAddress: mcpc asInteger.
(objectRepresentation checkValidObjectReference: literal) ifFalse:
[coInterpreter print: 'object ref leak in CM '; printHex: cogMethod asInteger; print: ' @ '; printHex: mcpc asInteger; cr.
^1]].
(self isSendAnnotation: annotation) ifTrue:
[| entryPoint selectorOrCacheTag offset sendTable |
entryPoint := backEnd callTargetFromReturnAddress: mcpc asInteger.
self
offsetAndSendTableFor: entryPoint
annotation: annotation
into: [:off :table| offset := off. sendTable := table].
selectorOrCacheTag := backEnd inlineCacheTagAt: mcpc asInteger.
(entryPoint > methodZoneBase
+ and: [offset ~= cmNoCheckEntryOffset
+ and: [(self cCoerceSimple: entryPoint + offset to: #'CogMethod *') cmType ~= CMOpenPIC
+ or: [(objectRepresentation couldBeObject: selectorOrCacheTag) not]]])
- and: [offset ~= cmNoCheckEntryOffset])
ifTrue: "linked non-super send, cacheTag is a cacheTag"
[(objectRepresentation checkValidInlineCacheTag: selectorOrCacheTag) ifFalse:
[coInterpreter print: 'cache tag leak in CM '; printHex: cogMethod asInteger; print: ' @ '; printHex: mcpc asInteger; cr.
^1]]
ifFalse: "unlinked send or super send; cacheTag is a selector"
[(objectRepresentation checkValidObjectReference: selectorOrCacheTag) ifFalse:
[coInterpreter print: 'selector leak in CM '; printHex: cogMethod asInteger; print: ' @ '; printHex: mcpc asInteger; cr.
^1]]].
^0 "keep scanning"!
Item was added:
+ ----- Method: NewObjectMemory>>leakCheckNewSpaceGC (in category 'debug support') -----
+ leakCheckNewSpaceGC
+ <api>
+ ^(checkForLeaks bitAnd: 2) ~= 0!
Item was added:
+ ----- Method: Spur32BitCoMemoryManager class>>simulatorClass (in category 'simulation only') -----
+ simulatorClass
+ ^Spur32BitMMLECoSimulator!
Item was added:
+ ----- Method: Spur32BitMMLECoSimulator>>freeStart (in category 'accessing') -----
+ freeStart
+ (#(Cogit SimpleStackBasedCogit StackToRegisterMappingCogit) includes: thisContext sender class name) ifTrue:
+ [self halt].
+ ^super freeStart!
Item was changed:
----- Method: Spur32BitMMLECoSimulator>>scavengingGCTenuringIf: (in category 'generation scavenging') -----
scavengingGCTenuringIf: tenuringCriterion
"Run the scavenger."
+ "self halt: (statScavenges + 1) printString, ((statScavenges between: 9 and: 19)
- self halt: (statScavenges + 1) printString, ((statScavenges between: 9 and: 19)
ifTrue: ['th']
+ ifFalse: [#('st' 'nd' 'rd') at: (statScavenges + 1) \\ 10 ifAbsent: 'th']), ' scavenge'."
- ifFalse: [#('st' 'nd' 'rd') at: (statScavenges + 1) \\ 10 ifAbsent: 'th']), ' scavenge'.
^super scavengingGCTenuringIf: tenuringCriterion!
Item was added:
+ ----- 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:) includes: sel) ifFalse:
+ [self halt].
+ ^super isIntegerObject: oop!
Item was changed:
+ ----- Method: SpurMemoryManager class>>initBytesPerWord: (in category 'class initialization') -----
- ----- Method: SpurMemoryManager class>>initBytesPerWord: (in category 'initialization') -----
initBytesPerWord: nBytes
BytesPerWord := nBytes.
ShiftForWord := (BytesPerWord log: 2) rounded.
"The following is necessary to avoid confusing the compiler with shifts that are larger than the width of the type on which they operate. In gcc, such shifts cause incorrect code to be generated."
BytesPerWord = 8
ifTrue: "64-bit VM"
[Byte0Mask := 16r00000000000000FF. Byte0Shift := 0.
Byte1Mask := 16r000000000000FF00. Byte1Shift := 8.
Byte2Mask := 16r0000000000FF0000. Byte2Shift := 16.
Byte3Mask := 16r00000000FF000000. Byte3Shift := 24.
Byte4Mask := 16r000000FF00000000. Byte4Shift := 32.
Byte5Mask := 16r0000FF0000000000. Byte5Shift := 40.
Byte6Mask := 16r00FF000000000000. Byte6Shift := 48.
Byte7Mask := 16rFF00000000000000. Byte7Shift := 56.
Bytes3to0Mask := 16r00000000FFFFFFFF.
Bytes7to4Mask := 16rFFFFFFFF00000000]
ifFalse: "32-bit VM"
[Byte0Mask := 16r00000000000000FF. Byte0Shift := 0.
Byte1Mask := 16r000000000000FF00. Byte1Shift := 8.
Byte2Mask := 16r0000000000FF0000. Byte2Shift := 16.
Byte3Mask := 16r00000000FF000000. Byte3Shift := 24.
Byte4Mask := nil. Byte4Shift := 0. "unused"
Byte5Mask := nil. Byte5Shift := 0. "unused"
Byte6Mask := nil. Byte6Shift := 0. "unused"
Byte7Mask := nil. Byte7Shift := 0. "unused"
Bytes3to0Mask := nil. "unused"
Bytes7to4Mask := nil "unused"].
Byte1ShiftNegated := Byte1Shift negated.
Byte3ShiftNegated := Byte3Shift negated.
Byte4ShiftNegated := Byte4Shift negated.
Byte5ShiftNegated := Byte5Shift negated.
Byte7ShiftNegated := Byte7Shift negated.
"N.B. This is *not* output when generating the interpreter file.
It is left to the various sqConfig.h files to define correctly."
VMBIGENDIAN := Smalltalk endianness == #big!
Item was changed:
+ ----- Method: SpurMemoryManager class>>initializeSpecialObjectIndices (in category 'class initialization') -----
- ----- Method: SpurMemoryManager class>>initializeSpecialObjectIndices (in category 'initialization') -----
initializeSpecialObjectIndices
"Initialize indices into specialObjects array."
NilObject := 0.
FalseObject := 1.
TrueObject := 2.
SchedulerAssociation := 3.
ClassBitmap := 4.
ClassInteger := 5.
ClassByteString := ClassString := 6. "N.B. Actually class ByteString"
ClassArray := 7.
"SmalltalkDictionary := 8." "Do not delete!!"
ClassFloat := 9.
ClassMethodContext := 10.
"ClassBlockContext := 11. unused by the VM"
ClassPoint := 12.
ClassLargePositiveInteger := 13.
TheDisplay := 14.
ClassMessage := 15.
"ClassCompiledMethod := 16. unused by the VM"
TheLowSpaceSemaphore := 17.
ClassSemaphore := 18.
ClassCharacter := 19.
SelectorDoesNotUnderstand := 20.
SelectorCannotReturn := 21.
ProcessSignalingLowSpace := 22. "was TheInputSemaphore"
SpecialSelectors := 23.
CharacterTable := nil. "Must be unused by the VM"
SelectorMustBeBoolean := 25.
ClassByteArray := 26.
"ClassProcess := 27. unused"
CompactClasses := 28.
TheTimerSemaphore := 29.
TheInterruptSemaphore := 30.
SelectorCannotInterpret := 34.
"Was MethodContextProto := 35."
ClassBlockClosure := 36.
"Was BlockContextProto := 37."
ExternalObjectsArray := 38.
ClassMutex := 39.
"Was: ClassTranslatedMethod := 40."
ProcessInExternalCodeTag := 40.
TheFinalizationSemaphore := 41.
ClassLargeNegativeInteger := 42.
ClassExternalAddress := 43.
ClassExternalStructure := 44.
ClassExternalData := 45.
ClassExternalFunction := 46.
ClassExternalLibrary := 47.
SelectorAboutToReturn := 48.
SelectorRunWithIn := 49.
SelectorAttemptToAssign := 50.
"PrimErrTableIndex := 51. in Interpreter class>>initializePrimitiveErrorCodes"
ClassAlien := 52.
SelectorInvokeCallback := 53.
ClassUnsafeAlien := 54.
ClassWeakFinalizer := 55.
ForeignCallbackProcess := 56.
SelectorUnknownBytecode := 57.
SelectorCounterTripped := 58!
Item was added:
+ ----- Method: SpurMemoryManager class>>isNonArgumentImplicitReceiverVariableName: (in category 'translation') -----
+ isNonArgumentImplicitReceiverVariableName: aString
+ ^#('self' 'coInterpreter' 'manager' 'scavenger' 'segmentManager') includes: aString!
Item was added:
+ ----- Method: SpurMemoryManager 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."
+
+ ^'checkForLeaks' = var!
Item was added:
+ ----- Method: SpurMemoryManager class>>prepareToBeAddedToCodeGenerator: (in category 'translation') -----
+ prepareToBeAddedToCodeGenerator: aCodeGen
+ "Remove the superclass methods we override."
+ self selectors do:
+ [:sel|
+ (superclass whichClassIncludesSelector: sel) ifNotNil:
+ [aCodeGen removeMethodForSelector: sel]]!
Item was changed:
----- Method: SpurMemoryManager>>checkedIntegerValueOf: (in category 'simulation only') -----
checkedIntegerValueOf: intOop
+ <doNotGenerate>
"hack around the CoInterpreter/ObjectMemory split refactoring"
^coInterpreter checkedIntegerValueOf: intOop!
Item was changed:
----- Method: SpurMemoryManager>>freeStart (in category 'accessing') -----
freeStart
- (#(Cogit SimpleStackBasedCogit StackToregisterMappingCogit) includes: thisContext sender class name) ifTrue:
- [self halt].
^freeStart!
Item was changed:
----- Method: SpurMemoryManager>>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:) includes: sel) ifFalse:
- [self halt].
^(oop bitAnd: 1) ~= 0!
Item was changed:
----- Method: SpurMemoryManager>>possibleRootStoreInto: (in category 'store check') -----
possibleRootStoreInto: destObj
- (#( storePointer:ofObject:withValue:
- storePointer:ofForwarder:withValue:
- inPlaceBecome:and:copyHashFlag:) includes: thisContext sender method selector) ifFalse:
- [self halt].
(self isRemembered: destObj) ifFalse:
[scavenger remember: destObj.
self setIsRememberedOf: destObj to: true]!
Item was changed:
----- Method: SpurMemoryManager>>setFreeOldSpaceStart: (in category 'snapshot') -----
+ setFreeOldSpaceStart: newFreeOldSpaceStart
- setFreeOldSpaceStart: freeStart
"Set by the segment manager on parsing the image."
+ freeOldSpaceStart := newFreeOldSpaceStart!
- freeOldSpaceStart := freeStart!
Item was changed:
----- Method: StackInterpreter>>followForwardingPointersInStackZone: (in category 'object memory support') -----
+ followForwardingPointersInStackZone: theBecomeEffectsFlags
- followForwardingPointersInStackZone: becomeEffectsFlags
"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: #'char *'>
+ (theBecomeEffectsFlags anyMask: BecameCompiledMethodFlag) ifTrue:
- (becomeEffectsFlags 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.
theSP := theSP + BytesPerWord].
[self assert: (thePage addressIsInPage: theFP).
self assert: (theIPPtr = 0 or: [thePage addressIsInPage: theIPPtr]).
oop := stackPages longAt: theFP + FoxReceiver.
((objectMemory isNonImmediate: oop)
and: [(objectMemory isForwarded: oop)]) ifTrue:
[stackPages
longAt: theFP + FoxReceiver
put: (objectMemory followForwarded: oop)].
theIP := theFP + (self frameStackedReceiverOffset: theFP). "reuse theIP; its just an offset here"
oop := stackPages longAt: theIP.
((objectMemory isNonImmediate: oop)
and: [(objectMemory isForwarded: 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:
[| delta |
theIPPtr ~= 0 ifTrue:
[self assert: (stackPages longAt: theIPPtr) > (self frameMethod: theFP).
delta := (objectMemory followForwarded: oop) - oop.
stackPages
longAt: theIPPtr
put: (stackPages longAt: theIPPtr) + delta].
stackPages
longAt: theFP + FoxMethod
put: (objectMemory followForwarded: oop)].
self followNecessaryForwardingInMethod: (self frameMethod: theFP).
(callerFP := self frameCallerFP: theFP) ~= 0] whileTrue:
[theIPPtr := theFP + FoxCallerSavedIP.
theFP := callerFP]]]!
Item was changed:
----- Method: StackInterpreter>>objectMemory: (in category 'initialization') -----
objectMemory: anObjectMemory
<doNotGenerate>
+ objectMemory ifNotNil: [self halt].
objectMemory := anObjectMemory!
Item was changed:
----- Method: StackInterpreter>>postBecomeAction: (in category 'object memory support') -----
+ postBecomeAction: theBecomeEffectsFlags
+ theBecomeEffectsFlags ~= 0 ifTrue:
+ [self followForwardingPointersInStackZone: theBecomeEffectsFlags]!
- postBecomeAction: becomeEffectsFlags
- becomeEffectsFlags ~= 0 ifTrue:
- [self followForwardingPointersInStackZone: becomeEffectsFlags]!
Item was added:
+ ----- Method: VMMaker class>>generate:with:to:platformDir:excluding: (in category 'utilities') -----
+ generate: interpreterClass with: optionsPairsArray to: srcDirName platformDir: platDirName excluding: exclusions
+ "Generate the VM to the given target directory. Include only plugins in pluginList.
+ Example:
+ (VMMaker
+ generate: StackInterpreter
+ with: #(ObjectMemory Spur32BitMemoryManager)
+ to: (FileDirectory default directoryNamed: 'oscogvm/spurstacksrc') fullName
+ platformDir: (FileDirectory default directoryNamed: 'oscogvm/platforms') fullName
+ excluding: (InterpreterPlugin withAllSubclasses collect: [:ea| ea name]))."
+ (self makerFor: interpreterClass and: nil with: optionsPairsArray to: srcDirName platformDir: platDirName excluding: exclusions) generateEntire!
Item was added:
+ ----- Method: VMMaker class>>generateSqueakSpurStackVM (in category 'configurations') -----
+ generateSqueakSpurStackVM
+ "No primitives since we can use those for the Cog VM"
+ ^VMMaker
+ generate: StackInterpreter
+ with: #(ObjectMemory Spur32BitMemoryManager)
+ to: (FileDirectory default directoryNamed: 'oscogvm/spurstacksrc') fullName
+ platformDir: (FileDirectory default directoryNamed: 'oscogvm/platforms') fullName
+ excluding: (InterpreterPlugin withAllSubclasses collect: [:ea| ea name])!
More information about the Vm-dev
mailing list