[Vm-dev] VM Maker: VMMaker.oscog-nice.3248.mcz

commits at source.squeak.org commits at source.squeak.org
Mon Aug 22 16:07:52 UTC 2022 

Nicolas Cellier uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-nice.3248.mcz

==================== Summary ====================

Name: VMMaker.oscog-nice.3248
Author: nice
Time: 22 August 2022, 6:07:40.424529 pm
UUID: 230bfa37-4d77-4fa6-a944-f7a51bf9dc32
Ancestors: VMMaker.oscog-eem.3247

Fix alpha blending by proper division by 255 instead of >> 8 (division by 256).
See https://github.com/OpenSmalltalk/opensmalltalk-vm/issues/643

Let alphaBlendConst round to nearest rather than round to upper.

Fix shifting of size_t which is known to be unsigned.

=============== Diff against VMMaker.oscog-eem.3247 ===============

Item was changed:
  ----- Method: BitBltSimulation>>alphaBlendConst:with:paintMode: (in category 'combination rules') -----
  alphaBlendConst: sourceWord with: destinationWord paintMode: paintMode
  	"Blend sourceWord with destinationWord using a constant alpha.
  	Alpha is encoded as 0 meaning 0.0, and 255 meaning 1.0.
  	The blend produced is alpha*source + (1.0-alpha)*dest, with the
  	computation being performed independently on each color component.
  	This function could eventually blend into any depth destination,
  	using the same color averaging and mapping as warpBlt.
  	paintMode = true means do nothing if the source pixel value is zero."
  
  	"This first implementation works with dest depths of 16 and 32 bits only.
  	Normal color mapping will allow sources of lower depths in this case,
  	and results can be mapped directly by truncation, so no extra color maps are needed.
  	To allow storing into any depth will require subsequent addition of two other
  	colormaps, as is the case with WarpBlt."
  
  	| pixMask destShifted sourceShifted destPixVal rgbMask sourcePixVal unAlpha result pixBlend shift blend maskShifted bitsPerColor blendAG blendRB |
  	<inline: false>
  	<returnTypeC: 'unsigned int'>
  	<var: 'sourceWord' type: #'unsigned int'>
  	<var: 'destinationWord' type: #'unsigned int'>
  	<var: 'blendRB' type: #'unsigned int'>
  	<var: 'blendAG' type: #'unsigned int'>
  	<var: 'result' type: #'unsigned int'>
  	<var: 'sourceAlpha' type: #'unsigned int'>
  	<var: 'unAlpha' type: #'unsigned int'>
  	<var: 'sourceShifted' type: #'unsigned int'>
  	<var: 'destShifted' type: #'unsigned int'>
  	<var: 'maskShifted' type: #'unsigned int'>
  	<var: 'pixMask' type: #'unsigned int'>
  	<var: 'rgbMask' type: #'unsigned int'>
  	<var: 'pixBlend' type: #'unsigned int'>
  	<var: 'blend' type: #'unsigned int'>
  	destDepth < 16 ifTrue: [^ destinationWord "no-op"].
  	unAlpha := 255 - sourceAlpha.
  	result := destinationWord.
  	destPPW = 1 ifTrue:["32bpp blends include alpha"
  		paintMode & (sourceWord = 0)  "painting a transparent pixel" ifFalse:[
  
  				blendRB := ((sourceWord bitAnd: 16rFF00FF) * sourceAlpha) +
+ 						((destinationWord bitAnd: 16rFF00FF) * unAlpha) + 16r800080.	"blend red and blue"
- 						((destinationWord bitAnd: 16rFF00FF) * unAlpha) + 16rFF00FF.	"blendRB red and blue"
  
  				blendAG := ((sourceWord>> 8 bitAnd: 16rFF00FF) * sourceAlpha) +
+ 						((destinationWord>>8 bitAnd: 16rFF00FF) * unAlpha) + 16r800080.	"blend alpha and green"
- 						((destinationWord>>8 bitAnd: 16rFF00FF) * unAlpha) + 16rFF00FF.	"blendRB alpha and green"
  
+ 				blendRB := blendRB >> 8 + blendRB >> 8 bitAnd: 16rFF00FF.	"divide by 255"
+ 				blendAG := blendAG >> 8 + blendAG >> 8 bitAnd: 16rFF00FF.
- 				blendRB := blendRB + (blendRB - 16r10001 >> 8 bitAnd: 16rFF00FF) >> 8 bitAnd: 16rFF00FF.	"divide by 255"
- 				blendAG := blendAG + (blendAG - 16r10001 >> 8 bitAnd: 16rFF00FF) >> 8 bitAnd: 16rFF00FF.
  				result := blendRB bitOr: blendAG<<8.
  		].
  	] ifFalse:[
  		pixMask := maskTable at: destDepth.
  		bitsPerColor := 5.
  		rgbMask := 16r1F.
  		maskShifted := destMask.
  		destShifted := destinationWord.
  		sourceShifted := sourceWord.
  		1 to: destPPW do:[:j |
  			sourcePixVal := sourceShifted bitAnd: pixMask.
  			((maskShifted bitAnd: pixMask) = 0  "no effect if outside of dest rectangle"
  				or: [paintMode & (sourcePixVal = 0)  "or painting a transparent pixel"])
  			ifFalse:
  				[destPixVal := destShifted bitAnd: pixMask.
  				pixBlend := 0.
  				1 to: 3 do:
  					[:i | shift := (i-1)*bitsPerColor.
  					blend := (((sourcePixVal>>shift bitAnd: rgbMask) * sourceAlpha)
  								+ ((destPixVal>>shift bitAnd: rgbMask) * unAlpha))
+ 						 	+ 128. "+128 for rounding"
+ 					blend := blend >> 8 + blend >> 8 bitAnd: rgbMask. "divide by 255"
- 						 	+ 254 // 255 bitAnd: rgbMask.
  					pixBlend := pixBlend bitOr: blend<<shift].
  				result := (result bitAnd: (pixMask << (j-1*16)) bitInvert32)
  								bitOr: pixBlend << (j-1*16)].
  			maskShifted := maskShifted >> destDepth.
  			sourceShifted := sourceShifted >> destDepth.
  			destShifted := destShifted >> destDepth].
  	].
  	^ result
  !

Item was changed:
  ----- Method: BitBltSimulation>>alphaBlendScaled:with: (in category 'combination rules') -----
  alphaBlendScaled: sourceWord with: destinationWord
  	"Blend sourceWord with destinationWord using the alpha value from sourceWord.
  	Alpha is encoded as 0 meaning 0.0, and 255 meaning 1.0.
  	In contrast to alphaBlend:with: the color produced is
  
  		srcColor + (1-srcAlpha) * dstColor
  
  	e.g., it is assumed that the source color is already scaled."
  	<returnTypeC: #'unsigned int'>
  	<inline: false>	"Do NOT inline this into optimized loops"
  	| unAlpha rb ag |
  	<var: 'sourceWord' type: #'unsigned int'>
  	<var: 'destinationWord' type: #'unsigned int'>
  	<var: 'rb' type: #'unsigned int'>
  	<var: 'ag' type: #'unsigned int'>
  	<var: 'unAlpha' type: #'unsigned int'>
  	unAlpha := 255 - (sourceWord >> 24).  "High 8 bits of source pixel is source opacity (ARGB format)"
+ 	rb := (destinationWord bitAnd: 16rFF00FF) * unAlpha + 16r800080. "add 16r80 for rounding division to nearest byte"
+ 	rb := rb >> 8 + rb >> 8. "divide by 255"
+ 	rb := (rb bitAnd: 16rFF00FF) + (sourceWord bitAnd: 16rFF00FF). "blend red and blue components"
+ 	ag := (destinationWord >> 8 bitAnd: 16rFF00FF) * unAlpha + 16r800080. "add 16r80 for rounding division to nearest byte"
+ 	ag := ag >> 8 + ag >> 8. "divide by 255"
+ 	ag := (ag bitAnd: 16rFF00FF) + (sourceWord >> 8 bitAnd: 16rFF00FF). "blend alpha and green components"
- 	rb := ((destinationWord bitAnd: 16rFF00FF) * unAlpha >> 8 bitAnd: 16rFF00FF) + (sourceWord bitAnd: 16rFF00FF). "blend red and blue components"
- 	ag := ((destinationWord >> 8 bitAnd: 16rFF00FF) * unAlpha >> 8 bitAnd: 16rFF00FF) + (sourceWord >> 8 bitAnd: 16rFF00FF). "blend alpha and green components"
  	rb := (rb bitAnd: 16rFF00FF) bitOr: (rb bitAnd: 16r01000100) * 16rFF >> 8. "saturate red and blue components if there is a carry"
  	ag := (ag bitAnd: 16rFF00FF) << 8 bitOr: (ag bitAnd: 16r01000100) * 16rFF. "saturate alpha and green components if there is a carry"
  	^ag bitOr: rb "recompose"!

Item was changed:
  ----- Method: BitBltSimulation>>alphaBlendUnscaled:with: (in category 'combination rules') -----
  alphaBlendUnscaled: sourceWord with: destinationWord
  	"Blend sourceWord with destinationWord using the alpha value from both sourceWord and destinationWord.
  	Alpha is encoded as 0 meaning 0.0, and 255 meaning 1.0.
  	The alpha channel and color produced are
  
  		srcAlpha + (destAlpha*(1-srcAlpha))
  		(srcAlpha*srcColor + (destAlpha*(1-srcAlpha)*dstColor)) / (srcAlpha + (destAlpha*(1-srcAlpha)))
  
  	In contrast to alphaBlend:with: the method does not assume that destination form is opaque.
  	In contrast to alphaBlendScaled:with: the method does not assume that colors have been pre-scaled (muliplied) by alpha channel."
  	| alpha blendA result blendR blendB blendG |
  	<inline: false>
  	<returnTypeC: 'unsigned int'>
  	<var: 'sourceWord' type: #'unsigned int'>
  	<var: 'destinationWord' type: #'unsigned int'>
  	<var: 'blendA' type: #'unsigned int'>
  	<var: 'blendR' type: #'unsigned int'>
  	<var: 'blendG' type: #'unsigned int'>
  	<var: 'blendB' type: #'unsigned int'>
  	<var: 'result' type: #'unsigned int'>
  	<var: 'alpha' type: #'unsigned int'>
  	alpha := sourceWord >> 24.  "High 8 bits of source pixel, assuming ARGB encoding"
  	alpha = 0 ifTrue: [ ^ destinationWord ].
  	alpha = 255 ifTrue: [ ^ sourceWord ].
  	
  	blendA := 16rFF * alpha + (16rFF - alpha * (destinationWord >> 24)) + 16r80. "blend alpha channels"
+ 	blendA := blendA >> 8 + blendA >> 8 bitAnd: 16rFF. "divide by 255"
- 	blendA := blendA + (blendA - 1 >> 8 bitAnd: 16rFF) >> 8 bitAnd: 16rFF. "divide by 255"
  
  	blendR := ((sourceWord bitAnd: 16rFF0000) * alpha) +
  				((destinationWord bitAnd: 16rFF0000) * (blendA-alpha))
  				+(blendA<<15)
  				// blendA bitAnd: 16rFF0000.	"blend red"
  					
  	blendG := ((sourceWord bitAnd: 16r00FF00) * alpha) +
  				((destinationWord bitAnd: 16r00FF00) * (blendA-alpha))
  				+(blendA<<7)
  				// blendA bitAnd: 16r00FF00.	"blend green"
  
  	blendB := ((sourceWord bitAnd: 16r0000FF) * alpha) +
  				((destinationWord bitAnd: 16r0000FF) * (blendA-alpha))
  				+(blendA>>1)
  				// blendA bitAnd: 16r0000FF.	"blend blue"
  					
  	result := ((blendR bitOr: blendB) bitOr: blendG) bitOr: blendA << 24.
  	^ result
  !

Item was changed:
  ----- Method: CCodeGenerator>>generateShiftLeft:on:indent: (in category 'C translation') -----
  generateShiftLeft: msgNode on: aStream indent: level
  	"Generate a C bitShift.  If the receiver type is unsigned avoid C99 undefined behaviour of
  	 left shifting negative values (what?!!?!!? such quiche eating idiocy to treat this like anything
  	 other than a truncated left shift) by casting signed receiver types to unsigned and back.
  	 If we can determine the result would overflow the word size, cast to a long integer."
  	| rcvr arg castToLong type mustCastBackToSign mustCastToUnsigned canSuffixTheConstant typeIsUnsigned |
  	(self generateAsConstantExpression: msgNode on: aStream) ifTrue:
  		[^self].
  	rcvr := msgNode receiver.
  	arg := msgNode args first.
  	castToLong := false.
  	(rcvr constantNumbericValueIfAtAllPossibleOrNilIn: self) ifNotNil:
  		[:rcvrVal |
  		 (arg constantNumbericValueIfAtAllPossibleOrNilIn: self)
  			ifNil: [castToLong := vmClass notNil and: [vmClass objectMemoryClass wordSize = 8]]
  			ifNotNil:
  				[:argVal |
  				| valueBeyondInt |
  				valueBeyondInt := 1 bitShift: 32. "The default type of const << N is int."
  				castToLong := rcvrVal < valueBeyondInt
  								  and: [(rcvrVal bitShift: argVal) >= valueBeyondInt]]].
  	canSuffixTheConstant := rcvr isConstant and: [rcvr name isEmpty and: [rcvr value >= 0]].
  	canSuffixTheConstant ifTrue:
  		[aStream nextPutAll: (self cLiteralForUnsignedInteger: rcvr value longlong: castToLong).
  		aStream nextPutAll: ' << '.
  		self emitCExpression: arg on: aStream indent: level.
  		^self].
  	type := self typeFor: rcvr in: currentMethod.
  	castToLong := castToLong and: [(self sizeOfIntegralCType: type) < (self sizeOfIntegralCType: #usqLong)].
+ 	typeIsUnsigned := type first = $u or: [type = #'size_t'].
- 	typeIsUnsigned := type first = $u.
  	mustCastToUnsigned := typeIsUnsigned not
  							or: [castToLong
  							or: [(self sizeOfIntegralCType: type) < (self sizeOfIntegralCType: #usqInt)]].
  	mustCastBackToSign := typeIsUnsigned not.
  	mustCastBackToSign ifTrue:
  		[| promotedType |
  		promotedType := castToLong
  			ifTrue: [#sqLong]
  			ifFalse: [(self sizeOfIntegralCType: type) < (self sizeOfIntegralCType: #sqInt)
  				ifTrue: [#sqInt]
  				ifFalse: [type]].
  		aStream nextPutAll: '(('; nextPutAll: promotedType; nextPut: $)].
  	mustCastToUnsigned ifTrue:
  		[| unsigned |
  		unsigned := castToLong
  			ifTrue: [#usqLong]
  			ifFalse: [(self sizeOfIntegralCType: type) < (self sizeOfIntegralCType: #usqLong)
  				ifTrue: [#usqInt]
  				ifFalse: [self unsignedTypeForIntegralType: type]].
  		aStream nextPutAll: '(('; nextPutAll: unsigned; nextPutAll: ')('].
  	self emitCExpression: rcvr on: aStream indent: level.
  	mustCastToUnsigned ifTrue: [aStream nextPut: $)].
  
  	aStream nextPutAll: ' << '.
  	self emitCExpression: arg on: aStream indent: level.
  
  	mustCastToUnsigned ifTrue: [aStream nextPut: $)].
  	mustCastBackToSign ifTrue: [aStream nextPut: $)]!

Item was changed:
  ----- Method: CCodeGenerator>>generateSignedShiftRight:on:indent: (in category 'C translation') -----
  generateSignedShiftRight: msgNode on: aStream indent: level
  	"Generate the C code for >>> onto the given stream."
  
  	| type typeIsUnsigned mustCastToSigned signedType |
  	type := self typeFor: msgNode receiver in: currentMethod.
+ 	typeIsUnsigned := type first = $u or: [type = #'size_t'].
- 	typeIsUnsigned := type first = $u.
  	mustCastToSigned := typeIsUnsigned or:
  		["cast to sqInt if the int is shorter: we want to avoid UB related to a shift exceeeding bit width"
  		(self sizeOfIntegralCType: type) < (self sizeOfIntegralCType: #usqInt)].
  	mustCastToSigned
  		ifTrue:
  			["If the variable is a 64-bit type then don't cast it to usqInt (typically a 32-bit type)"
  			signedType := (self sizeOfIntegralCType: type) < (self sizeOfIntegralCType: #usqLong)
  				ifTrue: [#sqInt]
  				ifFalse: [self signedTypeForIntegralType: type].
  			 aStream nextPutAll: '(('; nextPutAll: signedType; nextPutAll: ')('.
  			 self emitCExpression: msgNode receiver on: aStream indent: level.
  			 aStream nextPutAll: '))']
  		ifFalse:
  			[aStream nextPutAll: '('.
  			 self emitCExpression: msgNode receiver on: aStream indent: level.
  			 aStream nextPut: $)].
  	aStream nextPutAll: ' >> '.
  	self emitCExpression: msgNode args first on: aStream!

Item was changed:
  ----- Method: CCodeGenerator>>signedTypeForIntegralType: (in category 'type inference') -----
  signedTypeForIntegralType: aCTypeString
  	(aCTypeString beginsWith: 'unsigned ') ifTrue:
  		[^aCTypeString allButFirst: 8].
  	
  	(aCTypeString beginsWith: 'usq') ifTrue:
  		[^aCTypeString allButFirst].
  
+ 	aCTypeString = #'size_t' ifTrue:
+ 		["could be ssize_t if only it were universal...
+ 		 On all targetted systems so far, this is as long as a pointer type."
+ 		^#sqIntptr_t].
- 	aCTypeString = 'size_t' ifTrue: [^#usqIntptr_t].
  	
  	self error: 'unknown type'.
  	^#long!

Item was changed:
  ----- Method: CCodeGenerator>>unsignedTypeForIntegralType: (in category 'type inference') -----
  unsignedTypeForIntegralType: aCTypeString
  	^aCTypeString first = $u
  		ifTrue: [aCTypeString]
  		ifFalse:
  			[(aCTypeString beginsWith: 'sq')
  				ifTrue: ['u' , aCTypeString]
+ 				ifFalse: [aCTypeString = #'size_t'
+ 					ifTrue: [aCTypeString]
+ 					ifFalse: ['unsigned ' , aCTypeString]]]!
- 				ifFalse: ['unsigned ' , aCTypeString]]!

More information about the Vm-dev mailing list