[Vm-dev] VM Maker: VMMaker.oscog-eem.2211.mcz
commits at source.squeak.org
commits at source.squeak.org
Sat May 13 02:09:02 UTC 2017
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.2211.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.2211
Author: eem
Time: 12 May 2017, 7:08:08.505489 pm
UUID: 5a69567a-b158-4d95-99ca-80995331fe69
Ancestors: VMMaker.oscog-eem.2210
StackInterpreter:
Simplify and make robust display bitmap access for display update. The old code required platforms that needed to redraw at arbitrary times to have to access the display bits through interpreterProxy->displayObject, decoding it each time. There exists a small window during compaction, etc, during whiuch such access will fail and cause a VM crash. The new code provides four variablesa to reference the display, displayBits, displayWidth, displayHeight and displayDepth, which are assigned appropriately in the primitiveBeDisplay primitive. After a GC the interpreter checks if the displayBits have changed location and if so calls ioNoteDisplayChanged:width:height:depth: (ioNoteDisplayChangedwidthheightdepth) to inform the platform of the change (currently all platforms implement this as a null function).
On Spur the primtiiveBeDIsplay primitive also pins the display bits.
This scheme allows displayBitsOf:Left:Top:Right:Bottom: to be simplified to updateDisplayLeft:Top:Right:Bottom:.
Spur:
Fix cloneInOldSpaceForPinning: to handle failed allocations correctly.
Have pinObject: only clone an old space object that is 1Mb or less, simply pinning larger objects (whioch would include the display bitmap) where it sits.
=============== Diff against VMMaker.oscog-eem.2210 ===============
Item was changed:
----- Method: CogVMSimulator>>fullDisplay (in category 'I/O primitives') -----
fullDisplay
| primFailCodeValue |
+ displayForm ifNil: [^self].
- displayForm == nil ifTrue: [^ self].
primFailCodeValue := primFailCode.
self initPrimCall.
+ self updateDisplayLeft: 0 Top: 0 Right: displayWidth Bottom: displayHeight.
- self displayBitsOf: (objectMemory splObj: TheDisplay) Left: 0 Top: 0 Right: displayForm width Bottom: displayForm height.
primFailCode := primFailCodeValue!
Item was added:
+ ----- Method: CogVMSimulator>>ioBeDisplay:width:height:depth: (in category 'I/O primitives') -----
+ ioBeDisplay: bitsOrHandleCArray width: width height: height depth: depth
+ "The real platform may want to note the location of the display and respond to the fact of
+ its installation. Here merely create a scratch form the same size as Smalltalk displayObj"
+ super ioBeDisplay: bitsOrHandleCArray asInteger width: width height: height depth: depth.
+ displayForm := Form extent: width @ height depth: depth.
+ displayView ifNotNil: [displayView image: displayForm]!
Item was added:
+ ----- Method: CogVMSimulator>>ioShow:D:i:s:p:l:a:y: (in category 'I/O primitives') -----
+ ioShow: destBits D: w i: h s: d p: left l: right a: top y: bottom
+ "This is the simulator's implementation of ioShowDisplay."
+ | raster pixPerWord simDisp realDisp rect |
+ displayForm ifNil: [^self].
+ displayBits = 0 ifTrue: [^self].
+ pixPerWord := 32 // d.
+ raster := displayForm width + (pixPerWord - 1) // pixPerWord.
+ simDisp := Form new hackBits: objectMemory memory.
+ displayForm unhibernate.
+ realDisp := Form new hackBits: displayForm bits.
+ realDisp
+ copy: (0 @ (top * raster) extent: 4 @ (bottom - top * raster))
+ from: 0 @ (destBits // 4 + (top * raster))
+ in: simDisp
+ rule: Form over.
+ displayView ifNotNil: [^displayView changed].
+
+ "If running without a view, just blat the bits onto the screen..."
+ rect := 0 @ top corner: displayForm width @ bottom.
+ Display
+ copy: (rect translateBy: self displayLocation)
+ from: rect topLeft
+ in: displayForm
+ rule: Form over!
Item was removed:
- ----- Method: CogVMSimulator>>primitiveBeDisplay (in category 'I/O primitives') -----
- primitiveBeDisplay
- "Extended to create a scratch Form for use by showDisplayBits."
-
- | rcvr destWidth destHeight destDepth |
- rcvr := self stackTop.
- self success: ((objectMemory isPointers: rcvr) and: [(objectMemory lengthOf: rcvr) >= 4]).
- self successful ifTrue: [
- destWidth := self fetchInteger: 1 ofObject: rcvr.
- destHeight := self fetchInteger: 2 ofObject: rcvr.
- destDepth := self fetchInteger: 3 ofObject: rcvr.
- ].
- self successful ifTrue: [
- "create a scratch form the same size as Smalltalk displayObj"
- displayForm := Form extent: destWidth @ destHeight
- depth: destDepth.
- displayView ifNotNil: [displayView image: displayForm].
- ].
- super primitiveBeDisplay!
Item was removed:
- ----- Method: CogVMSimulator>>showDisplayBits:w:h:d:left:right:top:bottom: (in category 'I/O primitives') -----
- showDisplayBits: destBits w: w h: h d: d left: left right: right top: top bottom: bottom
- | raster pixPerWord simDisp realDisp rect |
- displayForm ifNil: [^self].
- pixPerWord := 32 // d.
- raster := displayForm width + (pixPerWord - 1) // pixPerWord.
- simDisp := Form new hackBits: objectMemory memory.
- displayForm unhibernate.
- realDisp := Form new hackBits: displayForm bits.
- realDisp
- copy: (0 @ (top * raster) extent: 4 @ (bottom - top * raster))
- from: 0 @ (destBits // 4 + (top * raster))
- in: simDisp
- rule: Form over.
- displayView ifNotNil: [^ displayView changed].
-
- "If running without a view, just blat the bits onto the screen..."
- rect := 0 @ top corner: displayForm width @ bottom.
- Display
- copy: (rect translateBy: self displayLocation)
- from: rect topLeft
- in: displayForm
- rule: Form over!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveBeDisplay (in category 'I/O primitives') -----
primitiveBeDisplay
+ "Record the system Display object in the specialObjectsTable,
+ and if possible pin the display bitmap. Further, invoke ioBeDisplay
+ to alow the VM to record the location, width heigth & depth of the bitmap."
+ | rcvr bitsOop depthOop heightOop widthOop |
- "Record the system Display object in the specialObjectsTable."
- | rcvr |
rcvr := self stackTop.
+ ((objectMemory isPointers: rcvr)
+ and: [(objectMemory lengthOf: rcvr) >= 4
+ and: [bitsOop := objectMemory fetchPointer: 0 ofObject: rcvr.
+ ((objectMemory isWordsOrBytes: bitsOop)
+ or: [objectMemory isIntegerObject: bitsOop]) "for surface plugin handles"
+ and: [(objectMemory isIntegerObject: (widthOop := objectMemory fetchPointer: 1 ofObject: rcvr))
+ and: [(objectMemory isIntegerObject: (heightOop := objectMemory fetchPointer: 2 ofObject: rcvr))
+ and: [(objectMemory isIntegerObject: (depthOop := objectMemory fetchPointer: 3 ofObject: rcvr))]]]]]) ifFalse:
+ [^self primitiveFailFor: PrimErrBadReceiver].
+ objectMemory splObj: TheDisplay put: rcvr.
+ (objectMemory hasSpurMemoryManagerAPI
+ and: [(objectMemory isNonImmediate: bitsOop)
+ and: [(objectMemory isPinned: bitsOop) not]]) ifTrue:
+ [rcvr := objectMemory pinObject: bitsOop. "Answers 0 if memory required to pin bit not enough memory available."
+ rcvr ~= 0 ifTrue: [bitsOop := rcvr]].
+ self ioBeDisplay: ((objectMemory isNonImmediate: bitsOop) ifTrue: [objectMemory firstIndexableField: bitsOop] ifFalse: [bitsOop])
+ width: (objectMemory integerValueOf: widthOop)
+ height: (objectMemory integerValueOf: heightOop)
+ depth: (objectMemory integerValueOf: depthOop)!
- self success: ((objectMemory isPointers: rcvr) and: [(objectMemory lengthOf: rcvr) >= 4]).
- self successful ifTrue: [objectMemory splObj: TheDisplay put: rcvr]!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveShowDisplayRect (in category 'I/O primitives') -----
primitiveShowDisplayRect
"Force the given rectangular section of the Display to be
copied to the screen."
| bottom top right left |
bottom := self stackIntegerValue: 0.
top := self stackIntegerValue: 1.
right := self stackIntegerValue: 2.
left := self stackIntegerValue: 3.
+ self updateDisplayLeft: left Top: top Right: right Bottom: bottom.
+ self successful ifTrue:
+ [self ioForceDisplayUpdate.
+ self pop: 4]!
- self displayBitsOf: (objectMemory splObj: TheDisplay) Left: left Top: top Right: right Bottom: bottom.
- self successful
- ifTrue: [self ioForceDisplayUpdate.
- self pop: 4]!
Item was changed:
----- Method: SpurMemoryManager>>cloneInOldSpaceForPinning: (in category 'allocation') -----
cloneInOldSpaceForPinning: objOop
| numSlots fmt newObj |
numSlots := self numSlotsOf: objOop.
fmt := self formatOf: objOop.
newObj := self allocateSlotsForPinningInOldSpace: numSlots
bytes: (self objectBytesForSlots: numSlots)
format: fmt
classIndex: (self classIndexOf: objOop).
+ newObj ifNil:
+ [^0].
(self isPointersFormat: fmt)
ifTrue:
[| hasYoung |
hasYoung := false.
0 to: numSlots - 1 do:
[:i| | oop |
oop := self fetchPointer: i ofObject: objOop.
((self isNonImmediate: oop)
and: [self isForwarded: oop]) ifTrue:
[oop := self followForwarded: oop].
((self isNonImmediate: oop)
and: [self isYoungObject: oop]) ifTrue:
[hasYoung := true].
self storePointerUnchecked: i
ofObject: newObj
withValue: oop].
+ hasYoung ifTrue:
- (hasYoung
- and: [(self isYoungObject: newObj) not]) ifTrue:
[scavenger remember: newObj]]
ifFalse:
[0 to: numSlots - 1 do:
[:i|
self storePointerUnchecked: i
ofObject: newObj
withValue: (self fetchPointer: i ofObject: objOop)].
fmt >= self firstCompiledMethodFormat ifTrue:
[coInterpreter maybeFixClonedCompiledMethod: newObj.
+ ((self isYoungObject: objOop) or: [self isRemembered: objOop]) ifTrue:
- ((self isOldObject: newObj)
- and: [(self isYoungObject: objOop) or: [self isRemembered: objOop]]) ifTrue:
[scavenger remember: newObj]]].
^newObj!
Item was changed:
----- Method: SpurMemoryManager>>pinObject: (in category 'primitive support') -----
pinObject: objOop
"Attempt to pin objOop, which must not be immediate.
If the attempt succeeds answer objOop's (possibly moved) oop.
+ If the attempt fails, which can only occur if there is no memory, answer 0."
- If the attept fails, which can only occur if there is no memory, answer 0."
<inline: false>
| oldClone seg |
<var: #seg type: #'SpurSegmentInfo *'>
self assert: (self isNonImmediate: objOop).
self flag: 'policy decision here. if already old, do we clone in a segment containing pinned objects or merely pin?'.
"We choose to clone to keep pinned objects together to reduce fragmentation,
+ if the object is not too large, assuming that pinning is rare and that fragmentation is a bad thing.
+ Too large is defined as over 1mb. The size of a 640x480x4 bitmap is 1228800."
- assuming that pinning is rare and that fragmentation is a bad thing."
(self isOldObject: objOop) ifTrue:
+ [(self numBytesOf: objOop) > (1024 * 1024) ifTrue:
+ [self setIsPinnedOf: objOop to: true.
+ ^objOop].
+ seg := segmentManager segmentContainingObj: objOop.
- [seg := segmentManager segmentContainingObj: objOop.
seg containsPinned ifTrue:
[self setIsPinnedOf: objOop to: true.
^objOop].
segmentManager someSegmentContainsPinned ifFalse:
[self setIsPinnedOf: objOop to: true.
seg containsPinned: true.
^objOop]].
oldClone := self cloneInOldSpaceForPinning: objOop.
oldClone ~= 0 ifTrue:
[becomeEffectsFlags := self becomeEffectFlagsFor: objOop.
self setIsPinnedOf: oldClone to: true.
self forward: objOop to: oldClone.
self followSpecialObjectsOop.
coInterpreter postBecomeAction: becomeEffectsFlags.
self postBecomeScanClassTable: becomeEffectsFlags.
becomeEffectsFlags := 0].
^oldClone!
Item was changed:
InterpreterPrimitives subclass: #StackInterpreter
+ instanceVariableNames: 'currentBytecode bytecodeSetSelector localFP localIP localSP stackLimit stackPage stackPages method instructionPointer stackPointer framePointer localReturnValue localAbsentReceiver localAbsentReceiverOrZero extA extB numExtB primitiveFunctionPointer methodCache nsMethodCache 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 breakSelector
Length longRunningPrimitiveCheckMethod longRunningPrimitiveCheckSemaphore longRunningPrimitiveStartUsecs longRunningPrimitiveStopUsecs longRunningPrimitiveGCUsecs longRunningPrimitiveCheckSequenceNumber longRunningPrimitiveSignalUndelivered checkAllocFiller tempOop tempOop2 tempOop3 theUnknownShort the2ndUnknownShort imageFloatsBigEndian maxExtSemTabSizeSet lastMethodCacheProbeWrite gcSemaphoreIndex classByteArrayCompactIndex checkedPluginName nativeSP nativeStackPointer lowcodeCalloutState shadowCallStackPointer displayBits displayWidth displayHeight displayDepth statForceInterruptCheck statStackOverflow statStackPageDivorce statCheckForEvents statProcessSwitch statIOProcessEvents statPendingFinalizationSignals statIdleUsecs debugCallbackPath debugCallbackReturns debugCallbackInvokes'
- instanceVariableNames: 'currentBytecode bytecodeSetSelector localFP localIP localSP stackLimit stackPage stackPages method instructionPointer stackPointer framePointer localReturnValue localAbsentReceiver localAbsentReceiverOrZero extA extB numExtB primitiveFunctionPointer methodCache nsMethodCache 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 breakSelector
Length longRunningPrimitiveCheckMethod longRunningPrimitiveCheckSemaphore longRunningPrimitiveStartUsecs longRunningPrimitiveStopUsecs longRunningPrimitiveGCUsecs longRunningPrimitiveCheckSequenceNumber longRunningPrimitiveSignalUndelivered checkAllocFiller tempOop tempOop2 tempOop3 theUnknownShort the2ndUnknownShort imageFloatsBigEndian maxExtSemTabSizeSet lastMethodCacheProbeWrite gcSemaphoreIndex classByteArrayCompactIndex checkedPluginName nativeSP nativeStackPointer lowcodeCalloutState shadowCallStackPointer statForceInterruptCheck statStackOverflow statStackPageDivorce statCheckForEvents statProcessSwitch statIOProcessEvents statPendingFinalizationSignals statIdleUsecs debugCallbackPath debugCallbackReturns debugCallbackInvokes'
classVariableNames: 'AccessModifierPrivate AccessModifierProtected AccessModifierPublic AltBytecodeEncoderClassName AltLongStoreBytecode AlternateHeaderHasPrimFlag AlternateHeaderIsOptimizedFlag AlternateHeaderNumLiteralsMask AtCacheFixedFields AtCacheFmt AtCacheMask AtCacheOop AtCacheSize AtCacheTotalSize AtPutBase BytecodeEncoderClassName BytecodeTable CacheProbeMax DirBadPath DirEntryFound DirNoMoreEntries DumpStackOnLowSpace EnclosingMixinIndex EnclosingObjectIndex EnforceAccessControl FailImbalancedPrimitives LongStoreBytecode MaxExternalPrimitiveTableSize MaxJumpBuf MaxPrimitiveIndex MaxQuickPrimitiveIndex MethodHeaderArgCountShift MethodHeaderFlagBitPosition MethodHeaderTempCountShift MixinIndex PrimNumberDoExternalCall PrimNumberExternalCall PrimNumberFFICall PrimitiveTable StackPageReachedButUntraced StackPageTraceInvalid StackPageTraced StackPageUnreached V3PrimitiveBitsMask'
poolDictionaries: 'VMBasicConstants VMBytecodeConstants VMMethodCacheConstants VMObjectIndices VMSpurObjectRepresentationConstants VMSqueakClassIndices VMStackFrameOffsets'
category: 'VMMaker-Interpreter'!
!StackInterpreter commentStamp: 'eem 12/5/2014 11:32' 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 f
rame 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.
StackInterpreter and subclasses support multiple memory managers. Currently there are two. NewMemoryManager is a slightly refined version of ObjectMemory, and is the memory manager and garbage collector for the original Squeak object representation as described in "Back to the Future The Story of Squeak, A Practical Smalltalk Written in Itself", see http://ftp.squeak.org/docs/OOPSLA.Squeak.html. Spur is a faster, more regular object representation that is designed for more performance and functionality, and to have a common header format for both 32-bit and 64-bit versions. You can read about it in SpurMemoryManager's class comment. There is also a video of a presentation at ESUG 2014 (https://www.youtube.com/watch?v=k0nBNS1aHZ4), along with slides (http://www.slideshare.net/esug/spur-a-new-object-representation-for-cog?related=1).!
Item was changed:
----- Method: StackInterpreter class>>declareCVarsIn: (in category 'translation') -----
declareCVarsIn: aCCodeGenerator
| vmClass |
self class == thisContext methodClass ifFalse: [^self]. "Don't duplicate decls in subclasses"
vmClass := aCCodeGenerator vmClass. "Generate primitiveTable etc based on vmClass, not just StackInterpreter"
aCCodeGenerator
addHeaderFile:'<stddef.h> /* for e.g. alloca */';
addHeaderFile:'<setjmp.h>';
addHeaderFile:'<wchar.h> /* for wint_t */';
addHeaderFile:'"vmCallback.h"';
addHeaderFile:'"sqMemoryFence.h"';
addHeaderFile:'"dispdbg.h"'.
LowcodeVM ifTrue: [ aCCodeGenerator addHeaderFile:'"sqLowcodeFFI.h"'].
+
-
vmClass declareInterpreterVersionIn: aCCodeGenerator defaultName: 'Stack'.
aCCodeGenerator
var: #interpreterProxy type: #'struct VirtualMachine*'.
aCCodeGenerator
declareVar: #sendTrace type: 'volatile int';
declareVar: #byteCount type: #usqInt.
"These need to be pointers or unsigned."
self declareC: #(instructionPointer method newMethod)
as: #usqInt
in: aCCodeGenerator.
"These are all pointers; char * because Slang has no support for C pointer arithmetic."
self declareC: #(localIP localSP localFP nativeSP stackPointer framePointer stackLimit breakSelector nativeStackPointer nativeFramePointer shadowCallStack)
as: #'char *'
in: aCCodeGenerator.
aCCodeGenerator
var: #breakSelectorLength
declareC: 'sqInt breakSelectorLength = MinSmallInteger'.
self declareC: #(stackPage overflowedPage)
as: #'StackPage *'
in: aCCodeGenerator.
aCCodeGenerator removeVariable: 'stackPages'. "this is an implicit receiver in the translated code."
"This defines bytecodeSetSelector as 0 if MULTIPLEBYTECODESETS
is not defined, for the benefit of the interpreter on slow machines."
aCCodeGenerator addConstantForBinding: (self bindingOf: #MULTIPLEBYTECODESETS).
MULTIPLEBYTECODESETS == false ifTrue:
[aCCodeGenerator
removeVariable: 'bytecodeSetSelector'].
BytecodeSetHasExtensions == false ifTrue:
[aCCodeGenerator
removeVariable: 'extA';
removeVariable: 'extB'].
aCCodeGenerator
var: #methodCache
declareC: 'sqIntptr_t methodCache[MethodCacheSize + 1 /* ', (MethodCacheSize + 1) printString, ' */]'.
NewspeakVM
ifTrue:
[aCCodeGenerator
var: #nsMethodCache
declareC: 'sqIntptr_t nsMethodCache[NSMethodCacheSize + 1 /* ', (NSMethodCacheSize + 1) printString, ' */]']
ifFalse:
[aCCodeGenerator
removeVariable: 'localAbsentReceiver';
removeVariable: 'localAbsentReceiverOrZero'].
AtCacheTotalSize isInteger ifTrue:
[aCCodeGenerator
var: #atCache
declareC: 'sqInt atCache[AtCacheTotalSize + 1 /* ', (AtCacheTotalSize + 1) printString, ' */]'].
aCCodeGenerator
var: #primitiveTable
declareC: 'void (*primitiveTable[MaxPrimitiveIndex + 2 /* ', (MaxPrimitiveIndex + 2) printString, ' */])(void) = ', vmClass primitiveTableString.
vmClass primitiveTable do:
[:symbolOrNot|
(symbolOrNot isSymbol
and: [symbolOrNot ~~ #primitiveFail]) ifTrue:
[(aCCodeGenerator methodNamed: symbolOrNot) ifNotNil:
[:tMethod| tMethod returnType: #void]]].
vmClass objectMemoryClass hasSpurMemoryManagerAPI
ifTrue:
[aCCodeGenerator
var: #primitiveAccessorDepthTable
type: 'signed char'
sizeString: 'MaxPrimitiveIndex + 2 /* ', (MaxPrimitiveIndex + 2) printString, ' */'
array: vmClass primitiveAccessorDepthTable]
ifFalse:
[aCCodeGenerator removeVariable: #primitiveAccessorDepthTable].
aCCodeGenerator
+ var: #displayBits type: #'void *'.
+ self declareC: #(displayWidth displayHeight displayDepth) as: #int in: aCCodeGenerator.
- var: #primitiveFunctionPointer
- declareC: 'void (*primitiveFunctionPointer)()'.
aCCodeGenerator
+ var: #primitiveFunctionPointer
+ declareC: 'void (*primitiveFunctionPointer)()';
var: #externalPrimitiveTable
+ declareC: 'void (*externalPrimitiveTable[MaxExternalPrimitiveTableSize + 1 /* ', (MaxExternalPrimitiveTableSize + 1) printString, ' */])(void)';
+ var: #interruptCheckChain
+ declareC: 'void (*interruptCheckChain)(void) = 0';
+ var: #showSurfaceFn
+ declareC: 'int (*showSurfaceFn)(sqIntptr_t, int, int, int, int)';
- declareC: 'void (*externalPrimitiveTable[MaxExternalPrimitiveTableSize + 1 /* ', (MaxExternalPrimitiveTableSize + 1) printString, ' */])(void)'.
- aCCodeGenerator var: #showSurfaceFn type: #'void *'.
- aCCodeGenerator
var: #jmpBuf
+ declareC: 'jmp_buf jmpBuf[MaxJumpBuf + 1 /* ', (MaxJumpBuf + 1) printString, ' */]';
- declareC: 'jmp_buf jmpBuf[MaxJumpBuf + 1 /* ', (MaxJumpBuf + 1) printString, ' */]'.
- aCCodeGenerator
var: #suspendedCallbacks
+ declareC: 'usqInt suspendedCallbacks[MaxJumpBuf + 1 /* ', (MaxJumpBuf + 1) printString, ' */]';
- declareC: 'usqInt suspendedCallbacks[MaxJumpBuf + 1 /* ', (MaxJumpBuf + 1) printString, ' */]'.
- aCCodeGenerator
var: #suspendedMethods
+ declareC: 'usqInt suspendedMethods[MaxJumpBuf + 1 /* ', (MaxJumpBuf + 1) printString, ' */]'.
- declareC: 'usqInt suspendedMethods[MaxJumpBuf + 1 /* ', (MaxJumpBuf + 1) printString, ' */]'.
- aCCodeGenerator
- var: #interruptCheckChain
- declareC: 'void (*interruptCheckChain)(void) = 0'.
self declareCAsUSqLong: #(nextPollUsecs nextWakeupUsecs longRunningPrimitiveGCUsecs
longRunningPrimitiveStartUsecs longRunningPrimitiveStopUsecs
"these are high-frequency enough that they're overflowing quite quickly on modern hardware"
statProcessSwitch statIOProcessEvents statForceInterruptCheck
statCheckForEvents statStackOverflow statStackPageDivorce
statIdleUsecs)
in: aCCodeGenerator.
aCCodeGenerator var: #nextProfileTick type: #sqLong.
LowcodeVM ifTrue:
[aCCodeGenerator
+ var: #shadowCallStackPointer type: #'char *';
+ var: #lowcodeCalloutState type: #'sqLowcodeCalloutState*']!
- var: #shadowCallStackPointer
- type: #'char *'.
- aCCodeGenerator
- var: #lowcodeCalloutState
- type: #'sqLowcodeCalloutState*']!
Item was changed:
----- Method: StackInterpreter 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."
^(super mustBeGlobal: var)
or: [(self objectMemoryClass mustBeGlobal: var)
or: [(#('interpreterProxy' 'interpreterVersion' 'inIOProcessEvents'
+ 'deferDisplayUpdates' 'extraVMMemory'
+ 'showSurfaceFn' 'displayBits' 'displayWidth' 'displayHeight' 'displayDepth'
- 'deferDisplayUpdates' 'extraVMMemory' 'showSurfaceFn'
'desiredNumStackPages' 'desiredEdenBytes'
'breakSelector' 'breakSelectorLength' 'sendTrace' 'checkAllocFiller' 'checkedPluginName'
'suppressHeartbeatFlag' 'debugCallbackInvokes' 'debugCallbackPath' 'debugCallbackReturns') includes: var)
or: [ "This allows slow machines to define bytecodeSetSelector as 0
to avoid the interpretation overhead."
MULTIPLEBYTECODESETS not and: [var = 'bytecodeSetSelector']]]]!
Item was removed:
- ----- Method: StackInterpreter>>displayBitsOf:Left:Top:Right:Bottom: (in category 'I/O primitives') -----
- displayBitsOf: aForm Left: l Top: t Right: r Bottom: b
- "Repaint the portion of the Smalltalk screen bounded by the affected rectangle. Used to synchronize the screen after a Bitblt to the Smalltalk Display object."
-
- | displayObj dispBits w h dispBitsIndex d left right top bottom surfaceHandle |
- displayObj := objectMemory splObj: TheDisplay.
- aForm = displayObj ifFalse: [^ nil].
- self success: ((objectMemory isPointers: displayObj) and: [(objectMemory lengthOf: displayObj) >= 4]).
- self successful ifTrue: [
- dispBits := objectMemory fetchPointer: 0 ofObject: displayObj.
- w := self fetchInteger: 1 ofObject: displayObj.
- h := self fetchInteger: 2 ofObject: displayObj.
- d := self fetchInteger: 3 ofObject: displayObj.
- ].
- l < 0 ifTrue:[left := 0] ifFalse: [left := l].
- r > w ifTrue: [right := w] ifFalse: [right := r].
- t < 0 ifTrue: [top := 0] ifFalse: [top := t].
- b > h ifTrue: [bottom := h] ifFalse: [bottom := b].
- ((left <= right) and: [top <= bottom]) ifFalse: [^nil].
- self successful ifTrue: [
- (objectMemory isIntegerObject: dispBits) ifTrue: [
- surfaceHandle := objectMemory integerValueOf: dispBits.
- showSurfaceFn = 0 ifTrue: [
- showSurfaceFn := self ioLoadFunction: 'ioShowSurface' From: 'SurfacePlugin'.
- showSurfaceFn = 0 ifTrue: [^self success: false]].
- self cCode:'((int (*)(sqIntptr_t, int, int, int, int))showSurfaceFn)(surfaceHandle, left, top, right-left, bottom-top)'.
- ] ifFalse: [
- self assert: (objectMemory isNonImmediate: dispBits).
- dispBitsIndex := dispBits + objectMemory baseHeaderSize. "index in memory byte array"
- self cCode: 'ioShowDisplay(dispBitsIndex, w, h, d, left, right, top, bottom)'
- inSmalltalk: [self showDisplayBits: dispBitsIndex
- w: w h: h d: d
- left: left right: right top: top bottom: bottom]
- ].
- ]!
Item was changed:
----- Method: StackInterpreter>>fullDisplayUpdate (in category 'I/O primitive support') -----
fullDisplayUpdate
"Repaint the entire smalltalk screen, ignoring the affected rectangle. Used in some platform's code when the Smalltalk window is brought to the front or uncovered."
+ <returnTypeC: #sqInt>
+ self updateDisplayLeft: 0 Top: 0 Right: displayWidth Bottom: displayHeight.
+ self ioForceDisplayUpdate!
-
- | displayObj w h |
- displayObj := objectMemory splObj: TheDisplay.
- ((objectMemory isPointers: displayObj) and: [(objectMemory lengthOf: displayObj) >= 4]) ifTrue: [
- w := self fetchInteger: 1 ofObject: displayObj.
- h := self fetchInteger: 2 ofObject: displayObj.
- self displayBitsOf: displayObj Left: 0 Top: 0 Right: w Bottom: h.
- self ioForceDisplayUpdate].
- ^nil!
Item was changed:
----- Method: StackInterpreter>>initialize (in category 'initialization') -----
initialize
"Here we can initialize the variables C initializes to zero. #initialize methods do /not/ get translated."
checkAllocFiller := false. "must precede initializeObjectMemory:"
primFailCode := 0.
stackLimit := 0. "This is also the initialization flag for the stack system."
stackPage := overflowedPage := 0.
extraFramesToMoveOnOverflow := 0.
bytecodeSetSelector := 0.
highestRunnableProcessPriority := 0.
nextProfileTick := 0.
nextPollUsecs := 0.
nextWakeupUsecs := 0.
tempOop := tempOop2 := tempOop3 := theUnknownShort := 0.
interruptPending := false.
inIOProcessEvents := 0.
fullScreenFlag := 0.
deferDisplayUpdates := false.
+ displayBits := displayWidth := displayHeight := displayDepth := 0.
pendingFinalizationSignals := statPendingFinalizationSignals := 0.
globalSessionID := 0.
jmpDepth := 0.
longRunningPrimitiveStartUsecs := longRunningPrimitiveStopUsecs := 0.
maxExtSemTabSizeSet := false.
debugCallbackInvokes := debugCallbackPath := debugCallbackReturns := 0.
statForceInterruptCheck := statStackOverflow := statCheckForEvents :=
statProcessSwitch := statIOProcessEvents := statStackPageDivorce :=
statIdleUsecs := 0!
Item was added:
+ ----- Method: StackInterpreter>>ioBeDisplay:width:height:depth: (in category 'I/O primitive support') -----
+ ioBeDisplay: bitsOrHandle width: width height: height depth: depth
+ "Record the position and dimensions of the display bitmap, and inform
+ the display subsystem of the installation of a new display bitmap."
+ <var: #bitsOrHandle type: #'void *'>
+ | changed |
+ changed := displayBits ~= bitsOrHandle.
+ displayBits := bitsOrHandle.
+ displayWidth := width.
+ displayHeight := height.
+ displayDepth := depth.
+ self ioNoteDisplayChanged: bitsOrHandle width: width height: height depth: depth!
Item was added:
+ ----- Method: StackInterpreter>>ioNoteDisplayChanged:width:height:depth: (in category 'I/O primitive support') -----
+ ioNoteDisplayChanged: bitsOrHandle width: width height: height depth: depth
+ "The real platform may want to note the location of the display and respond to the fact of
+ its installation."
+ <doNotGenerate>!
Item was changed:
----- Method: StackInterpreter>>postGCAction: (in category 'object memory support') -----
postGCAction: gcModeArg
+ "Signal the gc semaphore, and inform the display subsystem if the display bitmap has moved."
- "Signal the gc semaphore"
+ self signalSemaphoreWithIndex: gcSemaphoreIndex.
+ objectMemory hasSpurMemoryManagerAPI ifFalse:
+ [| displayObj bitsOop bitsNow |
+ displayObj := objectMemory splObj: TheDisplay.
+ ((objectMemory isPointers: displayObj)
+ and: [(objectMemory lengthOf: displayObj) >= 4
+ and: [objectMemory isWordsOrBytes: (bitsOop := objectMemory fetchPointer: 0 ofObject: displayObj)]]) ifTrue:
+ [bitsNow := self cCode: [objectMemory firstIndexableField: bitsOop]
+ inSmalltalk: [(objectMemory firstIndexableField: bitsOop) asInteger].
+ displayBits ~= bitsNow ifTrue:
+ [displayBits := bitsNow.
+ self ioNoteDisplayChanged: displayBits width: displayWidth height: displayHeight depth: displayDepth]]]!
- self signalSemaphoreWithIndex: gcSemaphoreIndex!
Item was changed:
----- Method: StackInterpreter>>reverseDisplayFrom:to: (in category 'I/O primitive support') -----
reverseDisplayFrom: startIndex to: endIndex
+ "Reverse the given range of Display words (at different bit depths, this will reverse different numbers
+ of pixels). Used to give feedback during VM activities such as garbage collection when debugging.
+ It is assumed that the given word range falls entirely within the first line of the Display."
+ | wordStartIndex wordEndIndex primFailCodeValue |
+ (displayBits = 0 or: [(objectMemory isImmediate: displayBits asInteger) or: [displayDepth = 0]]) ifTrue: [^nil].
+ wordStartIndex := startIndex * (displayDepth // 8).
+ wordEndIndex := endIndex * (displayDepth // 8) min: displayWidth * (displayDepth // 8).
- "Reverse the given range of Display words (at different bit
- depths, this will reverse different numbers of pixels). Used to
- give feedback during VM activities such as garbage
- collection when debugging. It is assumed that the given
- word range falls entirely within the first line of the Display."
- | displayObj displayBits w wordStartIndex wordEndIndex primFailCodeValue |
- displayObj := objectMemory splObj: TheDisplay.
- ((objectMemory isPointers: displayObj) and: [(objectMemory lengthOf: displayObj) >= 4]) ifFalse: [^ nil].
- w := objectMemory fetchPointer: 1 ofObject: displayObj.
- displayBits := objectMemory fetchPointer: 0 ofObject: displayObj.
- ((objectMemory isImmediate: displayBits)
- or: [(objectMemory isNonIntegerObject: w)
- or: [objectMemory isPointersNonImm: displayBits]]) ifTrue: [^ nil].
- wordStartIndex := startIndex * 4.
- wordEndIndex := endIndex * 4 min: (objectMemory sizeBitsOf: displayBits).
- displayBits := displayBits + objectMemory baseHeaderSize.
displayBits + wordStartIndex to: displayBits + wordEndIndex by: 4 do:
+ [:ptr | | reversed |
- [:ptr | | reversed |
reversed := (objectMemory long32At: ptr) bitXor: 16rFFFFFFFF.
objectMemory long32At: ptr put: reversed].
primFailCodeValue := primFailCode.
self initPrimCall.
+ self updateDisplayLeft: 0 Top: 0 Right: displayWidth Bottom: 1.
- self displayBitsOf: displayObj Left: 0 Top: 0 Right: (objectMemory integerValueOf: w) Bottom: 1.
self ioForceDisplayUpdate.
primFailCode := primFailCodeValue!
Item was added:
+ ----- Method: StackInterpreter>>show:Sur:fa:ce:Fn: (in category 'I/O primitive support') -----
+ show: surfaceHandle Sur: left fa: top ce: width Fn: height
+ "Simulate the showSurfaceFn function call as a failure to load the surface."
+ <doNotGenerate>
+ ^0!
Item was changed:
----- Method: StackInterpreter>>showDisplayBits:Left:Top:Right:Bottom: (in category 'I/O primitive support') -----
showDisplayBits: aForm Left: l Top: t Right: r Bottom: b
"Repaint the portion of the Smalltalk screen bounded by the affected rectangle. Used to synchronize the screen after a Bitblt to the Smalltalk Display object."
+ (deferDisplayUpdates
+ or: [aForm ~= (objectMemory splObj: TheDisplay)]) ifTrue: [^nil].
+ self updateDisplayLeft: l Top: t Right: r Bottom: b!
- deferDisplayUpdates ifTrue: [^ nil].
- self displayBitsOf: aForm Left: l Top: t Right: r Bottom: b!
Item was added:
+ ----- Method: StackInterpreter>>updateDisplayLeft:Top:Right:Bottom: (in category 'I/O primitive support') -----
+ updateDisplayLeft: l Top: t Right: r Bottom: b
+ "Repaint the portion of the Smalltalk screen bounded by the affected rectangle.
+ Used to synchronize the screen after a Bitblt to the Smalltalk Display object."
+ | left right top bottom surfaceHandle |
+ left := l max: 0.
+ right := r min: displayWidth.
+ top := t max: 0.
+ bottom := b min: displayHeight.
+ (left <= right and: [top <= bottom]) ifFalse: [^nil].
+ (objectMemory isIntegerObject: displayBits asInteger)
+ ifTrue:
+ [surfaceHandle := objectMemory integerValueOf: displayBits asInteger.
+ showSurfaceFn = 0 ifTrue:
+ [showSurfaceFn := self ioLoadFunction: 'ioShowSurface' From: 'SurfacePlugin'.
+ showSurfaceFn = 0 ifTrue: [^self primitiveFailFor: PrimErrNotFound]].
+ self show: surfaceHandle Sur: left fa: top ce: right - left Fn: bottom - top]
+ ifFalse:
+ [self assert: (objectMemory isNonImmediate: displayBits asInteger).
+ self ioShow: displayBits asInteger
+ D: displayWidth i: displayHeight s: displayDepth
+ p: left l: right a: top y: bottom]!
Item was changed:
----- Method: StackInterpreterSimulator>>fullDisplay (in category 'I/O primitives') -----
fullDisplay
| primFailCodeValue |
+ displayForm ifNil: [^self].
- displayForm == nil ifTrue: [^ self].
primFailCodeValue := primFailCode.
self initPrimCall.
+ self updateDisplayLeft: 0 Top: 0 Right: displayWidth Bottom: displayHeight.
- self displayBitsOf: (objectMemory splObj: TheDisplay) Left: 0 Top: 0 Right: displayForm width Bottom: displayForm height.
primFailCode := primFailCodeValue!
Item was added:
+ ----- Method: StackInterpreterSimulator>>ioBeDisplay:width:height:depth: (in category 'I/O primitives') -----
+ ioBeDisplay: bitsOrHandleCArray width: width height: height depth: depth
+ "The real platform may want to note the location of the display and respond to the fact of
+ its installation. Here merely create a scratch form the same size as Smalltalk displayObj"
+ super ioBeDisplay: bitsOrHandleCArray asInteger width: width height: height depth: depth.
+ displayForm := Form extent: width @ height depth: depth.
+ displayView ifNotNil: [displayView image: displayForm]!
Item was added:
+ ----- Method: StackInterpreterSimulator>>ioShow:D:i:s:p:l:a:y: (in category 'I/O primitives') -----
+ ioShow: destBits D: w i: h s: d p: left l: right a: top y: bottom
+ "This is the simulator's implementation of ioShowDisplay."
+ | raster pixPerWord simDisp realDisp rect |
+ displayForm ifNil: [^self].
+ displayBits = 0 ifTrue: [^self].
+ pixPerWord := 32 // d.
+ raster := displayForm width + (pixPerWord - 1) // pixPerWord.
+ simDisp := Form new hackBits: objectMemory memory.
+ displayForm unhibernate.
+ realDisp := Form new hackBits: displayForm bits.
+ realDisp
+ copy: (0 @ (top * raster) extent: 4 @ (bottom - top * raster))
+ from: 0 @ (destBits // 4 + (top * raster))
+ in: simDisp
+ rule: Form over.
+ displayView ifNotNil: [^displayView changed].
+
+ "If running without a view, just blat the bits onto the screen..."
+ rect := 0 @ top corner: displayForm width @ bottom.
+ Display
+ copy: (rect translateBy: self displayLocation)
+ from: rect topLeft
+ in: displayForm
+ rule: Form over!
Item was removed:
- ----- Method: StackInterpreterSimulator>>primitiveBeDisplay (in category 'I/O primitives') -----
- primitiveBeDisplay
- "Extended to create a scratch Form for use by showDisplayBits."
-
- | rcvr destWidth destHeight destDepth |
- rcvr := self stackTop.
- self success: ((objectMemory isPointers: rcvr) and: [(objectMemory lengthOf: rcvr) >= 4]).
- self successful ifTrue: [
- destWidth := self fetchInteger: 1 ofObject: rcvr.
- destHeight := self fetchInteger: 2 ofObject: rcvr.
- destDepth := self fetchInteger: 3 ofObject: rcvr.
- ].
- self successful ifTrue: [
- "create a scratch form the same size as Smalltalk displayObj"
- displayForm := Form extent: destWidth @ destHeight
- depth: destDepth.
- displayView ifNotNil: [displayView image: displayForm].
- ].
- super primitiveBeDisplay!
Item was removed:
- ----- Method: StackInterpreterSimulator>>showDisplayBits:w:h:d:left:right:top:bottom: (in category 'I/O primitives') -----
- showDisplayBits: destBits w: w h: h d: d left: left right: right top: top bottom: bottom
- | raster pixPerWord simDisp realDisp rect |
- displayForm ifNil: [^self].
- pixPerWord := 32 // d.
- raster := displayForm width + (pixPerWord - 1) // pixPerWord.
- simDisp := Form new hackBits: objectMemory memory.
- displayForm unhibernate.
- realDisp := Form new hackBits: displayForm bits.
- realDisp
- copy: (0 @ (top * raster) extent: 4 @ (bottom - top * raster))
- from: 0 @ (destBits // 4 + (top * raster))
- in: simDisp
- rule: Form over.
- displayView ifNotNil: [^ displayView changed].
-
- "If running without a view, just blat the bits onto the screen..."
- rect := 0 @ top corner: displayForm width @ bottom.
- Display
- copy: (rect translateBy: self displayLocation)
- from: rect topLeft
- in: displayForm
- rule: Form over!
More information about the Vm-dev
mailing list