[Vm-dev] VM Maker: .VMMaker.oscog-eem.615.mcz
commits at source.squeak.org
commits at source.squeak.org
Thu Feb 13 04:08:07 UTC 2014
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/.VMMaker.oscog-eem.615.mcz
==================== Summary ====================
Name: .VMMaker.oscog-eem.615
Author: eem
Time: 12 February 2014, 8:02:02.982 pm
UUID: f518acf8-ff68-42b9-9e4e-aec19abc4d41
Ancestors: VMMaker.oscog-eem.614
Make Spur snapshot avoid writing trailing free space in each
segment to the image file
Fix initialization of primitiveAccessorDepthTable during simulation.
=============== Diff against VMMaker.oscog-eem.614 ===============
Item was changed:
----- Method: CCodeGenerator>>shouldIncludeMethodFor:selector: (in category 'utilities') -----
shouldIncludeMethodFor: aClass selector: selector
"process optional methods by interpreting the argument to the option: pragma as either
a Cogit class name or a class variable name or a variable name in VMBasicConstants."
(aClass >> selector pragmaAt: #option:) ifNotNil:
[:pragma| | key |
key := pragma argumentAt: 1.
vmMaker ifNotNil:
[(Cogit withAllSubclasses anySatisfy: [:c| c name = key]) ifTrue:
[| cogitClass optionClass |
cogitClass := Smalltalk classNamed: vmMaker cogitClassName.
optionClass := Smalltalk classNamed: key.
^cogitClass includesBehavior: optionClass].
+ ((vmClass
+ ifNotNil: [vmClass initializationOptions]
+ ifNil: [vmMaker options]) at: key ifAbsent: [false]) ifNotNil:
- (vmMaker options at: key ifAbsent: [false]) ifNotNil:
[:option| option ~~ false ifTrue: [^true]].
(aClass bindingOf: key) ifNotNil:
[:binding|
binding value ~~ false ifTrue: [^true]].
(VMBasicConstants bindingOf: key) ifNotNil:
[:binding|
binding value ~~ false ifTrue: [^true]]].
^false].
^true!
Item was added:
+ ----- Method: CogVMSimulator>>codeGeneratorToComputeAccessorDepth (in category 'primitive support') -----
+ codeGeneratorToComputeAccessorDepth
+ ^VMMaker new
+ cogitClass: (Smalltalk classNamed: (self class initializationOptions
+ at: #Cogit
+ ifAbsent: [self class cogitClass name]));
+ buildCodeGeneratorForInterpreter: CoInterpreterPrimitives
+ includeAPIMethods: false
+ initializeClasses: false!
Item was changed:
----- Method: CogVMSimulator>>initialize (in category 'initialization') -----
initialize
"Initialize the CogVMSimulator 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."
+ transcript := Transcript.
+
objectMemory ifNil:
[objectMemory := self class objectMemoryClass simulatorClass new].
cogit ifNil:
[cogit := self class cogitClass new setInterpreter: self].
objectMemory coInterpreter: self cogit: cogit.
cogit numRegArgs > 0 ifTrue:
[debugStackDepthDictionary := Dictionary new].
cogThreadManager ifNotNil:
[super initialize].
"Note: we must initialize ConstMinusOne & HasBeenReturnedFromMCPC differently
for simulation, due to the fact that the simulator works only with +ve 32-bit values"
ConstMinusOne := objectMemory integerObjectOf: -1.
HasBeenReturnedFromMCPC := objectMemory integerObjectOf: -1.
cogMethodZone := cogit methodZone. "Because Slang can't remove intermediate implicit receivers (cogit methodZone foo doesn't reduce to foo())"
enableCog := true.
methodCache := Array new: MethodCacheSize.
atCache := Array new: AtCacheTotalSize.
self flushMethodCache.
self flushAtCache.
cogCompiledCodeCompactionCalledFor := false.
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.
+ objectMemory hasSpurMemoryManagerAPI
+ ifTrue:
+ [primitiveAccessorDepthTable := Array new: primitiveTable size.
+ pluginList := {}.
+ self loadNewPlugin: '']
+ ifFalse:
+ [pluginList := {'' -> self }].
desiredNumStackPages := desiredEdenBytes := desiredCogCodeSize := 0.
"This is initialized on loading the image, but convenient for testing stack page values..."
numStackPages := self defaultNumStackPages.
startMicroseconds := Time totalSeconds * 1000000.
maxLiteralCountForCompile := MaxLiteralCountForCompile.
minBackwardJumpCountForCompile := MinBackwardJumpCountForCompile.
flagInterpretedMethods := false.
"initialize InterpreterSimulator variables used for debugging"
byteCount := lastPollCount := sendCount := 0.
quitBlock := [^ self].
traceOn := true.
printSends := printFrameAtEachStep := printBytecodeAtEachStep := false.
myBitBlt := BitBltSimulator new setInterpreter: self.
- transcript := Transcript.
displayForm := 'Display has not yet been installed' asDisplayText form.
suppressHeartbeatFlag := deferSmash := deferredSmash := false.
systemAttributes := Dictionary new.
primTraceLog := CArrayAccessor on: (Array new: 256 withAll: 0).
primTraceLogIndex := 0.
traceLog := CArrayAccessor on: (Array new: TraceBufferSize withAll: 0).
traceLogIndex := 0.
traceSources := TraceSources.
statCodeCompactionCount := 0.
statCodeCompactionUsecs := 0.
extSemTabSize := 256!
Item was changed:
----- Method: FilePlugin>>primitiveDirectorySetMacTypeAndCreator (in category 'directory primitives') -----
primitiveDirectorySetMacTypeAndCreator
+ | creatorString typeString fileName creatorStringIndex typeStringIndex fileNameIndex fileNameSize okToSet |
- | creatorString typeString fileName creatorStringIndex typeStringIndex fileNameIndex fileNameSize okToSet |
<var: 'creatorStringIndex' type: 'char *'>
<var: 'typeStringIndex' type: 'char *'>
<var: 'fileNameIndex' type: 'char *'>
<export: true>
creatorString := interpreterProxy stackValue: 0.
typeString := interpreterProxy stackValue: 1.
fileName := interpreterProxy stackValue: 2.
((interpreterProxy isBytes: creatorString)
+ and: [(interpreterProxy isBytes: typeString)
+ and: [(interpreterProxy isBytes: fileName)
+ and: [(interpreterProxy byteSizeOf: creatorString) = 4
+ and: [(interpreterProxy byteSizeOf: typeString) = 4]]]]) ifFalse:
+ [^interpreterProxy primitiveFail].
- and: [(interpreterProxy byteSizeOf: creatorString)
- = 4])
- ifFalse: [^interpreterProxy primitiveFail].
- ((interpreterProxy isBytes: typeString)
- and: [(interpreterProxy byteSizeOf: typeString)
- = 4])
- ifFalse: [^interpreterProxy primitiveFail].
- (interpreterProxy isBytes: fileName)
- ifFalse: [^interpreterProxy primitiveFail].
creatorStringIndex := interpreterProxy firstIndexableField: creatorString.
typeStringIndex := interpreterProxy firstIndexableField: typeString.
fileNameIndex := interpreterProxy firstIndexableField: fileName.
fileNameSize := interpreterProxy byteSizeOf: fileName.
"If the security plugin can be loaded, use it to check for permission.
If not, assume it's ok"
+ sCSFTfn ~= 0 ifTrue:
+ [okToSet := self
+ cCode: '((sqInt (*)(char *, sqInt))sCSFTfn)(fileNameIndex, fileNameSize)'
+ inSmalltalk: [true].
+ okToSet ifFalse:
+ [^interpreterProxy primitiveFail]].
- sCSFTfn ~= 0
- ifTrue: [okToSet := self cCode: ' ((sqInt (*)(char *, sqInt))sCSFTfn)(fileNameIndex, fileNameSize)'.
- okToSet
- ifFalse: [^interpreterProxy primitiveFail]].
(self
+ cCode: 'dir_SetMacFileTypeAndCreator(fileNameIndex, fileNameSize, typeStringIndex, creatorStringIndex)'
+ inSmalltalk: [true]) ifFalse:
+ [^interpreterProxy primitiveFail].
- cCode: 'dir_SetMacFileTypeAndCreator(fileNameIndex, fileNameSize,typeStringIndex, creatorStringIndex)'
- inSmalltalk: [true])
- ifFalse: [^interpreterProxy primitiveFail].
interpreterProxy pop: 3!
Item was added:
+ ----- Method: ObjectMemory>>postSnapshot (in category 'image save/restore') -----
+ postSnapshot
+ "No op for Spur compatibility."!
Item was changed:
----- Method: SpurMemoryManager>>garbageCollectForSnapshot (in category 'snapshot') -----
garbageCollectForSnapshot
self flushNewSpace. "There is no place to put newSpace in the snapshot file."
+ self fullGC.
+ segmentManager prepareForSnapshot!
- self fullGC!
Item was added:
+ ----- Method: SpurMemoryManager>>postSnapshot (in category 'snapshot') -----
+ postSnapshot
+ <doNotGenerate>
+ segmentManager postSnapshot!
Item was changed:
VMStructType subclass: #SpurSegmentInfo
+ instanceVariableNames: 'segStart segSize swizzle containsPinned savedSegSize lastFreeObject'
- instanceVariableNames: 'segStart segSize swizzle containsPinned'
classVariableNames: ''
poolDictionaries: ''
category: 'VMMaker-SpurMemoryManager'!
Item was added:
+ ----- Method: SpurSegmentInfo>>lastFreeObject (in category 'accessing') -----
+ lastFreeObject
+ "Answer the value of lastFreeObject"
+
+ ^ lastFreeObject!
Item was added:
+ ----- Method: SpurSegmentInfo>>lastFreeObject: (in category 'accessing') -----
+ lastFreeObject: anObject
+ "Set the value of lastFreeObject"
+
+ ^lastFreeObject := anObject!
Item was added:
+ ----- Method: SpurSegmentInfo>>savedSegSize (in category 'accessing') -----
+ savedSegSize
+ "Answer the value of savedSegSize"
+
+ ^ savedSegSize!
Item was added:
+ ----- Method: SpurSegmentInfo>>savedSegSize: (in category 'accessing') -----
+ savedSegSize: anObject
+ "Set the value of savedSegSize"
+
+ ^savedSegSize := anObject!
Item was added:
+ ----- Method: SpurSegmentManager>>postSnapshot (in category 'snapshot') -----
+ postSnapshot
+ "Restore all shortened segments to their proper size,
+ re-freeing the trailing space."
+ numSegments - 1 to: 0 by: -1 do:
+ [:i|
+ (segments at: i) lastFreeObject ifNotNil:
+ [:freeChunk| | address |
+ address := (segments at: i) segLimit - manager bridgeSize.
+ (segments at: i) segSize: (segments at: i) savedSegSize.
+ self bridgeFrom: (segments at: i)
+ to: (i < (numSegments - 1) ifTrue: [segments at: i + 1]).
+ manager
+ addFreeChunkWithBytes: (segments at: i) segLimit - address - manager bridgeSize
+ at: address]].
+
+ "perhaps this should read
+ manager setEndOfMemory: 0; assimilateNewSegment: (segments at: numSegments - 1)"
+ manager setEndOfMemory: (segments at: numSegments - 1) segLimit - manager bridgeSize!
Item was added:
+ ----- Method: SpurSegmentManager>>prepareForSnapshot (in category 'snapshot') -----
+ prepareForSnapshot
+ "shorten all segments by any trailing free space."
+ <var: #seg type: #'SpurSegmentInfo *'>
+ 0 to: numSegments - 1 do:
+ [:i|
+ (segments at: i)
+ savedSegSize: (segments at: i) segSize;
+ lastFreeObject: nil].
+
+ "Ideally finding the lastFreeObject of each segment would be
+ done in some linear pass through the heap. But for now KISS."
+ manager freeTreeNodesDo:
+ [:freeChunk| | next seg |
+ next := manager objectAfter: freeChunk limit: manager endOfMemory.
+ (manager isSegmentBridge: next) ifTrue:
+ [seg := self segmentContainingObj: freeChunk.
+ seg lastFreeObject: freeChunk].
+ freeChunk].
+
+ 0 to: numSegments - 1 do:
+ [:i|
+ (segments at: i) lastFreeObject ifNotNil:
+ [:freeChunk|
+ manager detachFreeObject: freeChunk.
+ (segments at: i)
+ segSize: (manager startOfObject: freeChunk)
+ + manager bridgeSize
+ - (segments at: i) segStart.
+ self bridgeFrom: (segments at: i)
+ to: (i < (numSegments - 1) ifTrue: [segments at: i + 1])]].
+
+ "perhaps this should read
+ manager setEndOfMemory: 0; assimilateNewSegment: (segments at: numSegments - 1)"
+ manager setEndOfMemory: (segments at: numSegments - 1) segLimit - manager bridgeSize!
Item was added:
+ ----- Method: SpurSegmentManager>>segmentContainingObj: (in category 'accessing') -----
+ segmentContainingObj: objOop
+ <returnTypeC: #'SpurSegmentInfo *'>
+ numSegments - 1 to: 0 by: -1 do:
+ [:i|
+ objOop >= (segments at: i) segStart ifTrue:
+ [^self addressOf: (segments at: i)]].
+ ^nil!
Item was added:
+ ----- Method: StackInterpreter>>codeGeneratorToComputeAccessorDepth (in category 'primitive support') -----
+ codeGeneratorToComputeAccessorDepth
+ ^VMMaker new
+ buildCodeGeneratorForInterpreter: StackInterpreterPrimitives
+ includeAPIMethods: false
+ initializeClasses: false!
Item was changed:
----- Method: StackInterpreter>>snapshot: (in category 'image save/restore') -----
snapshot: embedded
"update state of active context"
| activeContext activeProc rcvr setMacType stackIndex |
<var: #setMacType type: #'void *'>
"For now the stack munging below doesn't deal with more than one argument.
It can, and should."
argumentCount ~= 0 ifTrue:
[^self primitiveFailFor: PrimErrBadNumArgs].
"Need to convert all frames into contexts since the snapshot file only holds objects."
self push: instructionPointer.
activeContext := self voidVMStateForSnapshotFlushingExternalPrimitivesIf: true.
"update state of active process"
activeProc := self activeProcess.
objectMemory
storePointer: SuspendedContextIndex
ofObject: activeProc
withValue: activeContext.
tempOop := activeContext.
objectMemory garbageCollectForSnapshot.
"Nothing moves from here on so it is safe to grab the activeContext again."
activeContext := tempOop.
tempOop := 0.
self successful ifTrue:
["Without contexts or stacks simulate
rcvr := self popStack. ''pop rcvr''
self push: trueObj.
to arrange that the snapshot resumes with true. N.B. stackIndex is one-relative."
stackIndex := self quickFetchInteger: StackPointerIndex ofObject: activeContext.
rcvr := objectMemory fetchPointer: stackIndex + CtxtTempFrameStart - 1 ofObject: activeContext.
objectMemory
storePointerUnchecked: stackIndex + CtxtTempFrameStart - 1
ofObject: activeContext
withValue: objectMemory trueObject.
"now attempt to write the snapshot file"
self writeImageFileIO.
(self successful and: [embedded not]) ifTrue:
["set Mac file type and creator; this is a noop on other platforms"
setMacType := self ioLoadFunction: 'setMacFileTypeAndCreator' From: 'FilePlugin'.
setMacType = 0 ifFalse:
[self cCode: '((sqInt (*)(char *, char *, char *))setMacType)(imageName, "STim", "FAST")']].
"Without contexts or stacks simulate
self pop: 1"
objectMemory
storePointerUnchecked: StackPointerIndex
ofObject: activeContext
withValue: (objectMemory integerObjectOf: stackIndex - 1)].
+ objectMemory postSnapshot.
self marryContextInNewStackPageAndInitializeInterpreterRegisters: activeContext.
self successful
ifTrue: [self push: objectMemory falseObject]
ifFalse:
[self push: rcvr.
self justActivateNewMethod]!
Item was changed:
----- Method: StackInterpreter>>tryLoadNewPlugin:pluginEntries: (in category 'primitive support') -----
tryLoadNewPlugin: pluginString pluginEntries: pluginEntries
"Load the plugin and if on Spur, populate pluginEntries with the prmitives in the plugin."
<doNotGenerate>
| plugin plugins simulatorClasses |
self transcript cr; show: 'Looking for module ', pluginString.
"Defeat loading of the FloatArrayPlugin & Matrix2x3Plugin since complications with 32-bit
float support prevent simulation. If you feel up to tackling this start by implementing
cCoerce: value to: cType
^cType = 'float'
ifTrue: [value asIEEE32BitWord]
ifFalse: [value]
in FloatArrayPlugin & Matrix2x3Plugin and then address the issues in the BalloonEnginePlugin.
See http://forum.world.st/Simulating-the-BalloonEnginePlugin-FloatArrayPlugin-amp-Matrix2x3Plugin-primitives-td4734673.html"
(#('FloatArrayPlugin' 'Matrix2x3Plugin') includes: pluginString) ifTrue:
[self transcript show: ' ... defeated'. ^nil].
pluginString isEmpty
ifTrue:
[plugin := self]
ifFalse:
[plugins := InterpreterPlugin allSubclasses select: [:psc| psc moduleName asString = pluginString asString].
simulatorClasses := (plugins
select: [:psc| psc simulatorClass notNil]
thenCollect: [:psc| psc simulatorClass]) asSet.
simulatorClasses isEmpty ifTrue: [self transcript show: ' ... not found'. ^nil].
simulatorClasses size > 1 ifTrue: [^self error: 'This won''t work...'].
plugins size > 1 ifTrue:
[self transcript show: '...multiple plugin classes; choosing ', plugins last name].
plugin := simulatorClasses anyOne newFor: plugins last. "hopefully lowest in the hierarchy..."
plugin setInterpreter: objectMemory. "Ignore return value from setInterpreter"
(plugin respondsTo: #initialiseModule) ifTrue:
[plugin initialiseModule ifFalse:
[self transcript show: ' ... initialiser failed'. ^nil]]]. "module initialiser failed"
self transcript show: ' ... loaded'.
objectMemory hasSpurMemoryManagerAPI ifTrue:
[| realPlugin cg |
self transcript show: '...computing accessor depths'.
plugin class isPluginClass
ifTrue:
[realPlugin := plugin class withAllSuperclasses detect: [:class| class shouldBeTranslated].
cg := realPlugin buildCodeGeneratorUpTo: realPlugin]
ifFalse:
+ [cg := self codeGeneratorToComputeAccessorDepth.
+ primitiveTable withIndexDo:
+ [:prim :index| | depth |
+ prim isSymbol ifTrue:
+ [depth := cg accessorDepthForSelector: prim.
+ self assert: depth isInteger.
+ primitiveAccessorDepthTable at: index - 1 put: depth]]].
- [cg := VMMaker new
- buildCodeGeneratorForInterpreter: StackInterpreter
- includeAPIMethods: false
- initializeClasses: false].
cg exportedPrimitiveNames do:
[:primName| | fnSymbol |
fnSymbol := primName asSymbol.
pluginEntries addLast: {plugin.
fnSymbol.
[plugin perform: fnSymbol. self].
cg accessorDepthForSelector: fnSymbol}].
self transcript show: '...done'].
^pluginString asString -> plugin!
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.
+ transcript := Transcript.
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.
+ mappedPluginEntries := OrderedCollection new.
objectMemory hasSpurMemoryManagerAPI
ifTrue:
+ [primitiveAccessorDepthTable := Array new: primitiveTable size.
+ pluginList := {}.
+ self loadNewPlugin: '']
- [primitiveAccessorDepthTable := self class primitiveAccessorDepthTable.
- pluginList := {}]
ifFalse:
[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 added:
+ ----- Method: VMClass class>>initializationOptions (in category 'initialization') -----
+ initializationOptions
+ ^initializationOptions!
More information about the Vm-dev
mailing list