[Vm-dev] VM Maker: VMMaker.oscog-eem.3313.mcz
commits at source.squeak.org
commits at source.squeak.org
Wed Mar 22 17:50:23 UTC 2023
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.3313.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.3313
Author: eem
Time: 22 March 2023, 10:50:02.472629 am
UUID: eec7f9f2-1dea-4660-bacc-8f63d29beb2e
Ancestors: VMMaker.oscog-eem.3312
Have the copyBits primitives answer #'bad receiver' if loadBitBltFrom:warping: fails. Speed up noSource/noHalftone setup there-in.
Typoe. Nuke unused method.
=============== Diff against VMMaker.oscog-eem.3312 ===============
Item was removed:
- ----- Method: BitBltSimulation>>ignoreSourceOrHalftone: (in category 'setup') -----
- ignoreSourceOrHalftone: formPointer
-
- formPointer = interpreterProxy nilObject ifTrue: [ ^true ].
- combinationRule = 0 ifTrue: [ ^true ].
- combinationRule = 5 ifTrue: [ ^true ].
- combinationRule = 10 ifTrue: [ ^true ].
- combinationRule = 15 ifTrue: [ ^true ].
- ^false!
Item was changed:
----- Method: BitBltSimulation>>loadBitBltFrom:warping: (in category 'interpreter interface') -----
loadBitBltFrom: bbObj warping: aBool
"Load context from BitBlt instance. Return false if anything is amiss"
"NOTE this should all be changed to minX/maxX coordinates for simpler clipping
-- once it works!!"
| ok |
<inline: false>
bitBltOop := bbObj.
isWarping := aBool.
bitBltIsReceiver := bbObj = (interpreterProxy stackValue: interpreterProxy methodArgumentCount).
numGCsOnInvocation := interpreterProxy statNumGCs.
combinationRule := interpreterProxy fetchInteger: BBRuleIndex ofObject: bitBltOop.
(interpreterProxy failed
+ or: [(combinationRule < 0 or: [combinationRule > (OpTableSize - 2)])"operation out of range"
+ or: [(combinationRule between: 16 and: 17)]])
- or: [combinationRule < 0 or: [combinationRule > (OpTableSize - 2)]])
- ifTrue: [^false "operation out of range"].
- (combinationRule >= 16 and: [combinationRule <= 17])
ifTrue: [^false "fail for old simulated paint, erase modes"].
+ self noSourceCombinationRule
+ ifTrue: [noSource := noHalftone := true]
+ ifFalse:
+ [sourceForm := interpreterProxy fetchPointer: BBSourceFormIndex ofObject: bitBltOop.
+ noSource := sourceForm = interpreterProxy nilObject.
+ halftoneForm := interpreterProxy fetchPointer: BBHalftoneFormIndex ofObject: bitBltOop.
+ noHalftone := halftoneForm = interpreterProxy nilObject].
- sourceForm := interpreterProxy fetchPointer: BBSourceFormIndex ofObject: bitBltOop.
- noSource := self ignoreSourceOrHalftone: sourceForm.
- halftoneForm := interpreterProxy fetchPointer: BBHalftoneFormIndex ofObject: bitBltOop.
- noHalftone := self ignoreSourceOrHalftone: halftoneForm.
destForm := interpreterProxy fetchPointer: BBDestFormIndex ofObject: bbObj.
ok := self loadBitBltDestForm.
ok ifFalse:[^false].
destX := self fetchIntOrFloat: BBDestXIndex ofObject: bitBltOop ifNil: 0.
destY := self fetchIntOrFloat: BBDestYIndex ofObject: bitBltOop ifNil: 0.
width := self fetchIntOrFloat: BBWidthIndex ofObject: bitBltOop ifNil: destWidth.
height := self fetchIntOrFloat: BBHeightIndex ofObject: bitBltOop ifNil: destHeight.
interpreterProxy failed ifTrue: [^false].
noSource
ifTrue:
[sourceX := sourceY := 0]
ifFalse:
[ok := self loadBitBltSourceForm.
ok ifFalse:[^false].
ok := self loadColorMap.
ok ifFalse:[^false].
"Need the implicit setup here in case of 16<->32 bit conversions"
(cmFlags bitAnd: ColorMapNewStyle) = 0 ifTrue:[self setupColorMasks].
sourceX := self fetchIntOrFloat: BBSourceXIndex ofObject: bitBltOop ifNil: 0.
sourceY := self fetchIntOrFloat: BBSourceYIndex ofObject: bitBltOop ifNil: 0].
ok := self loadHalftoneForm.
ok ifFalse:[^false].
clipX := self fetchIntOrFloat: BBClipXIndex ofObject: bitBltOop ifNil: 0.
clipY := self fetchIntOrFloat: BBClipYIndex ofObject: bitBltOop ifNil: 0.
clipWidth := self fetchIntOrFloat: BBClipWidthIndex ofObject: bitBltOop ifNil: destWidth.
clipHeight := self fetchIntOrFloat: BBClipHeightIndex ofObject: bitBltOop ifNil: destHeight.
interpreterProxy failed ifTrue: [^ false "non-integer value"].
clipX < 0 ifTrue: [clipWidth := clipWidth + clipX. clipX := 0].
clipY < 0 ifTrue: [clipHeight := clipHeight + clipY. clipY := 0].
clipX+clipWidth > destWidth ifTrue: [clipWidth := destWidth - clipX].
clipY+clipHeight > destHeight ifTrue: [clipHeight := destHeight - clipY].
numGCsOnInvocation ~= interpreterProxy statNumGCs ifTrue: "querySurface could be a callback in loadSourceFor: and loadDestForm:"
[interpreterProxy primitiveFailFor: PrimErrObjectMoved.
^false].
^true!
Item was added:
+ ----- Method: BitBltSimulation>>noSourceCombinationRule (in category 'setup') -----
+ noSourceCombinationRule
+ <inline: #always>
+ ^combinationRule = 0
+ or: [combinationRule = 5
+ or: [combinationRule = 10
+ or: [combinationRule = 15]]]!
Item was changed:
----- Method: BitBltSimulation>>primitiveCompareColorA:to:test: (in category 'primitives') -----
primitiveCompareColorA: colorA to: colorB test: testID
"Invoke the pixel color comparing primitive.Only applicable if compiling
with ENABLE_FAST_BLT"
| rcvr val |
<export: true>
rcvr := self
primitive: 'primitiveCompareColors'
parameters: #(#Unsigned #Unsigned #SmallInteger )
receiver: #Oop.
self
cppIf: #'ENABLE_FAST_BLT'
ifTrue: [(self loadBitBltFrom: rcvr)
+ ifFalse: [^interpreterProxy primitiveFailFor: PrimErrBadReceiver].
- ifFalse: [^ interpreterProxy primitiveFail].
self clipRange.
(bbW <= 0 or: [bbH <= 0])
ifTrue: ["zero width or height; noop"
^ interpreterProxy primitiveFail].
self cCode: '
compare_operation_t op;
op.matchRule = testID & 3;
op.tally = testID & (1u<<3);
op.srcA.bits = (void *) sourceBits;
op.srcA.pitch = sourcePitch;
op.srcA.depth = sourceDepth;
op.srcA.msb = sourceMSB;
op.srcA.x = sx;
op.srcA.y = sy;
op.srcB.bits = (void *) destBits;
op.srcB.pitch = destPitch;
op.srcB.depth = destDepth;
op.srcB.msb = destMSB;
op.srcB.x = dx;
op.srcB.y = dy;
op.width = bbW;
op.height = bbH;
op.colorA = colorA;
op.colorB = colorB;
val = compareColorsDispatch(&op);'.
^val asPositiveIntegerObj]
ifFalse: [interpreterProxy primitiveFail]!
Item was changed:
----- Method: BitBltSimulation>>primitiveCopyBits (in category 'primitives') -----
primitiveCopyBits
"Invoke the copyBits primitive. If the destination is the display, then copy it to the screen."
| rcvr |
<export: true>
rcvr := interpreterProxy stackValue: interpreterProxy methodArgumentCount.
(self loadBitBltFrom: rcvr) ifFalse:
+ [^interpreterProxy primitiveFailFor: PrimErrBadReceiver].
- [^interpreterProxy primitiveFail].
self copyBits.
interpreterProxy failed ifTrue: [^nil].
self showDisplayBits.
interpreterProxy failed ifTrue: [^nil].
(combinationRule = 22 or: [combinationRule = 32])
ifTrue: [interpreterProxy methodReturnInteger: bitCount]
ifFalse: [interpreterProxy methodReturnReceiver]!
Item was changed:
----- Method: BitBltSimulation>>primitiveDisplayString (in category 'primitives') -----
primitiveDisplayString
<export: true>
| kernDelta xTable glyphMap stopIndex startIndex sourceString bbObj maxGlyph ascii glyphIndex sourcePtr left quickBlt |
<var: 'sourcePtr' type: #'char *'>
interpreterProxy methodArgumentCount = 6 ifFalse:
[^interpreterProxy primitiveFail].
kernDelta := interpreterProxy stackIntegerValue: 0.
xTable := interpreterProxy stackValue: 1.
glyphMap := interpreterProxy stackValue: 2.
stopIndex := interpreterProxy stackIntegerValue: 3.
startIndex := interpreterProxy stackIntegerValue: 4.
sourceString := interpreterProxy stackValue: 5.
bbObj := interpreterProxy stackObjectValue: 6.
interpreterProxy failed ifTrue:
[^nil].
+ (self loadBitBltFrom: bbObj) ifFalse:
+ [^interpreterProxy primitiveFailFor: PrimErrBadReceiver].
-
((interpreterProxy isArray: xTable)
and: [(interpreterProxy isArray: glyphMap)
and: [(interpreterProxy slotSizeOf: glyphMap) = 256
and: [(interpreterProxy isBytes: sourceString)
and: [startIndex > 0
and: [stopIndex >= 0 "to avoid failing for empty strings..."
and: [stopIndex <= (interpreterProxy byteSizeOf: sourceString)
- and: [(self loadBitBltFrom: bbObj)
and: [combinationRule ~= 30 "these two need extra source alpha"
+ and: [combinationRule ~= 31]]]]]]]]) ifFalse:
+ [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
- and: [combinationRule ~= 31]]]]]]]]]) ifFalse:
- [^interpreterProxy primitiveFail].
stopIndex = 0 ifTrue:
[^interpreterProxy pop: 6 "the string is empty; pop args, return rcvr"].
maxGlyph := (interpreterProxy slotSizeOf: xTable) - 2.
"See if we can go directly into copyLoopPixMap (usually we can)"
quickBlt := destBits ~= 0 "no OS surfaces please"
and:[sourceBits ~= 0 "and again"
and:[noSource = false "needs a source"
and:[sourceForm ~= destForm "no blits onto self"
and:[cmFlags ~= 0
or:[sourceMSB ~= destMSB
or:[sourceDepth ~= destDepth]]]]]]. "no point using slower version"
quickBlt
ifTrue:
[endOfSource := sourceBits + (sourcePitch * sourceHeight).
endOfDestination := destBits + (destPitch * destHeight)]
ifFalse:
[self lockSurfaces ifFalse:
[^interpreterProxy primitiveFail]].
left := destX.
sourcePtr := interpreterProxy firstIndexableField: sourceString.
startIndex to: stopIndex do:
[:charIndex|
ascii := interpreterProxy byteAtPointer: sourcePtr + charIndex - 1.
glyphIndex := interpreterProxy fetchInteger: ascii ofObject: glyphMap.
(glyphIndex < 0 or: [glyphIndex > maxGlyph]) ifTrue:
+ [^interpreterProxy primitiveFailFor: PrimErrBadIndex].
- [^interpreterProxy primitiveFail].
sourceX := interpreterProxy fetchInteger: glyphIndex ofObject: xTable.
width := (interpreterProxy fetchInteger: glyphIndex + 1 ofObject: xTable) - sourceX.
interpreterProxy failed ifTrue:
[^nil].
self clipRange. "Must clip here"
(bbW > 0 and: [bbH > 0]) ifTrue:
[quickBlt
ifTrue:
[self destMaskAndPointerInit.
self copyLoopPixMap.
"both, hDir and vDir are known to be > 0"
affectedL := dx.
affectedR := dx + bbW.
affectedT := dy.
affectedB := dy + bbH]
ifFalse:
[self copyBitsLockedAndClipped]].
interpreterProxy failed ifTrue:
[^nil].
destX := destX + width + kernDelta].
affectedL := left.
quickBlt ifFalse:
[self unlockSurfaces].
self showDisplayBits.
"store destX back"
interpreterProxy storeInteger: BBDestXIndex ofObject: bbObj withValue: destX.
interpreterProxy pop: 6 "pop args, return rcvr"!
Item was changed:
----- Method: BitBltSimulation>>primitiveDrawLoop (in category 'primitives') -----
primitiveDrawLoop
"Invoke the line drawing primitive."
| rcvr xDelta yDelta |
<export: true>
rcvr := interpreterProxy stackValue: 2.
xDelta := interpreterProxy stackIntegerValue: 1.
yDelta := interpreterProxy stackIntegerValue: 0.
+ (self loadBitBltFrom: rcvr) ifFalse:
+ [^interpreterProxy primitiveFailFor: PrimErrBadReceiver].
+ interpreterProxy failed ifFalse:
+ [self drawLoopX: xDelta Y: yDelta.
+ self showDisplayBits.
+ interpreterProxy failed ifFalse:
+ [interpreterProxy pop: 2]]!
- (self loadBitBltFrom: rcvr) ifFalse:[^interpreterProxy primitiveFail].
- interpreterProxy failed ifFalse:[
- self drawLoopX: xDelta Y: yDelta.
- self showDisplayBits].
- interpreterProxy failed ifFalse:[interpreterProxy pop: 2].!
Item was changed:
----- Method: SpurGenerationScavenger>>computeRefCountToShrinkRT (in category 'remembered set') -----
computeRefCountToShrinkRT
"Some time in every scavenger's life there may come a time when someone writes code that stresses
the remembered table. One might conclude that if the remembered table is full, then the right thing
+ to do is simply to tenure everything, emptying the remembered table. But in some circumstances this
- to do is simply to tenure everything, emptying the remembered table. Bt in some circumstances this
can be counter-productive, and result in the same situation arising soon after tenuring everything.
Instead, we can try and selectively prune the remembered table, tenuring only those objects that
are referenced by many objects in the remembered table. That's what this algorithm does. It
reference counts young objects referenced from the remembered set, and then sets a threshold
used to tenure objects oft referenced from the remembered set, thereby allowing the remembered
set to shrink, while not tenuring everything.
Once in a network monitoring application in a galaxy not dissimilar from the one this code inhabits,
a tree of nodes referring to large integers was in precisely this situation. The nodes were old, and
the integers were in new space. Some of the nodes referred to shared numbers, some their own
unique numbers. The numbers were updated frequently. Were new space simply tenured when the
remembered table was full, the remembered table would soon fill up as new numbers were computed.
Only by selectively pruning the remembered table of nodes that shared data, was a balance achieved
whereby the remembered table population was kept small, and tenuring rates were low."
<inline: #never>
| population |
<var: 'population' declareC: 'long population[MaxRTRefCount + 1]'>
self cCode: [self memset: population _: 0 _: (self sizeof: #long) * (MaxRTRefCount + 1)]
inSmalltalk: [population := CArrayAccessor on: (Array new: MaxRTRefCount + 1 withAll: 0)].
self assert: self allNewSpaceObjectsHaveZeroRTRefCount.
self referenceCountRememberedReferents: population.
self setRefCountToShrinkRT: population
"For debugging:
(manager allNewSpaceObjectsDo: [:o| manager rtRefCountOf: o put: 0])"!
Item was removed:
- ----- Method: SpurGenerationScavenger>>followRememberedForwardersAndForgetFreeObjectsForPigCompact (in category 'gc - global') -----
- followRememberedForwardersAndForgetFreeObjectsForPigCompact
- "Scan the remembered set. Follow any forwarded objects,
- and remove free objects. This is for global scan-mark GC."
- | index obj |
- index := 0.
- [index < rememberedSetSize] whileTrue:
- [obj := rememberedSet at: index.
- (manager isFreeObject: obj) "free; remove by overwriting with last element"
- ifTrue:
- [rememberedSetSize := rememberedSetSize - 1.
- rememberedSet at: index put: (rememberedSet at: rememberedSetSize)]
- ifFalse:
- [(manager isForwarded: obj) ifTrue:
- [manager setIsRememberedOf: obj to: false.
- obj := manager followForwarded: obj.
- self assert: (manager isRemembered: obj).
- rememberedSet at: index put: obj].
- index := index + 1]]!
More information about the Vm-dev
mailing list