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-am..." (#('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!
vm-dev@lists.squeakfoundation.org