[Vm-dev] VM Maker: VMMaker.oscog-eem.575.mcz
commits at source.squeak.org
commits at source.squeak.org
Mon Jan 6 18:03:15 UTC 2014
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.575.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.575
Author: eem
Time: 6 January 2014, 10:00:10.701 am
UUID: 3c41906f-dd7d-4298-9487-2a7089d19714
Ancestors: VMMaker.oscog-dtl.574, VMMaker.oscog-dtl.572
Implement following primitive args to primitive accessor depth on
primitive failure in Spur.
Implement simulator support for Spur primitive accessor depth.
Fix assert in mapStackPages. Can't check for being married with
SqueakV3 obj mem since when compacting it moves bodies after
updating pointers.
=============== Diff against VMMaker.oscog-dtl.574 ===============
Item was changed:
----- Method: CoInterpreter>>slowPrimitiveResponse (in category 'primitive support') -----
slowPrimitiveResponse
"Invoke a normal (non-quick) primitive.
+ Called under the assumption that primFunctionPointer has been preloaded.
+ Override to log primitive."
- Called under the assumption that primFunctionPtr has been preloaded"
- | nArgs savedFramePointer savedStackPointer |
- <inline: true>
- <asmLabel: false>
- <var: #savedFramePointer type: #'char *'>
- <var: #savedStackPointer type: #'char *'>
cogit recordPrimTrace ifTrue:
[self fastLogPrim: messageSelector].
+ ^super slowPrimitiveResponse!
- FailImbalancedPrimitives ifTrue:
- [nArgs := argumentCount.
- savedStackPointer := stackPointer.
- savedFramePointer := framePointer].
- self initPrimCall.
- self dispatchFunctionPointer: primitiveFunctionPointer.
- (FailImbalancedPrimitives
- and: [self successful
- and: [framePointer = savedFramePointer
- and: [(self isMachineCodeFrame: framePointer) not]]]) ifTrue:"Don't fail if primitive has done something radical, e.g. perform:"
- [stackPointer ~= (savedStackPointer + (nArgs * BytesPerWord)) ifTrue:
- [self flag: 'Would be nice to make this a message send of e.g. unbalancedPrimitive to the current process or context'.
- "This is necessary but insufficient; the result may still have been written to the stack.
- At least we'll know something is wrong."
- stackPointer := savedStackPointer.
- self failUnbalancedPrimitive]].
- "If we are profiling, take accurate primitive measures"
- nextProfileTick > 0 ifTrue:
- [self checkProfileTick: newMethod].
- ^self successful!
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."
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.
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 removed:
- ----- Method: CogVMSimulator>>ioLoadExternalFunction:OfLength:FromModule:OfLength: (in category 'plugin support') -----
- ioLoadExternalFunction: functionName OfLength: functionLength FromModule: moduleName OfLength: moduleLength
- "Load and return the requested function from a module"
- | pluginString functionString |
- pluginString := String new: moduleLength.
- 1 to: moduleLength do:[:i| pluginString byteAt: i put: (objectMemory byteAt: moduleName+i-1)].
- functionString := String new: functionLength.
- 1 to: functionLength do:[:i| functionString byteAt: i put: (objectMemory byteAt: functionName+i-1)].
- ^self ioLoadFunction: functionString From: pluginString!
Item was changed:
----- Method: CogVMSimulator>>loadNewPlugin: (in category 'plugin support') -----
loadNewPlugin: pluginString
+ ^(self tryLoadNewPlugin: pluginString pluginEntries: mappedPluginEntries) ifNotNil:
+ [:entry|
+ pluginList := pluginList copyWith: entry.
+ entry]!
- | plugin plugins simulatorClasses |
- transcript cr; show: 'Looking for module ', pluginString.
- "but *why*??"
- (#('FloatArrayPlugin' 'Matrix2x3Plugin') includes: pluginString) ifTrue:
- [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: [transcript show: ' ... not found'. ^nil].
- simulatorClasses size > 1 ifTrue: [^self error: 'This won''t work...'].
- plugins size > 1 ifTrue:
- [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:
- [transcript show: ' ... initialiser failed'. ^nil]]]. "module initialiser failed"
- pluginList := pluginList copyWith: (pluginString asString -> plugin).
- transcript show: ' ... loaded'.
- ^pluginList last!
Item was changed:
----- Method: SpurMemoryManager>>followForwardedObjectFields:toDepth: (in category 'forwarding') -----
followForwardedObjectFields: objOop toDepth: depth
+ "Follow pointers in the object to depth.
+ Answer if any forwarders were found.
- "follow pointers in the object to depth.
How to avoid cyclic structures?? A temproary mark bit?"
+ | oop found |
+ found := false.
- | oop |
self assert: ((self isPointers: objOop) or: [self isOopCompiledMethod: objOop]).
0 to: (self numPointerSlotsOf: objOop) - 1 do:
[:i|
+ oop := self fetchPointer: i ofObject: objOop.
+ (self isNonImmediate: oop) ifTrue:
+ [(self isForwarded: oop) ifTrue:
+ [found := true.
+ oop := self followForwarded: oop.
+ self storePointer: i ofObject: objOop withValue: oop].
+ (depth > 0
+ and: [(self hasPointerFields: oop)
+ and: [self followForwardedObjectFields: oop toDepth: depth - 1]]) ifTrue:
+ [found := true]]].
+ ^found!
- oop := self fetchPointer: i ofObject: objOop.
- ((self isNonImmediate: oop)
- and: [self isForwarded: oop]) ifTrue:
- [oop := self followForwarded: oop.
- self storePointer: i ofObject: objOop withValue: oop].
- depth > 0 ifTrue:
- [self followForwardedObjectFields: objOop toDepth: depth - 1]]!
Item was added:
+ ----- Method: SpurMemoryManager>>hasPointerFields: (in category 'object testing') -----
+ hasPointerFields: oop
+ <inline: true>
+ | format |
+ ^(self isNonImmediate: oop)
+ and: [(format := self formatOf: oop) <= self lastPointerFormat
+ or: [format >= self firstCompiledMethodFormat]]!
Item was changed:
InterpreterPrimitives subclass: #StackInterpreter
+ instanceVariableNames: 'currentBytecode bytecodeSetSelector localFP localIP localSP stackLimit stackPage stackPages method instructionPointer stackPointer framePointer localReturnValue extA extB primitiveFunctionPointer methodCache atCache lkupClassTag lkupClass methodDictLinearSearchLimit highestRunnableProcessPriority nextWakeupUsecs nextPollUsecs inIOProcessEvents interruptKeycode interruptPending savedWindowSize imageHeaderFlags fullScreenFlag deferDisplayUpdates pendingFinalizationSignals extraVMMemory interpreterProxy showSurfaceFn primitiveTable primitiveAccessorDepthTable externalPrimitiveTable externalPrimitiveTableFirstFreeIndex overflowedPage extraFramesToMoveOnOverflow globalSessionID jmpBuf jmpDepth suspendedCallbacks suspendedMethods numStackPages desiredNumStackPages desiredEdenBytes classNameIndex thisClassIndex metaclassNumSlots interruptCheckChain suppressHeartbeatFlag breakSelector breakSelectorLength longRunningPrimitiveCheckMethod longRunningPrimitiveCheckSemaphore longRunningPrimitiveStartUsecs longRunningPrimitiveStopUsecs longRunningPrimitiveGCUsecs longRunningPrimitiveCheckSequenceNumber longRunningPrimitiveSignalUndelivered tempOop statForceInterruptCheck statStackOverflow statStackPageDivorce statCheckForEvents statProcessSwitch statIOProcessEvents theUnknownShort the2ndUnknownShort imageFloatsBigEndian maxExtSemTabSizeSet lastMethodCacheProbeWrite statPendingFinalizationSignals gcSemaphoreIndex classByteArrayCompactIndex'
- instanceVariableNames: 'currentBytecode bytecodeSetSelector localFP localIP localSP stackLimit stackPage stackPages method instructionPointer stackPointer framePointer localReturnValue extA extB primitiveFunctionPointer methodCache atCache lkupClassTag lkupClass methodDictLinearSearchLimit highestRunnableProcessPriority nextWakeupUsecs nextPollUsecs inIOProcessEvents interruptKeycode interruptPending savedWindowSize imageHeaderFlags fullScreenFlag deferDisplayUpdates pendingFinalizationSignals extraVMMemory interpreterProxy showSurfaceFn primitiveTable externalPrimitiveTable externalPrimitiveTableFirstFreeIndex overflowedPage extraFramesToMoveOnOverflow globalSessionID jmpBuf jmpDepth suspendedCallbacks suspendedMethods numStackPages desiredNumStackPages desiredEdenBytes classNameIndex thisClassIndex metaclassNumSlots interruptCheckChain suppressHeartbeatFlag breakSelector breakSelectorLength longRunningPrimitiveCheckMethod longRunningPrimitiveCheckSemaphore longRunningPrimitiveStartUsecs longRunningPrimitiveStopUsecs longRunningPrimitiveGCUsecs longRunningPrimitiveCheckSequenceNumber longRunningPrimitiveSignalUndelivered tempOop statForceInterruptCheck statStackOverflow statStackPageDivorce statCheckForEvents statProcessSwitch statIOProcessEvents theUnknownShort the2ndUnknownShort imageFloatsBigEndian maxExtSemTabSizeSet lastMethodCacheProbeWrite statPendingFinalizationSignals gcSemaphoreIndex classByteArrayCompactIndex'
classVariableNames: 'AtCacheEntries AtCacheFixedFields AtCacheFmt AtCacheMask AtCacheOop AtCacheSize AtCacheTotalSize AtPutBase BytecodeTable CacheProbeMax DirBadPath DirEntryFound DirNoMoreEntries DumpStackOnLowSpace EnclosingMixinIndex EnclosingObjectIndex FailImbalancedPrimitives HeaderFlagBitPosition MaxExternalPrimitiveTableSize MaxJumpBuf MaxPrimitiveIndex MaxQuickPrimitiveIndex MixinIndex PrimitiveExternalCallIndex PrimitiveTable StackPageReachedButUntraced StackPageTraceInvalid StackPageTraced StackPageUnreached'
poolDictionaries: 'VMBasicConstants VMMethodCacheConstants VMObjectIndices VMSpurObjectRepresentationConstants VMSqueakClassIndices VMSqueakV3BytecodeConstants VMSqueakV3ObjectRepresentationConstants VMStackFrameOffsets'
category: 'VMMaker-Interpreter'!
!StackInterpreter commentStamp: 'eem 9/11/2013 18:30' prior: 0!
This class is a complete implementation of the Smalltalk-80 virtual machine, derived originally from the Blue Book specification but quite different in some areas. This VM supports Closures but *not* old-style BlockContexts.
It has been modernized with 32-bit pointers, better management of Contexts (see next item), and attention to variable use that allows the CCodeGenerator (qv) to keep, eg, the instruction pointer and stack pointer in registers as well as keeping most simple variables in a global array that seems to improve performance for most platforms.
The VM does not use Contexts directly. Instead Contexts serve as proxies for a more conventional stack format that is invisible to the image. There is considerable explanation at http://www.mirandabanda.org/cogblog/2009/01/14/under-cover-contexts-and-the-big-frame-up. The VM maintains a fixed-size stack zone divided into pages, each page being capable of holding several method/block activations. A send establishes a new frame in the current stack page, a return returns to the previous frame. This eliminates allocation/deallocation of contexts and the moving of receiver and arguments from caller to callee on each send/return. Contexts are created lazily when an activation needs a context (creating a block, explicit use of thisContext, access to sender when sender is a frame, or linking of stack pages together). Contexts are either conventional and heap-resident ("single") or "married" and serve as proxies for their corresponding frame or "widowed", meaning that their spouse frame has been returned from (died). A married context is specially marked (more details in the code) and refers to its frame. Likewise a married frame is specially marked and refers to its context.
In addition to SmallInteger arithmetic and Floats, the VM supports logic on 32-bit PositiveLargeIntegers, thus allowing it to simulate itself much more effectively than would otherwise be the case.
NOTE: Here follows a list of things to be borne in mind when working on this code, or when making changes for the future.
1. There are a number of things that should be done the next time we plan to release a completely incompatible image format. These include unifying the instanceSize field of the class format word -- see instantiateClass:indexableSize:, and unifying the bits of the method primitive index (if we decide we need more than 512, after all) -- see primitiveIndexOf:. Also, contexts should be given a special format code (see next item).
2. There are several fast checks for contexts (see isContextHeader: and isMethodContextHeader:) which will fail if the compact class indices of BlockContext or MethodContext change. This is necessary because the oops may change during a compaction when the oops are being adjusted. It's important to be aware of this when writing a new image using the SystemTracer. A better solution would be to reserve one of the format codes for Contexts only. An even better solution is to eliminate compact classes altogether (see 6.).
3. We have made normal files tolerant to size and positions up to 32 bits. This has not been done for async files, since they are still experimental. The code in size, at: and at:put: should work with sizes and indices up to 31 bits, although I have not tested it (di 12/98); it might or might not work with 32-bit sizes. [Late news, the support has been extended to 64-bit file sizes].
4. Note that 0 is used in a couple of places as an impossible oop. This should be changed to a constant that really is impossible (or perhaps there is code somewhere that guarantees it --if so it should be put in this comment). The places include the method cache and the at cache.
5. Moving to a 2 bit immediate tag and having immediate Characters is a good choice for Unicode and the JIT. We can still have 31-bit SmallIntegers by allowing two tag patterns for SmallInteger.
6. If Eliot Miranda's 2 word header scheme is acceptable in terms of footprint (we estimate about a 10% increase in image size with about 35 reclaimed by better representation of CompiledMethod - loss of MethodProperties) then the in-line cache for the JIT is simplified, class access is faster and header access is the same in 32-bit and full 64-bit images. [Late breaking news, the 2-word header scheme is more compact, by over 2%]. See SpurMemorymanager's class comment.!
Item was added:
+ ----- Method: StackInterpreter class>>primitiveAccessorDepthTable (in category 'constants') -----
+ primitiveAccessorDepthTable
+ | cg |
+ cg := CCodeGenerator new.
+ cg vmClass: StackInterpreter.
+ ^PrimitiveTable collect:
+ [:thing| |class method |
+ (thing isInteger "quick prims, 0 for fast primitve fail"
+ or: [thing == #primitiveFail
+ or: [(class := self whichClassIncludesSelector: thing) isNil]])
+ ifTrue: [-1]
+ ifFalse:
+ [method := (class >> thing) methodNode asTranslationMethodOfClass: TMethod.
+ cg accessorDepthForMethod: method]]!
Item was added:
+ ----- Method: StackInterpreter>>checkForAndFollowForwardedPrimitiveState (in category 'primitive support') -----
+ checkForAndFollowForwardedPrimitiveState
+ "In Spur a primitive may fail due to encountering a forwarder.
+ On failure check the accessorDepth for the primitive and
+ if non-negative scan the args to the depth, following any
+ forwarders. Answer if any are found so the prim can be retried.."
+ | primIndex accessorDepth found |
+ self assert: self successful not.
+ found := false.
+ primIndex := self primitiveIndexOf: newMethod.
+ self assert: (self
+ cCode:
+ [primitiveFunctionPointer = (self functionPointerFor: primIndex inClass: objectMemory nilObject)]
+ inSmalltalk:
+ [((primitiveFunctionPointer isInteger and: [primitiveFunctionPointer >= 1000])
+ ifTrue: [#primitiveExternalCall]
+ ifFalse: [primitiveFunctionPointer]) = (self functionPointerFor: primIndex inClass: objectMemory nilObject)]).
+ self assert: argumentCount = (self argumentCountOf: newMethod).
+ accessorDepth := (primIndex = 117 and: [primitiveFunctionPointer ~~ #primitiveExternalCall])
+ ifTrue: [self primitiveAccessorDepthForExternalPrimitiveMethod: newMethod]
+ ifFalse: [primitiveAccessorDepthTable at: primIndex].
+ accessorDepth < 0 ifTrue:
+ [^false].
+ 0 to: argumentCount do:
+ [:index| | oop |
+ oop := self stackValue: index.
+ (objectMemory isNonImmediate: oop) ifTrue:
+ [(objectMemory isForwarded: oop) ifTrue:
+ [self assert: index < argumentCount. "receiver should have been caught at send time."
+ found := true.
+ oop := objectMemory followForwarded: oop.
+ self stackValue: index put: oop].
+ ((objectMemory hasPointerFields: oop)
+ and: [objectMemory followForwardedObjectFields: oop toDepth: accessorDepth]) ifTrue:
+ [found := true]]].
+ ^found!
Item was added:
+ ----- Method: StackInterpreter>>ioLoadExternalFunction:OfLength:FromModule:OfLength: (in category 'primitive support') -----
+ ioLoadExternalFunction: functionName OfLength: functionLength FromModule: moduleName OfLength: moduleLength
+ "Load and return the requested function from a module.
+ N.B. The actual code lives in platforms/Cross/vm/sqNamedPrims.h"
+ <doNotGenerate>
+ | pluginString functionString |
+ pluginString := String new: moduleLength.
+ 1 to: moduleLength do:[:i| pluginString byteAt: i put: (objectMemory byteAt: moduleName+i-1)].
+ functionString := String new: functionLength.
+ 1 to: functionLength do:[:i| functionString byteAt: i put: (objectMemory byteAt: functionName+i-1)].
+ ^self ioLoadFunction: functionString From: pluginString!
Item was added:
+ ----- Method: StackInterpreter>>ioLoadExternalFunction:OfLength:FromModule:OfLength:AccessorDepthInto: (in category 'primitive support') -----
+ ioLoadExternalFunction: functionName OfLength: functionLength FromModule: moduleName OfLength: moduleLength 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"
+ <doNotGenerate>
+ | pluginString functionString |
+ pluginString := String new: moduleLength.
+ 1 to: moduleLength do:[:i| pluginString byteAt: i put: (objectMemory byteAt: moduleName+i-1)].
+ functionString := String new: functionLength.
+ 1 to: functionLength do:[:i| functionString byteAt: i put: (objectMemory byteAt: functionName+i-1)].
+ ^self ioLoadFunction: functionString From: pluginString AccessorDepthInto: accessorDepthPtr!
Item was changed:
----- Method: StackInterpreter>>mapStackPages (in category 'object memory support') -----
mapStackPages
<inline: false>
<var: #thePage type: #'StackPage *'>
<var: #theSP type: #'char *'>
<var: #theFP type: #'char *'>
<var: #callerFP type: #'char *'>
<var: #theIPPtr type: #'char *'>
0 to: numStackPages - 1 do:
[:i| | thePage theSP theFP callerFP theIPPtr 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: (thePage addressIsInPage: theSP).
self assert: (theIPPtr = 0 or: [thePage addressIsInPage: theIPPtr]).
[theSP <= (theFP + FoxReceiver)] whileTrue:
[oop := stackPages longAt: theSP.
(objectMemory shouldRemapOop: oop) ifTrue:
[stackPages longAt: theSP put: (objectMemory remapObj: oop)].
theSP := theSP + BytesPerWord].
(self frameHasContext: theFP) ifTrue:
[(objectMemory shouldRemapObj: (self frameContext: theFP)) ifTrue:
[stackPages
longAt: theFP + FoxThisContext
put: (objectMemory remapObj: (self frameContext: theFP))].
+ "With SqueakV3 objectMemory can't assert since object body is yet to move."
+ objectMemory hasSpurMemoryManagerAPI ifTrue:
+ [self assert: ((self isMarriedOrWidowedContext: (self frameContext: theFP))
+ and: [(self frameOfMarriedContext: (self frameContext: theFP)) = theFP])]].
- self assert: ((self isMarriedOrWidowedContext: (self frameContext: theFP))
- and: [(self frameOfMarriedContext: (self frameContext: theFP)) = theFP])].
(objectMemory shouldRemapObj: (self frameMethod: theFP)) ifTrue:
[theIPPtr ~= 0 ifTrue:
[self assert: (stackPages longAt: theIPPtr) > (self frameMethod: theFP).
theIP := (stackPages longAt: theIPPtr) - (self frameMethod: theFP)].
stackPages
longAt: theFP + FoxMethod
put: (objectMemory remapObj: (self frameMethod: theFP)).
theIPPtr ~= 0 ifTrue:
[stackPages longAt: theIPPtr put: theIP + (self frameMethod: theFP)]].
(callerFP := self frameCallerFP: theFP) ~= 0] whileTrue:
[theSP := (theIPPtr := theFP + FoxCallerSavedIP) + BytesPerWord.
theFP := callerFP].
theSP := theFP + FoxCallerContext. "a.k.a. FoxCallerSavedIP"
[theSP <= thePage baseAddress] whileTrue:
[oop := stackPages longAt: theSP.
(objectMemory shouldRemapOop: oop) ifTrue:
[stackPages longAt: theSP put: (objectMemory remapObj: oop)].
theSP := theSP + BytesPerWord]]]!
Item was added:
+ ----- Method: StackInterpreter>>primitiveAccessorDepthForExternalPrimitiveMethod: (in category 'primitive support') -----
+ primitiveAccessorDepthForExternalPrimitiveMethod: methodObj
+ ^objectMemory integerValueOf:
+ (objectMemory
+ fetchPointer: 2
+ ofObject: (self literal: 0 ofMethod: methodObj))!
Item was changed:
----- Method: StackInterpreter>>slowPrimitiveResponse (in category 'primitive support') -----
slowPrimitiveResponse
"Invoke a normal (non-quick) primitive.
+ Called under the assumption that primFunctionPointer has been preloaded."
- Called under the assumption that primFunctionPtr has been preloaded"
| nArgs savedFramePointer savedStackPointer |
<inline: true>
<asmLabel: false>
<var: #savedFramePointer type: #'char *'>
<var: #savedStackPointer type: #'char *'>
FailImbalancedPrimitives ifTrue:
[nArgs := argumentCount.
savedStackPointer := stackPointer.
savedFramePointer := framePointer].
self initPrimCall.
self dispatchFunctionPointer: primitiveFunctionPointer.
+ "In Spur a primitive may fail due to encountering a forwarder.
+ On failure check the accessorDepth for the primitive and
+ if non-negative scan the args to the depth, following any
+ forwarders. Retry the primitive if any are found."
+ (objectMemory hasSpurMemoryManagerAPI
+ and: [self successful not
+ and: [(objectMemory isOopCompiledMethod: newMethod)
+ and: [self checkForAndFollowForwardedPrimitiveState]]]) ifTrue:
+ [self initPrimCall.
+ self dispatchFunctionPointer: primitiveFunctionPointer].
(FailImbalancedPrimitives
and: [self successful
+ and: [framePointer = savedFramePointer
+ and: [(self isMachineCodeFrame: framePointer) not]]]) ifTrue:"Don't fail if primitive has done something radical, e.g. perform:"
- and: [framePointer = savedFramePointer]]) ifTrue:"Don't fail if primitive has done something radical, e.g. perform:"
[stackPointer ~= (savedStackPointer + (nArgs * BytesPerWord)) ifTrue:
[self flag: 'Would be nice to make this a message send of e.g. unbalancedPrimitive to the current process or context'.
"This is necessary but insufficient; the result may still have been written to the stack.
At least we'll know something is wrong."
stackPointer := savedStackPointer.
self failUnbalancedPrimitive]].
"If we are profiling, take accurate primitive measures"
nextProfileTick > 0 ifTrue:
[self checkProfileTick: newMethod].
^self successful!
Item was added:
+ ----- 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'.
+ realPlugin := plugin class withAllSuperclasses detect: [:class| class shouldBeTranslated].
+ cg := realPlugin buildCodeGeneratorUpTo: realPlugin.
+ 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>>flushExternalPrimitives (in category 'plugin support') -----
flushExternalPrimitives
+ mappedPluginEntries := OrderedCollection new.
+ super flushExternalPrimitives!
- mappedPluginEntries := #().
- super flushExternalPrimitives.!
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.
- mappedPluginEntries := #().
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.
extSemTabSize := 256.
disableBooleanCheat := false!
Item was removed:
- ----- Method: StackInterpreterSimulator>>ioLoadExternalFunction:OfLength:FromModule:OfLength: (in category 'plugin support') -----
- ioLoadExternalFunction: functionName OfLength: functionLength FromModule: moduleName OfLength: moduleLength
- "Load and return the requested function from a module"
- | pluginString functionString |
- pluginString := String new: moduleLength.
- 1 to: moduleLength do:[:i| pluginString byteAt: i put: (objectMemory byteAt: moduleName+i-1)].
- functionString := String new: functionLength.
- 1 to: functionLength do:[:i| functionString byteAt: i put: (objectMemory byteAt: functionName+i-1)].
- ^self ioLoadFunction: functionString From: pluginString!
Item was added:
+ ----- 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 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: StackInterpreterSimulator>>loadNewPlugin: (in category 'plugin support') -----
loadNewPlugin: pluginString
+ ^(self tryLoadNewPlugin: pluginString pluginEntries: mappedPluginEntries) ifNotNil:
+ [:entry|
+ pluginList := pluginList copyWith: entry.
+ entry]!
- | plugin plugins simulatorClasses |
- transcript cr; show: 'Looking for module ', pluginString.
- "but *why*??"
- (#('FloatArrayPlugin' 'Matrix2x3Plugin') includes: pluginString) ifTrue:
- [transcript show: ' ... defeated'. ^nil].
- 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: [transcript show: ' ... not found'. ^nil].
- simulatorClasses size > 1 ifTrue: [^self error: 'This won''t work...'].
- plugins size > 1 ifTrue:
- [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:
- [transcript show: ' ... initialiser failed'. ^nil]]. "module initialiser failed"
- pluginList := pluginList copyWith: (pluginString asString -> plugin).
- transcript show: ' ... loaded'.
- ^pluginList last!
Item was changed:
----- Method: StackInterpreterSimulator>>utilitiesMenu: (in category 'UI') -----
utilitiesMenu: aMenuMorph
aMenuMorph
add: 'toggle transcript' action: #toggleTranscript;
add: 'clone VM' action: #cloneSimulation;
addLine;
add: 'print ext head frame' action: #printExternalHeadFrame;
add: 'print int head frame' action: #printHeadFrame;
add: 'short print ext frame & callers' action: [self shortPrintFrameAndCallers: framePointer];
add: 'short print int frame & callers' action: [self shortPrintFrameAndCallers: localFP];
add: 'long print ext frame & callers' action: [self printFrameAndCallers: framePointer SP: stackPointer];
add: 'long print int frame & callers' action: [self printFrameAndCallers: localFP SP: localSP];
add: 'print frame...' action: [(self promptHex: 'print frame') ifNotNil: [:fp| self printFrame: fp]];
add: 'print call stack' action: #printCallStack;
add: 'print stack call stack' action: #printStackCallStack;
add: 'print call stack of...' action: [(self promptHex: 'context or process oop') ifNotNil: [:obj| self printCallStackOf: obj]];
add: 'print call stack of frame...' action: [(self promptHex: 'frame') ifNotNil: [:fp| self printCallStackFP: fp]];
add: 'print all stacks' action: #printAllStacks;
add: 'write back local ptrs' action: [stackPointer := localSP. framePointer := localFP. instructionPointer := localIP.
self writeBackHeadFramePointers];
add: 'print prim trace log' action: #dumpPrimTraceLog;
addLine;
add: 'print oop...' action: [(self promptHex: 'print oop') ifNotNil: [:oop| self printOop: oop]];
add: 'long print oop...' action: [(self promptHex: 'print oop') ifNotNil: [:oop| self longPrintOop: oop]];
addLine;
add: 'inspect object memory' target: objectMemory action: #inspect;
+ add: 'inspect interpreter' action: #inspect;
- add: 'inspect cointerpreter' action: #inspect;
addLine;
add: 'set break count...' action: [|s| s := UIManager default request: 'break count (dec)'.
s notEmpty ifTrue: [breakCount := Integer readFrom: s readStream]];
add: 'set break selector...' action: [|s| s := UIManager default request: 'break selector'.
s notEmpty ifTrue: [self setBreakSelector: s]];
add: (printSends
ifTrue: ['no print sends']
ifFalse: ['print sends'])
action: [self ensureDebugAtEachStepBlock.
printSends := printSends not];
"currently printReturns does nothing"
"add: (printReturns
ifTrue: ['no print returns']
ifFalse: ['print returns'])
action: [self ensureDebugAtEachStepBlock.
printReturns := printReturns not];"
add: (printBytecodeAtEachStep
ifTrue: ['no print bytecode each bytecode']
ifFalse: ['print bytecode each bytecode'])
action: [self ensureDebugAtEachStepBlock.
printBytecodeAtEachStep := printBytecodeAtEachStep not];
add: (printFrameAtEachStep
ifTrue: ['no print frame each bytecode']
ifFalse: ['print frame each bytecode'])
action: [self ensureDebugAtEachStepBlock.
printFrameAtEachStep := printFrameAtEachStep not].
^aMenuMorph!
More information about the Vm-dev
mailing list