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

Nicolas Cellier nicolas.cellier.aka.nice at gmail.com
Thu Mar 31 20:12:29 UTC 2016


Note that I have these "changes" working for 5 months now, so they should
be reasonnably stable
I'm not particularly happy with the proliferation of type hint and some of
them might well be unecessary, but I don't believe in chirurgical patch:
too fragile, I prefer uniformity.

2016-03-31 22:06 GMT+02:00 <commits at source.squeak.org>:

>
> Nicolas Cellier uploaded a new version of VMMaker to project VM Maker:
> http://source.squeak.org/VMMaker/VMMaker.oscog-nice.1754.mcz
>
> ==================== Summary ====================
>
> Name: VMMaker.oscog-nice.1754
> Author: nice
> Time: 31 March 2016, 10:04:44.274 pm
> UUID: a0138c60-3e62-446e-a1d8-b00b7bb6c92b
> Ancestors: VMMaker.oscog-eem.1753
>
> BitBltSimulation is operating on bits of 32bits words, therefore it's
> better to declare its operans as 'unsigned int' rather than sqInt.
>
> On 32bits VM, this should not change anything, but on 64bits spur, it
> makes this snippet work:
>
> | wideString source pos blt expectedWideString |
> source := #[1 64 255 14 1 64 48 251].
> expectedWideString := WideString fromByteArray: source.
> wideString := WideString new: source size // 4.
> pos := 0.
> blt := (BitBlt
>         toForm: (Form new hackBits: wideString))
>         sourceForm: (Form new hackBits: source).
> blt
>         combinationRule: Form over;
>         sourceX: 0;
>         sourceY: pos // 4;
>         height: wideString byteSize // 4;
>         width: 4;
>         destX: 0;
>         destY: 0;
>         copyBits.
> wideString restoreEndianness.
> self assert: wideString = expectedWideString
>
> Hence it fix loading/diffing MCZ with wide character.
>
> =============== Diff against VMMaker.oscog-eem.1753 ===============
>
> Item was changed:
>   ----- Method: BitBltSimulation>>addWord:with: (in category 'combination
> rules') -----
>   addWord: sourceWord with: destinationWord
> +       <returnTypeC: 'unsigned int'>
> +       <var: #sourceWord type: 'unsigned int'>
> +       <var: #destinationWord type: 'unsigned int'>
>         ^sourceWord + destinationWord!
>
> Item was changed:
>   ----- Method: BitBltSimulation>>alphaBlend:with: (in category
> 'combination rules') -----
>   alphaBlend: sourceWord with: destinationWord
>         "Blend sourceWord with destinationWord, assuming both are 32-bit
> pixels.
>         The source is assumed to have 255*alpha in the high 8 bits of each
> pixel,
>         while the high 8 bits of the destinationWord will be ignored.
>         The blend produced is alpha*source + (1-alpha)*dest, with
>         the computation being performed independently on each color
>         component.  The high byte of the result will be 0."
>         | alpha unAlpha result blendRB blendAG |
>         <inline: false>
> +       <returnTypeC: 'unsigned int'>
> -       <return: '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: #alpha type: 'unsigned int'>
>         <var: #unAlpha type: 'unsigned int'>
>         alpha := sourceWord >> 24.  "High 8 bits of source pixel"
>         alpha = 0 ifTrue: [ ^ destinationWord ].
>         alpha = 255 ifTrue: [ ^ sourceWord ].
>         unAlpha := 255 - alpha.
>
>         blendRB := ((sourceWord bitAnd: 16rFF00FF) * alpha) +
>                                 ((destinationWord bitAnd: 16rFF00FF) *
> unAlpha)
>                                 + 16rFF00FF.    "blend red and blue"
>
>         blendAG := (((sourceWord>> 8 bitOr: 16rFF0000) bitAnd: 16rFF00FF)
> * alpha) +
>                                 ((destinationWord>>8 bitAnd: 16rFF00FF) *
> unAlpha)
>                                 + 16rFF00FF.    "blend alpha and green"
>
>         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.
>         ^ result
>   !
>
> Item was changed:
>   ----- Method: BitBltSimulation>>alphaBlendConst:with: (in category
> 'combination rules') -----
>   alphaBlendConst: sourceWord with: destinationWord
> +       <returnTypeC: 'unsigned int'>
> +       <var: #sourceWord type: 'unsigned int'>
> +       <var: #destinationWord type: 'unsigned int'>
>
>         ^ self alphaBlendConst: sourceWord with: destinationWord
> paintMode: false!
>
> 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'>
> -       <return: '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) + 16rFF00FF.    "blendRB red and blue"
>
>                                 blendAG := ((sourceWord>> 8 bitAnd:
> 16rFF00FF) * sourceAlpha) +
>                                                 ((destinationWord>>8
> bitAnd: 16rFF00FF) * unAlpha) + 16rFF00FF. "blendRB alpha and green"
>
>                                 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))
>                                                         + 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."
>         | unAlpha rb ag |
>         <inline: false> "Do NOT inline this into optimized loops"
> +       <returnTypeC: 'unsigned int'>
>         <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 >> 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: 16r1000100) *
> 16rFF >> 8. "saturate red and blue components if there is a carry"
>         ag := (ag bitAnd: 16rFF00FF) << 8 bitOr: (ag bitAnd: 16r1000100) *
> 16rFF. "saturate alpha and green components if there is a carry"
>         ^ag bitOr: rb "recompose"!
>
> Item was changed:
>   ----- Method: BitBltSimulation>>alphaPaintConst:with: (in category
> 'combination rules') -----
>   alphaPaintConst: sourceWord with: destinationWord
> +       <returnTypeC: 'unsigned int'>
> +       <var: #sourceWord type: 'unsigned int'>
> +       <var: #destinationWord type: 'unsigned int'>
>
>         sourceWord = 0 ifTrue: [^ destinationWord  "opt for
> all-transparent source"].
>         ^ self alphaBlendConst: sourceWord with: destinationWord
> paintMode: true!
>
> Item was changed:
>   ----- Method: BitBltSimulation>>alphaSourceBlendBits16 (in category
> 'inner loop') -----
>   alphaSourceBlendBits16
>         "This version assumes
>                 combinationRule = 34
>                 sourcePixSize = 32
>                 destPixSize = 16
>                 sourceForm ~= destForm.
>         "
>         | srcIndex dstIndex sourceWord srcAlpha destWord deltaX deltaY
>         srcY dstY dstMask srcShift ditherBase ditherIndex ditherThreshold |
>         <inline: false> "This particular method should be optimized in
> itself"
> +       <var: #sourceWord type: #'unsigned int'>
> +       <var: #destWord type: #'unsigned int'>
> +       <var: #dstMask type: #'unsigned int'>
>         deltaY := bbH + 1. "So we can pre-decrement"
>         srcY := sy.
>         dstY := dy.
>         srcShift := (dx bitAnd: 1) * 16.
>         destMSB ifTrue:[srcShift := 16 - srcShift].
>         mask1 := 16rFFFF << (16 - srcShift).
>         "This is the outer loop"
>         [(deltaY := deltaY - 1) ~= 0] whileTrue:[
>                 srcIndex := sourceBits + (srcY * sourcePitch) + (sx * 4).
>                 dstIndex := destBits + (dstY * destPitch) + (dx // 2 * 4).
>                 ditherBase := (dstY bitAnd: 3) * 4.
>                 ditherIndex := (sx bitAnd: 3) - 1. "For pre-increment"
>                 deltaX := bbW + 1. "So we can pre-decrement"
>                 dstMask := mask1.
>                 dstMask = 16rFFFF ifTrue:[srcShift := 16]
> ifFalse:[srcShift := 0].
>
>                 "This is the inner loop"
>                 [(deltaX := deltaX - 1) ~= 0] whileTrue:[
>                         ditherThreshold := ditherMatrix4x4 at: ditherBase
> + (ditherIndex := ditherIndex + 1 bitAnd: 3).
>                         sourceWord := self srcLongAt: srcIndex.
>                         srcAlpha := sourceWord >> 24.
>                         srcAlpha = 255 ifTrue:[
>                                 "Dither from 32 to 16 bit"
>                                 sourceWord := self dither32To16:
> sourceWord threshold: ditherThreshold.
>                                 sourceWord = 0
>                                         ifTrue:[sourceWord := 1 <<
> srcShift]
>                                         ifFalse: [sourceWord := sourceWord
> << srcShift].
>                                 "Store masked value"
>                                 self dstLongAt: dstIndex put: sourceWord
> mask: dstMask.
>                         ] ifFalse:[ "srcAlpha ~= 255"
>                                 srcAlpha = 0 ifFalse:[ "0 < srcAlpha < 255"
>                                         "If we have to mix colors then
> just copy a single word"
>                                         destWord := self dstLongAt:
> dstIndex.
>                                         destWord := destWord bitAnd:
> dstMask bitInvert32.
>                                         destWord := destWord >> srcShift.
>                                         "Expand from 16 to 32 bit by
> adding zero bits"
>                                         destWord := (((destWord bitAnd:
> 16r7C00) bitShift: 9) bitOr:
>
> ((destWord bitAnd: 16r3E0) bitShift: 6)) bitOr:
>
> (((destWord bitAnd: 16r1F) bitShift: 3) bitOr:
>
> 16rFF000000).
>                                         "Mix colors"
>                                         sourceWord := self
> alphaBlendScaled: sourceWord with: destWord.
>                                         "And dither"
>                                         sourceWord := self dither32To16:
> sourceWord threshold: ditherThreshold.
>                                         sourceWord = 0
>                                                 ifTrue:[sourceWord := 1 <<
> srcShift]
>                                                 ifFalse:[sourceWord :=
> sourceWord << srcShift].
>                                         "Store back"
>                                         self dstLongAt: dstIndex put:
> sourceWord mask: dstMask.
>                                 ].
>                         ].
>                         srcIndex := srcIndex + 4.
>                         destMSB
>                                 ifTrue:[srcShift = 0 ifTrue:[dstIndex :=
> dstIndex + 4]]
>                                 ifFalse:[srcShift = 0 ifFalse:[dstIndex :=
> dstIndex + 4]].
>                         srcShift := srcShift bitXor: 16. "Toggle between 0
> and 16"
>                         dstMask := dstMask bitInvert32. "Mask other half
> word"
>                 ].
>                 srcY := srcY + 1.
>                 dstY := dstY + 1.
>         ].!
>
> Item was changed:
>   ----- Method: BitBltSimulation>>alphaSourceBlendBits32 (in category
> 'inner loop') -----
>   alphaSourceBlendBits32
>         "This version assumes
>                 combinationRule = 34
>                 sourcePixSize = destPixSize = 32
>                 sourceForm ~= destForm.
>         Note: The inner loop has been optimized for dealing
>                 with the special cases of srcAlpha = 0.0 and srcAlpha = 1.0
>         "
>         | srcIndex dstIndex sourceWord srcAlpha destWord deltaX deltaY
> srcY dstY |
>         <inline: false> "This particular method should be optimized in
> itself"
> +       <var: #sourceWord type: #'unsigned int'>
> +       <var: #destWord type: #'unsigned int'>
>
>         "Give the compile a couple of hints"
>
>         "The following should be declared as pointers so the compiler will
>         notice that they're used for accessing memory locations
>         (good to know on an Intel architecture) but then the increments
>         would be different between ST code and C code so must hope the
>         compiler notices what happens (MS Visual C does)"
>
>         deltaY := bbH + 1. "So we can pre-decrement"
>         srcY := sy.
>         dstY := dy.
>
>         "This is the outer loop"
>         [(deltaY := deltaY - 1) ~= 0] whileTrue:[
>                 srcIndex := sourceBits + (srcY * sourcePitch) + (sx * 4).
>                 dstIndex := destBits + (dstY * destPitch) + (dx * 4).
>                 deltaX := bbW + 1. "So we can pre-decrement"
>
>                 "This is the inner loop"
>                 [(deltaX := deltaX - 1) ~= 0] whileTrue:[
>                         sourceWord := self srcLongAt: srcIndex.
>                         srcAlpha := sourceWord >> 24.
>                         srcAlpha = 255 ifTrue:[
>                                 self dstLongAt: dstIndex put: sourceWord.
>                                 srcIndex := srcIndex + 4.
>                                 dstIndex := dstIndex + 4.
>                                 "Now copy as many words as possible with
> alpha = 255"
>                                 [(deltaX := deltaX - 1) ~= 0 and:[
>                                         (sourceWord := self srcLongAt:
> srcIndex) >> 24 = 255]]
>                                                 whileTrue:[
>                                                         self dstLongAt:
> dstIndex put: sourceWord.
>                                                         srcIndex :=
> srcIndex + 4.
>                                                         dstIndex :=
> dstIndex + 4.
>                                                 ].
>                                 "Adjust deltaX"
>                                 deltaX := deltaX + 1.
>                         ] ifFalse:[ "srcAlpha ~= 255"
>                                 srcAlpha = 0 ifTrue:[
>                                         srcIndex := srcIndex + 4.
>                                         dstIndex := dstIndex + 4.
>                                         "Now skip as many words as
> possible,"
>                                         [(deltaX := deltaX - 1) ~= 0 and:[
>                                                 (sourceWord := self
> srcLongAt: srcIndex) >> 24 = 0]]
>                                                 whileTrue:[
>                                                         srcIndex :=
> srcIndex + 4.
>                                                         dstIndex :=
> dstIndex + 4.
>                                                 ].
>                                         "Adjust deltaX"
>                                         deltaX := deltaX + 1.
>                                 ] ifFalse:[ "0 < srcAlpha < 255"
>                                         "If we have to mix colors then
> just copy a single word"
>                                         destWord := self dstLongAt:
> dstIndex.
>                                         destWord := self alphaBlendScaled:
> sourceWord with: destWord.
>                                         self dstLongAt: dstIndex put:
> destWord.
>                                         srcIndex := srcIndex + 4.
>                                         dstIndex := dstIndex + 4.
>                                 ].
>                         ].
>                 ].
>                 srcY := srcY + 1.
>                 dstY := dstY + 1.
>         ].!
>
> Item was changed:
>   ----- Method: BitBltSimulation>>alphaSourceBlendBits8 (in category
> 'inner loop') -----
>   alphaSourceBlendBits8
>         "This version assumes
>                 combinationRule = 34
>                 sourcePixSize = 32
>                 destPixSize = 8
>                 sourceForm ~= destForm.
>         Note: This is not real blending since we don't have the source
> colors available.
>         "
>         | srcIndex dstIndex sourceWord srcAlpha destWord deltaX deltaY
>         srcY dstY dstMask srcShift adjust mappingTable mapperFlags |
>         <inline: false>
>         <var: #mappingTable type:'unsigned int *'>
> +       <var: #sourceWord type: #'unsigned int'>
> +       <var: #destWord type: #'unsigned int'>
> +       <var: #dstMask type: #'unsigned int'>
>         mappingTable := self default8To32Table.
>         mapperFlags := cmFlags bitAnd: ColorMapNewStyle bitInvert32.
>         deltaY := bbH + 1. "So we can pre-decrement"
>         srcY := sy.
>         dstY := dy.
>         mask1 := ((dx bitAnd: 3) * 8).
>         destMSB ifTrue:[mask1 := 24 - mask1].
>         mask2 := AllOnes bitXor:(16rFF << mask1).
>         (dx bitAnd: 1) = 0
>                 ifTrue:[adjust := 0]
>                 ifFalse:[adjust := 16r1F1F1F1F].
>         (dy bitAnd: 1) = 0
>                 ifTrue:[adjust := adjust bitXor: 16r1F1F1F1F].
>         "This is the outer loop"
>         [(deltaY := deltaY - 1) ~= 0] whileTrue:[
>                 adjust := adjust bitXor: 16r1F1F1F1F.
>                 srcIndex := sourceBits + (srcY * sourcePitch) + (sx * 4).
>                 dstIndex := destBits + (dstY * destPitch) + (dx // 4 * 4).
>                 deltaX := bbW + 1. "So we can pre-decrement"
>                 srcShift := mask1.
>                 dstMask := mask2.
>
>                 "This is the inner loop"
>                 [(deltaX := deltaX - 1) ~= 0] whileTrue:[
>                         sourceWord := ((self srcLongAt: srcIndex) bitAnd:
> (adjust bitInvert32)) + adjust.
>                         srcAlpha := sourceWord >> 24.
>                         srcAlpha > 31 ifTrue:["Everything below 31 is
> transparent"
>                                 srcAlpha < 224 ifTrue:["Everything above
> 224 is opaque"
>                                         destWord := self dstLongAt:
> dstIndex.
>                                         destWord := destWord bitAnd:
> dstMask bitInvert32.
>                                         destWord := destWord >> srcShift.
>                                         destWord := mappingTable at:
> destWord.
>                                         sourceWord := self
> alphaBlendScaled: sourceWord with: destWord.
>                                 ].
>                                 sourceWord := self mapPixel: sourceWord
> flags: mapperFlags.
>                                 sourceWord := sourceWord << srcShift.
>                                 "Store back"
>                                 self dstLongAt: dstIndex put: sourceWord
> mask: dstMask.
>                         ].
>                         srcIndex := srcIndex + 4.
>                         destMSB ifTrue:[
>                                 srcShift = 0
>                                         ifTrue:[dstIndex := dstIndex + 4.
>                                                         srcShift := 24.
>                                                         dstMask :=
> 16r00FFFFFF]
>                                         ifFalse:[srcShift := srcShift - 8.
>                                                         dstMask :=
> (dstMask >> 8) bitOr: 16rFF000000].
>                         ] ifFalse:[
>                                 srcShift = 24
>                                         ifTrue:[dstIndex := dstIndex + 4.
>                                                         srcShift := 0.
>                                                         dstMask :=
> 16rFFFFFF00]
>                                         ifFalse:[srcShift := srcShift + 8.
>                                                         dstMask := dstMask
> << 8 bitOr: 255].
>                         ].
>                         adjust := adjust bitXor: 16r1F1F1F1F.
>                 ].
>                 srcY := srcY + 1.
>                 dstY := dstY + 1.
>         ].!
>
> Item was changed:
>   ----- Method: BitBltSimulation>>bitAnd:with: (in category 'combination
> rules') -----
>   bitAnd: sourceWord with: destinationWord
> +       <returnTypeC: 'unsigned int'>
> +       <var: #sourceWord type: 'unsigned int'>
> +       <var: #destinationWord type: 'unsigned int'>
>         ^sourceWord bitAnd: destinationWord!
>
> Item was changed:
>   ----- Method: BitBltSimulation>>bitAndInvert:with: (in category
> 'combination rules') -----
>   bitAndInvert: sourceWord with: destinationWord
> +       <returnTypeC: 'unsigned int'>
> +       <var: #sourceWord type: 'unsigned int'>
> +       <var: #destinationWord type: 'unsigned int'>
>         ^sourceWord bitAnd: destinationWord bitInvert32!
>
> Item was changed:
>   ----- Method: BitBltSimulation>>bitInvertAnd:with: (in category
> 'combination rules') -----
>   bitInvertAnd: sourceWord with: destinationWord
> +       <returnTypeC: 'unsigned int'>
> +       <var: #sourceWord type: 'unsigned int'>
> +       <var: #destinationWord type: 'unsigned int'>
>         ^sourceWord bitInvert32 bitAnd: destinationWord!
>
> Item was changed:
>   ----- Method: BitBltSimulation>>bitInvertAndInvert:with: (in category
> 'combination rules') -----
>   bitInvertAndInvert: sourceWord with: destinationWord
> +       <returnTypeC: 'unsigned int'>
> +       <var: #sourceWord type: 'unsigned int'>
> +       <var: #destinationWord type: 'unsigned int'>
>         ^sourceWord bitInvert32 bitAnd: destinationWord bitInvert32!
>
> Item was changed:
>   ----- Method: BitBltSimulation>>bitInvertDestination:with: (in category
> 'combination rules') -----
>   bitInvertDestination: sourceWord with: destinationWord
> +       <returnTypeC: 'unsigned int'>
> +       <var: #sourceWord type: 'unsigned int'>
> +       <var: #destinationWord type: 'unsigned int'>
>         ^destinationWord bitInvert32!
>
> Item was changed:
>   ----- Method: BitBltSimulation>>bitInvertOr:with: (in category
> 'combination rules') -----
>   bitInvertOr: sourceWord with: destinationWord
> +       <returnTypeC: 'unsigned int'>
> +       <var: #sourceWord type: 'unsigned int'>
> +       <var: #destinationWord type: 'unsigned int'>
>         ^sourceWord bitInvert32 bitOr: destinationWord!
>
> Item was changed:
>   ----- Method: BitBltSimulation>>bitInvertOrInvert:with: (in category
> 'combination rules') -----
>   bitInvertOrInvert: sourceWord with: destinationWord
> +       <returnTypeC: 'unsigned int'>
> +       <var: #sourceWord type: 'unsigned int'>
> +       <var: #destinationWord type: 'unsigned int'>
>         ^sourceWord bitInvert32 bitOr: destinationWord bitInvert32!
>
> Item was changed:
>   ----- Method: BitBltSimulation>>bitInvertSource:with: (in category
> 'combination rules') -----
>   bitInvertSource: sourceWord with: destinationWord
> +       <returnTypeC: 'unsigned int'>
> +       <var: #sourceWord type: 'unsigned int'>
> +       <var: #destinationWord type: 'unsigned int'>
>         ^sourceWord bitInvert32!
>
> Item was changed:
>   ----- Method: BitBltSimulation>>bitInvertXor:with: (in category
> 'combination rules') -----
>   bitInvertXor: sourceWord with: destinationWord
> +       <returnTypeC: 'unsigned int'>
> +       <var: #sourceWord type: 'unsigned int'>
> +       <var: #destinationWord type: 'unsigned int'>
>         ^sourceWord bitInvert32 bitXor: destinationWord!
>
> Item was changed:
>   ----- Method: BitBltSimulation>>bitOr:with: (in category 'combination
> rules') -----
>   bitOr: sourceWord with: destinationWord
> +       <returnTypeC: 'unsigned int'>
> +       <var: #sourceWord type: 'unsigned int'>
> +       <var: #destinationWord type: 'unsigned int'>
>         ^sourceWord bitOr: destinationWord!
>
> Item was changed:
>   ----- Method: BitBltSimulation>>bitOrInvert:with: (in category
> 'combination rules') -----
>   bitOrInvert: sourceWord with: destinationWord
> +       <returnTypeC: 'unsigned int'>
> +       <var: #sourceWord type: 'unsigned int'>
> +       <var: #destinationWord type: 'unsigned int'>
>         ^sourceWord bitOr: destinationWord bitInvert32!
>
> Item was changed:
>   ----- Method: BitBltSimulation>>bitXor:with: (in category 'combination
> rules') -----
>   bitXor: sourceWord with: destinationWord
> +       <returnTypeC: 'unsigned int'>
> +       <var: #sourceWord type: 'unsigned int'>
> +       <var: #destinationWord type: 'unsigned int'>
>         ^sourceWord bitXor: destinationWord!
>
> Item was changed:
>   ----- Method: BitBltSimulation>>clearWord:with: (in category
> 'combination rules') -----
> + clearWord: sourceWord with: destinationWord
> +       <returnTypeC: 'unsigned int'>
> +       <var: #sourceWord type: 'unsigned int'>
> +       <var: #destinationWord type: 'unsigned int'>
> - clearWord: source with: destination
>         ^ 0!
>
> Item was changed:
>   ----- Method: BitBltSimulation>>copyLoop (in category 'inner loop') -----
>   copyLoop
>         | prevWord thisWord skewWord halftoneWord mergeWord hInc y unskew
> skewMask notSkewMask mergeFnwith destWord |
>         "This version of the inner loop assumes noSource = false."
>         <inline: false>
> +       <var: #mergeFnwith declareC: 'unsigned int (*mergeFnwith)(unsigned
> int, unsigned int)'>
> +       <var: #prevWord type: #'unsigned int'>
> +       <var: #thisWord type: #'unsigned int'>
> +       <var: #skewWord type: #'unsigned int'>
> +       <var: #halftoneWord type: #'unsigned int'>
> +       <var: #mergeWord type: #'unsigned int'>
> +       <var: #destWord type: #'unsigned int'>
> +       <var: #skewMask type: #'unsigned int'>
> +       <var: #notSkewMask type: #'unsigned int'>
> +       mergeFnwith := self cCoerce: (opTable at: combinationRule+1) to:
> 'unsigned int (*)(unsigned int, unsigned int)'.
> -       <var: #mergeFnwith declareC: 'sqInt (*mergeFnwith)(sqInt, sqInt)'>
> -       mergeFnwith := self cCoerce: (opTable at: combinationRule+1) to:
> 'sqInt (*)(sqInt, sqInt)'.
>         mergeFnwith.  "null ref for compiler"
>
>         hInc := hDir*4.  "Byte delta"
>         "degenerate skew fixed for Sparc. 10/20/96 ikp"
>         skew == -32
>                 ifTrue: [skew := unskew := skewMask := 0]
>                 ifFalse: [skew < 0
>                         ifTrue:
>                                 [unskew := skew+32.
>                                 skewMask := AllOnes << (0-skew)]
>                         ifFalse:
>                                 [skew = 0
>                                         ifTrue:
>                                                 [unskew := 0.
>                                                 skewMask := AllOnes]
>                                         ifFalse:
>                                                 [unskew := skew-32.
>                                                 skewMask := AllOnes >>
> skew]]].
>         notSkewMask := skewMask bitInvert32.
>         noHalftone
>                 ifTrue: [halftoneWord := AllOnes.  halftoneHeight := 0]
>                 ifFalse: [halftoneWord := self halftoneAt: 0].
>
>         y := dy.
>         1 to: bbH do: "here is the vertical loop"
>                 [ :i |
>                 halftoneHeight > 1 ifTrue:  "Otherwise, its always the
> same"
>                         [halftoneWord := self halftoneAt: y.
>                         y := y + vDir].
>                 preload ifTrue:
>                         ["load the 64-bit shifter"
>                         prevWord := self srcLongAt: sourceIndex.
>                         self incSrcIndex: hInc]
>                         ifFalse:
>                         [prevWord := 0].
>
>         "Note: the horizontal loop has been expanded into three parts for
> speed:"
>
>                         "This first section requires masking of the
> destination store..."
>                         destMask := mask1.
>                         thisWord := self srcLongAt: sourceIndex.  "pick up
> next word"
>                         self incSrcIndex: hInc.
>                         skewWord := ((prevWord bitAnd: notSkewMask)
> bitShift: unskew)
>                                                         bitOr:  "32-bit
> rotate"
>                                                 ((thisWord bitAnd:
> skewMask) bitShift: skew).
>                         prevWord := thisWord.
>                         destWord := self dstLongAt: destIndex.
>                         mergeWord := self mergeFn: (skewWord bitAnd:
> halftoneWord) with: destWord.
>                         destWord := (destMask bitAnd: mergeWord) bitOr:
>                                                         (destWord bitAnd:
> destMask bitInvert32).
>                         self dstLongAt: destIndex put: destWord.
>                         self incDestIndex: hInc.
>
>                 "This central horizontal loop requires no store masking"
>                 destMask := AllOnes.
>   combinationRule = 3
>   ifTrue: [(skew = 0) & (halftoneWord = AllOnes)
>                 ifTrue:
>                 ["Very special inner loop for STORE mode with no skew --
> just move words"
>                 hDir = -1
>                 ifTrue: ["Woeful patch: revert to older code for hDir = -1"
>                                 2 to: nWords-1 do:
>                                         [ :word |
>                                         thisWord := self srcLongAt:
> sourceIndex.
>                                         self incSrcIndex: hInc.
>                                         self dstLongAt: destIndex put:
> thisWord.
>                                         self incDestIndex: hInc]]
>                 ifFalse: [2 to: nWords-1 do:
>                                         [ :word |  "Note loop starts with
> prevWord loaded (due to preload)"
>                                         self dstLongAt: destIndex put:
> prevWord.
>                                         self incDestIndex: hInc.
>                                         prevWord := self srcLongAt:
> sourceIndex.
>                                         self incSrcIndex: hInc]]]
>                 ifFalse:
>                 ["Special inner loop for STORE mode -- no need to call
> merge"
>                 2 to: nWords-1 do:
>                         [ :word |
>                         thisWord := self srcLongAt: sourceIndex.
>                         self incSrcIndex: hInc.
>                         skewWord := ((prevWord bitAnd: notSkewMask)
> bitShift: unskew)
>                                                         bitOr:  "32-bit
> rotate"
>                                                 ((thisWord bitAnd:
> skewMask) bitShift: skew).
>                         prevWord := thisWord.
>                         self dstLongAt: destIndex put: (skewWord bitAnd:
> halftoneWord).
>                         self incDestIndex: hInc]]
>   ] ifFalse: [2 to: nWords-1 do: "Normal inner loop does merge:"
>                         [ :word |
>                         thisWord := self srcLongAt: sourceIndex.  "pick up
> next word"
>                         self incSrcIndex: hInc.
>                         skewWord := ((prevWord bitAnd: notSkewMask)
> bitShift: unskew)
>                                                         bitOr:  "32-bit
> rotate"
>                                                 ((thisWord bitAnd:
> skewMask) bitShift: skew).
>                         prevWord := thisWord.
>                         mergeWord := self mergeFn: (skewWord bitAnd:
> halftoneWord)
>                                                         with: (self
> dstLongAt: destIndex).
>                         self dstLongAt: destIndex put: mergeWord.
>                         self incDestIndex: hInc]
>   ].
>
>                 "This last section, if used, requires masking of the
> destination store..."
>                 nWords > 1 ifTrue:
>                         [destMask := mask2.
>                         thisWord := self srcLongAt: sourceIndex.  "pick up
> next word"
>                         self incSrcIndex: hInc.
>                         skewWord := ((prevWord bitAnd: notSkewMask)
> bitShift: unskew)
>                                                         bitOr:  "32-bit
> rotate"
>                                                 ((thisWord bitAnd:
> skewMask) bitShift: skew).
>                         destWord := self dstLongAt: destIndex.
>                         mergeWord := self mergeFn: (skewWord bitAnd:
> halftoneWord) with: destWord.
>                         destWord := (destMask bitAnd: mergeWord) bitOr:
>                                                         (destWord bitAnd:
> destMask bitInvert32).
>                         self dstLongAt: destIndex put: destWord.
>                         self incDestIndex: hInc].
>
>         self incSrcIndex: sourceDelta.
>         self incDestIndex: destDelta]!
>
> Item was changed:
>   ----- Method: BitBltSimulation>>copyLoopNoSource (in category 'inner
> loop') -----
>   copyLoopNoSource
>         "Faster copyLoop when source not used.  hDir and vDir are both
>         positive, and perload and skew are unused"
>         | halftoneWord mergeWord mergeFnwith destWord |
>         <inline: false>
> +       <var: #mergeFnwith declareC: 'unsigned int (*mergeFnwith)(unsigned
> int, unsigned int)'>
> +       <var: #halftoneWord type: #'unsigned int'>
> +       <var: #mergeWord type: #'unsigned int'>
> +       <var: #destWord type: #'unsigned int'>
> +       mergeFnwith := self cCoerce: (opTable at: combinationRule+1) to:
> 'unsigned int (*)(unsigned int, unsigned int)'.
> -       <var: #mergeFnwith declareC: 'sqInt (*mergeFnwith)(sqInt, sqInt)'>
> -       mergeFnwith := self cCoerce: (opTable at: combinationRule+1) to:
> 'sqInt (*)(sqInt, sqInt)'.
>         mergeFnwith.  "null ref for compiler"
>
>         1 to: bbH do: "here is the vertical loop"
>                 [ :i |
>                 noHalftone
>                         ifTrue: [halftoneWord := AllOnes]
>                         ifFalse: [halftoneWord := self halftoneAt: dy+i-1].
>
>         "Note: the horizontal loop has been expanded into three parts for
> speed:"
>
>                         "This first section requires masking of the
> destination store..."
>                         destMask := mask1.
>                         destWord := self dstLongAt: destIndex.
>                         mergeWord := self mergeFn: halftoneWord
>                                                         with: destWord.
>                         destWord := (destMask bitAnd: mergeWord) bitOr:
>                                                         (destWord bitAnd:
> destMask bitInvert32).
>                         self dstLongAt: destIndex put: destWord.
>                         self incDestIndex: 4.
>
>                 "This central horizontal loop requires no store masking"
>                         destMask := AllOnes.
>                         combinationRule = 3 ifTrue: ["Special inner loop
> for STORE"
>                                 destWord := halftoneWord.
>                                 2 to: nWords-1 do:[ :word |
>                                         self dstLongAt: destIndex put:
> destWord.
>                                         self incDestIndex: 4].
>                         ] ifFalse:[ "Normal inner loop does merge"
>                                 2 to: nWords-1 do:[ :word | "Normal inner
> loop does merge"
>                                         destWord := self dstLongAt:
> destIndex.
>                                         mergeWord := self mergeFn:
> halftoneWord with: destWord.
>                                         self dstLongAt: destIndex put:
> mergeWord.
>                                         self incDestIndex: 4].
>                         ].
>
>                 "This last section, if used, requires masking of the
> destination store..."
>                 nWords > 1 ifTrue:
>                         [destMask := mask2.
>                         destWord := self dstLongAt: destIndex.
>                         mergeWord := self mergeFn: halftoneWord with:
> destWord.
>                         destWord := (destMask bitAnd: mergeWord) bitOr:
>                                                         (destWord bitAnd:
> destMask bitInvert32).
>                         self dstLongAt: destIndex put: destWord.
>                         self incDestIndex: 4].
>
>         self incDestIndex: destDelta]!
>
> Item was changed:
>   ----- Method: BitBltSimulation>>copyLoopPixMap (in category 'inner
> loop') -----
>   copyLoopPixMap
>         "This version of the inner loop maps source pixels
>         to a destination form with different depth.  Because it is already
>         unweildy, the loop is not unrolled as in the other versions.
>         Preload, skew and skewMask are all overlooked, since
> pickSourcePixels
>         delivers its destination word already properly aligned.
>         Note that pickSourcePixels could be copied in-line at the top of
>         the horizontal loop, and some of its inits moved out of the loop."
>         "ar 12/7/1999:
>         The loop has been rewritten to use only one pickSourcePixels call.
>         The idea is that the call itself could be inlined. If we decide not
>         to inline pickSourcePixels we could optimize the loop instead."
>         | skewWord halftoneWord mergeWord scrStartBits nSourceIncs
> startBits endBits sourcePixMask destPixMask mergeFnwith nPix srcShift
> dstShift destWord words srcShiftInc dstShiftInc dstShiftLeft mapperFlags |
>         <inline: false>
> +       <var: #mergeFnwith declareC: 'unsigned int (*mergeFnwith)(unsigned
> int, unsigned int)'>
> +       <var: #skewWord type: #'unsigned int'>
> +       <var: #halftoneWord type: #'unsigned int'>
> +       <var: #mergeWord type: #'unsigned int'>
> +       <var: #destWord type: #'unsigned int'>
> +       <var: #sourcePixMask type: #'unsigned int'>
> +       <var: #destPixMask type: #'unsigned int'>
> +       mergeFnwith := self cCoerce: (opTable at: combinationRule+1) to:
> 'unsigned int (*)(unsigned int, unsigned int)'.
> -       <var: #mergeFnwith declareC: 'sqInt (*mergeFnwith)(sqInt, sqInt)'>
> -       mergeFnwith := self cCoerce: (opTable at: combinationRule+1) to:
> 'sqInt (*)(sqInt, sqInt)'.
>         mergeFnwith.  "null ref for compiler"
>
>         "Additional inits peculiar to unequal source and dest pix size..."
>         sourcePPW := 32//sourceDepth.
>         sourcePixMask := maskTable at: sourceDepth.
>         destPixMask := maskTable at: destDepth.
>         mapperFlags := cmFlags bitAnd: ColorMapNewStyle bitInvert32.
>         sourceIndex := sourceBits +
>                                         (sy * sourcePitch) + ((sx //
> sourcePPW) *4).
>         scrStartBits := sourcePPW - (sx bitAnd: sourcePPW-1).
>         bbW < scrStartBits
>                 ifTrue: [nSourceIncs := 0]
>                 ifFalse: [nSourceIncs := (bbW - scrStartBits)//sourcePPW +
> 1].
>         sourceDelta := sourcePitch - (nSourceIncs * 4).
>
>         "Note following two items were already calculated in destmask
> setup!!"
>         startBits := destPPW - (dx bitAnd: destPPW-1).
>         endBits := ((dx + bbW - 1) bitAnd: destPPW-1) + 1.
>
>         bbW < startBits ifTrue:[startBits := bbW].
>
>         "Precomputed shifts for pickSourcePixels"
>         srcShift := ((sx bitAnd: sourcePPW - 1) * sourceDepth).
>         dstShift := ((dx bitAnd: destPPW - 1) * destDepth).
>         srcShiftInc := sourceDepth.
>         dstShiftInc := destDepth.
>         dstShiftLeft := 0.
>         sourceMSB ifTrue:[
>                 srcShift := 32 - sourceDepth - srcShift.
>                 srcShiftInc := 0 - srcShiftInc].
>         destMSB ifTrue:[
>                 dstShift := 32 - destDepth - dstShift.
>                 dstShiftInc := 0 - dstShiftInc.
>                 dstShiftLeft := 32 - destDepth].
>
>         1 to: bbH do: "here is the vertical loop"
>                 [ :i |
>                 "*** is it possible at all that noHalftone == false? ***"
>                 noHalftone
>                         ifTrue:[halftoneWord := AllOnes]
>                         ifFalse: [halftoneWord := self halftoneAt: dy+i-1].
>                 "setup first load"
>                 srcBitShift := srcShift.
>                 dstBitShift := dstShift.
>                 destMask := mask1.
>                 nPix := startBits.
>                 "Here is the horizontal loop..."
>                 words := nWords.
>                         ["pick up the word"
>                         skewWord := self pickSourcePixels: nPix flags:
> mapperFlags
>                                                                 srcMask:
> sourcePixMask destMask: destPixMask
>
> srcShiftInc: srcShiftInc dstShiftInc: dstShiftInc.
>                         "align next word to leftmost pixel"
>                         dstBitShift := dstShiftLeft.
>
>                         destMask = AllOnes ifTrue:["avoid
> read-modify-write"
>                                 mergeWord := self mergeFn: (skewWord
> bitAnd: halftoneWord)
>                                                                 with:
> (self dstLongAt: destIndex).
>                                 self dstLongAt: destIndex put: (destMask
> bitAnd: mergeWord).
>                         ] ifFalse:[ "General version using dest masking"
>                                 destWord := self dstLongAt: destIndex.
>                                 mergeWord := self mergeFn: (skewWord
> bitAnd: halftoneWord)
>                                                                 with:
> (destWord bitAnd: destMask).
>                                 destWord := (destMask bitAnd: mergeWord)
> bitOr:
>                                                                 (destWord
> bitAnd: destMask bitInvert32).
>                                 self dstLongAt: destIndex put: destWord.
>                         ].
>                         self incDestIndex: 4.
>                         words = 2 "e.g., is the next word the last word?"
>                                 ifTrue:["set mask for last word in this
> row"
>                                                 destMask := mask2.
>                                                 nPix := endBits]
>                                 ifFalse:["use fullword mask for inner loop"
>                                                 destMask := AllOnes.
>                                                 nPix := destPPW].
>                         (words := words - 1) = 0] whileFalse.
>                 "--- end of inner loop ---"
>                 self incSrcIndex: sourceDelta.
>                 self incDestIndex: destDelta]
>   !
>
> Item was changed:
>   ----- Method: BitBltSimulation>>destinationWord:with: (in category
> 'combination rules') -----
>   destinationWord: sourceWord with: destinationWord
> +       <returnTypeC: 'unsigned int'>
> +       <var: #sourceWord type: 'unsigned int'>
> +       <var: #destinationWord type: 'unsigned int'>
>         ^destinationWord!
>
> Item was changed:
>   ----- Method: BitBltSimulation>>dither32To16:threshold: (in category
> 'pixel mapping') -----
>   dither32To16: srcWord threshold: ditherValue
>         "Dither the given 32bit word to 16 bit. Ignore alpha."
>         | addThreshold  |
>         <inline: true> "You bet"
> +       <returnTypeC: 'unsigned int'>
> +       <var: #srcWord type: 'unsigned int'>
>         addThreshold := ditherValue bitShift: 8.
>         ^((dither8Lookup at: (addThreshold+((srcWord bitShift: -16)
> bitAnd: 255))) bitShift: 10) +
>                 ((dither8Lookup at: (addThreshold+((srcWord bitShift: -8)
> bitAnd: 255))) bitShift: 5) +
>                 (dither8Lookup at: (addThreshold+(srcWord bitAnd: 255))).
>   !
>
> Item was changed:
>   ----- Method: BitBltSimulation>>expensiveDither32To16:threshold: (in
> category 'pixel mapping') -----
>   expensiveDither32To16: srcWord threshold: ditherValue
>         "Dither the given 32bit word to 16 bit. Ignore alpha."
>         | pv threshold value out |
>         <inline: true> "You bet"
> +       <returnTypeC: 'unsigned int'>
> +       <var: #srcWord type: 'unsigned int'>
>         pv := srcWord bitAnd: 255.
>         threshold := ditherThresholds16 at: (pv bitAnd: 7).
>         value := ditherValues16 at: (pv bitShift: -3).
>         ditherValue < threshold
>                 ifTrue:[out := value + 1]
>                 ifFalse:[out := value].
>         pv := (srcWord bitShift: -8) bitAnd: 255.
>         threshold := ditherThresholds16 at: (pv bitAnd: 7).
>         value := ditherValues16 at: (pv bitShift: -3).
>         ditherValue < threshold
>                 ifTrue:[out := out bitOr: (value+1 bitShift:5)]
>                 ifFalse:[out := out bitOr: (value bitShift: 5)].
>         pv := (srcWord bitShift: -16) bitAnd: 255.
>         threshold := ditherThresholds16 at: (pv bitAnd: 7).
>         value := ditherValues16 at: (pv bitShift: -3).
>         ditherValue < threshold
>                 ifTrue:[out := out bitOr: (value+1 bitShift:10)]
>                 ifFalse:[out := out bitOr: (value bitShift: 10)].
>         ^out!
>
> Item was changed:
>   ----- Method: BitBltSimulation>>fixAlpha:with: (in category 'combination
> rules') -----
>   fixAlpha: sourceWord with: destinationWord
>         "For any non-zero pixel value in destinationWord with zero alpha
> channel take the alpha from sourceWord and fill it in. Intended for fixing
> alpha channels left at zero during 16->32 bpp conversions."
> +       <returnTypeC: 'unsigned int'>
> +       <var: #sourceWord type: 'unsigned int'>
> +       <var: #destinationWord type: 'unsigned int'>
>         destDepth = 32 ifFalse:[^destinationWord]. "no-op for non 32bpp"
>         destinationWord = 0 ifTrue:[^0].
>         (destinationWord bitAnd: 16rFF000000) = 0
> ifFalse:[^destinationWord].
>         ^destinationWord bitOr: (sourceWord bitAnd: 16rFF000000)
>   !
>
> Item was changed:
>   ----- Method: BitBltSimulation>>merge:with: (in category 'combination
> rules') -----
>   merge: sourceWord with: destinationWord
>         | mergeFnwith |
>         "Sender warpLoop is too big to include this in-line"
> +       <var: #mergeFnwith declareC: 'unsigned int (*mergeFnwith)(unsigned
> int, unsigned int)'>
> +       <returnTypeC: 'unsigned int'>
> +       <var: #sourceWord type: 'unsigned int'>
> +       <var: #destinationWord type: 'unsigned int'>
> +       mergeFnwith := self cCoerce: (opTable at: combinationRule+1) to:
> 'unsigned int (*)(unsigned int, unsigned int)'.
> -       <var: #mergeFnwith declareC: 'sqInt (*mergeFnwith)(sqInt, sqInt)'>
> -       mergeFnwith := self cCoerce: (opTable at: combinationRule+1) to:
> 'sqInt (*)(sqInt, sqInt)'.
>         mergeFnwith.  "null ref for compiler"
>
>         ^ self mergeFn: sourceWord with: destinationWord!
>
> Item was changed:
>   ----- Method: BitBltSimulation>>partitionedAND:to:nBits:nPartitions: (in
> category 'combination rules') -----
>   partitionedAND: word1 to: word2 nBits: nBits nPartitions: nParts
>         "AND word1 to word2 as nParts partitions of nBits each.
>         Any field of word1 not all-ones is treated as all-zeroes.
>         Used for erasing, eg, brush shapes prior to ORing in a color"
>         | mask result |
> +       <returnTypeC: 'unsigned int'>
> +       <var: #word1 type: 'unsigned int'>
> +       <var: #word2 type: 'unsigned int'>
> +       <var: #result type: 'unsigned int'>
>         mask := maskTable at: nBits.  "partition mask starts at the right"
>         result := 0.
>         1 to: nParts do:
>                 [:i |
>                 (word1 bitAnd: mask) = mask
>                         ifTrue: [result := result bitOr: (word2 bitAnd:
> mask)].
>                 mask := mask << nBits  "slide left to next partition"].
>         ^ result
>   !
>
> Item was changed:
>   ----- Method:
> BitBltSimulation>>partitionedAdd:to:nBits:componentMask:carryOverflowMask:
> (in category 'combination rules') -----
>   partitionedAdd: word1 to: word2 nBits: nBits componentMask:
> componentMask carryOverflowMask: carryOverflowMask
>         "Add word1 to word2 as nParts partitions of nBits each.
>         This is useful for packed pixels, or packed colors"
>         | carryOverflow sum w1 w2 |
>         "Use unsigned int everywhere because it has a well known
> arithmetic model without undefined behavior w.r.t. overflow and shifts"
> +       <returnTypeC: 'unsigned int'>
>          <var: #word1 type: 'unsigned int'>
>         <var: #word2 type: 'unsigned int'>
>          <var: #w1 type: 'unsigned int'>
>         <var: #w2 type: 'unsigned int'>
>         <var: #componentMask type: 'unsigned int'>
>         <var: #carryOverflowMask type: 'unsigned int'>
>         <var: #carryOverflow type: 'unsigned int'>
>         <var: #sum type: 'unsigned int'>
>         w1 := word1 bitAnd: carryOverflowMask. "mask to remove high bit of
> each component"
>         w2 := word2 bitAnd: carryOverflowMask.
>         sum := (word1 bitXor: w1)+(word2 bitXor: w2). "sum without high
> bit to avoid overflowing over next component"
>         carryOverflow := (w1 bitAnd: w2) bitOr: ((w1 bitOr: w2) bitAnd:
> sum). "detect overflow condition for saturating"
>         ^((sum bitXor: w1)bitXor:w2) "sum high bit without overflow"
>                 bitOr: carryOverflow>>(nBits-1) * componentMask "saturate
> in case of overflow"!
>
> Item was changed:
>   ----- Method: BitBltSimulation>>partitionedMax:with:nBits:nPartitions:
> (in category 'combination rules') -----
>   partitionedMax: word1 with: word2 nBits: nBits nPartitions: nParts
>         "Max word1 to word2 as nParts partitions of nBits each"
>         | mask result |
>         "In C, most arithmetic operations answer the same bit pattern
> regardless of the operands being signed or unsigned ints
>         (this is due to the way 2's complement numbers work). However,
> comparisions might fail. Add the proper declaration of
>         words as unsigned int in those cases where comparisions are done
> (jmv)"
> +       <returnTypeC: 'unsigned int'>
>         <var: #word1 type: 'unsigned int'>
>         <var: #word2 type: 'unsigned int'>
>         <var: #mask type: 'unsigned int'>
>         <var: #result type: 'unsigned int'>
>         mask := maskTable at: nBits.  "partition mask starts at the right"
>         result := 0.
>         1 to: nParts do:
>                 [:i |
>                 result := result bitOr: ((word2 bitAnd: mask) max: (word1
> bitAnd: mask)).
>                 mask := mask << nBits  "slide left to next partition"].
>         ^ result
>   !
>
> Item was changed:
>   ----- Method: BitBltSimulation>>partitionedMin:with:nBits:nPartitions:
> (in category 'combination rules') -----
>   partitionedMin: word1 with: word2 nBits: nBits nPartitions: nParts
>         "Min word1 to word2 as nParts partitions of nBits each"
>         | mask result |
>         "In C, most arithmetic operations answer the same bit pattern
> regardless of the operands being signed or unsigned ints
>         (this is due to the way 2's complement numbers work). However,
> comparisions might fail. Add the proper declaration of
>         words as unsigned int in those cases where comparisions are done
> (jmv)"
> +       <returnTypeC: 'unsigned int'>
>         <var: #word1 type: 'unsigned int'>
>         <var: #word2 type: 'unsigned int'>
>         <var: #mask type: 'unsigned int'>
>         <var: #result type: 'unsigned int'>
>         mask := maskTable at: nBits.  "partition mask starts at the right"
>         result := 0.
>         1 to: nParts do:
>                 [:i |
>                 result := result bitOr: ((word2 bitAnd: mask) min: (word1
> bitAnd: mask)).
>                 mask := mask << nBits  "slide left to next partition"].
>         ^ result
>   !
>
> Item was changed:
>   ----- Method: BitBltSimulation>>partitionedMul:with:nBits:nPartitions:
> (in category 'combination rules') -----
>   partitionedMul: word1 with: word2 nBits: nBits nPartitions: nParts
>         "Multiply word1 with word2 as nParts partitions of nBits each.
>         This is useful for packed pixels, or packed colors.
>         Bug in loop version when non-white background"
>
>         | sMask product result dMask |
>         "In C, integer multiplication might answer a wrong value if the
> unsigned values are declared as signed.
>         This problem does not affect this method, because the most
> significant bit (i.e. the sign bit) will
>         always be zero (jmv)"
> +       <returnTypeC: 'unsigned int'>
> +       <var: #word1 type: 'unsigned int'>
> +       <var: #word2 type: 'unsigned int'>
> +       <var: #sMask type: 'unsigned int'>
> +       <var: #dMask type: 'unsigned int'>
> +       <var: #result type: 'unsigned int'>
> +       <var: #product type: 'unsigned int'>
>         sMask := maskTable at: nBits.  "partition mask starts at the right"
>         dMask :=  sMask << nBits.
>         result := (((word1 bitAnd: sMask)+1) * ((word2 bitAnd: sMask)+1) -
> 1
>                                 bitAnd: dMask) >> nBits.        "optimized
> first step"
>         nParts = 1
>                 ifTrue: [ ^result ].
>         product := (((word1>>nBits bitAnd: sMask)+1) * ((word2>>nBits
> bitAnd: sMask)+1) - 1 bitAnd: dMask).
>         result := result bitOr: product.
>         nParts = 2
>                 ifTrue: [ ^result ].
>         product := (((word1>>(2*nBits) bitAnd: sMask)+1) *
> ((word2>>(2*nBits) bitAnd: sMask)+1) - 1 bitAnd: dMask).
>         result := result bitOr: product << nBits.
>         nParts = 3
>                 ifTrue: [ ^result ].
>         product := (((word1>>(3*nBits) bitAnd: sMask)+1) *
> ((word2>>(3*nBits) bitAnd: sMask)+1) - 1 bitAnd: dMask).
>         result := result bitOr: product << (2*nBits).
>         ^ result
>
>   "     | sMask product result dMask |
>         sMask := maskTable at: nBits.  'partition mask starts at the right'
>         dMask :=  sMask << nBits.
>         result := (((word1 bitAnd: sMask)+1) * ((word2 bitAnd: sMask)+1) -
> 1
>                                 bitAnd: dMask) >> nBits.        'optimized
> first step'
>         nBits to: nBits * (nParts-1) by: nBits do: [:ofs |
>                 product := (((word1>>ofs bitAnd: sMask)+1) * ((word2>>ofs
> bitAnd: sMask)+1) - 1 bitAnd: dMask).
>                 result := result bitOr: (product bitAnd: dMask) <<
> (ofs-nBits)].
>         ^ result"!
>
> Item was changed:
>   ----- Method:
> BitBltSimulation>>partitionedRgbComponentAlpha:dest:nBits:nPartitions: (in
> category 'combination rules') -----
>   partitionedRgbComponentAlpha: sourceWord dest: destWord nBits: nBits
> nPartitions: nParts
>         | mask result p1 p2 v |
> +       <returnTypeC: 'unsigned int'>
> +       <var: #sourceWord type: 'unsigned int'>
> +       <var: #destWord type: 'unsigned int'>
> +       <var: #p1 type: 'unsigned int'>
> +       <var: #p2 type: 'unsigned int'>
> +       <var: #mask type: 'unsigned int'>
> +       <var: #result type: 'unsigned int'>
>         mask := maskTable at: nBits.  "partition mask starts at the right"
>         result := 0.
>         1 to: nParts do:
>                 [:i |
>                 p1 := (sourceWord bitAnd: mask) >> ((i - 1)*nBits).
>                 p2 := (destWord bitAnd: mask) >> ((i - 1)*nBits).
>                 nBits = 32
>                         ifFalse:[
>                                 nBits = 16
>                                         ifTrue:[
>                                                 p1 := (self rgbMap16To32:
> p1) bitOr: 16rFF000000.
>                                                 p2 := (self rgbMap16To32:
> p2) bitOr: 16rFF000000]
>                                         ifFalse:[
>                                                 p1 := (self rgbMap: p1
> from: nBits to: 32) bitOr: 16rFF000000.
>                                                 p2 := (self rgbMap: p2
> from: nBits to: 32) bitOr: 16rFF000000.]].
>                 v := self rgbComponentAlpha32: p1 with: p2.
>                 nBits = 32
>                         ifFalse:[
>                                 v := self rgbMap: v from: 32 to: nBits].
>                 result := result bitOr: (v <<  ((i - 1)*nBits)).
>                 mask := mask << nBits  "slide left to next partition"].
>         ^ result
>   !
>
> Item was changed:
>   ----- Method: BitBltSimulation>>partitionedSub:from:nBits:nPartitions:
> (in category 'combination rules') -----
>   partitionedSub: word1 from: word2 nBits: nBits nPartitions: nParts
>         "Subtract word1 from word2 as nParts partitions of nBits each.
>         This is useful for packed pixels, or packed colors"
>         | mask result p1 p2 |
>         "In C, most arithmetic operations answer the same bit pattern
> regardless of the operands being signed or unsigned ints
>         (this is due to the way 2's complement numbers work). However,
> comparisions might fail. Add the proper declaration of
>         words as unsigned int in those cases where comparisions are done
> (jmv)"
> +       <returnTypeC: 'unsigned int'>
>         <var: #word1 type: 'unsigned int'>
>         <var: #word2 type: 'unsigned int'>
>         <var: #p1 type: 'unsigned int'>
>         <var: #p2 type: 'unsigned int'>
>         <var: #mask type: 'unsigned int'>
>         <var: #result type: 'unsigned int'>
>         mask := maskTable at: nBits.  "partition mask starts at the right"
>         result := 0.
>         1 to: nParts do:
>                 [:i |
>                 p1 := word1 bitAnd: mask.
>                 p2 := word2 bitAnd: mask.
>                 p1 < p2  "result is really abs value of thedifference"
>                         ifTrue: [result := result bitOr: p2 - p1]
>                         ifFalse: [result := result bitOr: p1 - p2].
>                 mask := mask << nBits  "slide left to next partition"].
>         ^ result
>   !
>
> Item was changed:
>   ----- Method:
> BitBltSimulation>>pickSourcePixels:flags:srcMask:destMask:srcShiftInc:dstShiftInc:
> (in category 'combination rules') -----
>   pickSourcePixels: nPixels flags: mapperFlags srcMask: srcMask destMask:
> dstMask srcShiftInc: srcShiftInc dstShiftInc: dstShiftInc
>         "Pick nPix pixels starting at srcBitIndex from the source, map by
> the
>         color map, and justify them according to dstBitIndex in the
> resulting destWord."
>         | sourceWord destWord sourcePix destPix srcShift dstShift nPix |
>         <inline: true> "oh please"
> +       <returnTypeC: 'unsigned int'>
> +       <var: #sourceWord type: #'unsigned int'>
> +       <var: #destWord type: #'unsigned int'>
>         sourceWord := self srcLongAt: sourceIndex.
>         destWord := 0.
>         srcShift := srcBitShift. "Hint: Keep in register"
>         dstShift := dstBitShift. "Hint: Keep in register"
>         nPix := nPixels. "always > 0 so we can use do { } while(--nPix);"
>         (mapperFlags = (ColorMapPresent bitOr: ColorMapIndexedPart))
> ifTrue:[
>                 "a little optimization for (pretty crucial) blits using
> indexed lookups only"
>                 [       "grab, colormap and mix in pixel"
>                         sourcePix := sourceWord >> srcShift bitAnd:
> srcMask.
>                         destPix := cmLookupTable at: (sourcePix bitAnd:
> cmMask).
>                         destWord := destWord bitOr: (destPix bitAnd:
> dstMask) << dstShift.
>                         "adjust dest pix index"
>                         dstShift := dstShift + dstShiftInc.
>                         "adjust source pix index"
>                         ((srcShift := srcShift + srcShiftInc) bitAnd:
> 16rFFFFFFE0) = 0 ifFalse:[
>                                 sourceMSB ifTrue:[srcShift := srcShift +
> 32] ifFalse:[srcShift := srcShift - 32].
>                                 sourceWord := self srcLongAt: (self
> incSrcIndex: 4)].
>                 (nPix := nPix - 1) = 0] whileFalse.
>         ] ifFalse:[
>                 [       "grab, colormap and mix in pixel"
>                         sourcePix := sourceWord >> srcShift bitAnd:
> srcMask.
>                         destPix := self mapPixel: sourcePix flags:
> mapperFlags.
>                         destWord := destWord bitOr: (destPix bitAnd:
> dstMask) << dstShift.
>                         "adjust dest pix index"
>                         dstShift := dstShift + dstShiftInc.
>                         "adjust source pix index"
>                         ((srcShift := srcShift + srcShiftInc) bitAnd:
> 16rFFFFFFE0) = 0 ifFalse:[
>                                 sourceMSB ifTrue:[srcShift := srcShift +
> 32] ifFalse:[srcShift := srcShift - 32].
>                                 sourceWord := self srcLongAt: (self
> incSrcIndex: 4)].
>                 (nPix := nPix - 1) = 0] whileFalse.
>         ].
>         srcBitShift := srcShift. "Store back"
>         ^destWord
>   !
>
> Item was changed:
>   ----- Method: BitBltSimulation>>pickWarpPixelAtX:y: (in category 'pixel
> mapping') -----
>   pickWarpPixelAtX: xx y: yy
>         "Pick a single pixel from the source for WarpBlt.
>         Note: This method is crucial for WarpBlt speed w/o smoothing
>         and still relatively important when smoothing is used."
>         | x y srcIndex sourceWord sourcePix |
>         <inline: true> "*please*"
> +       <returnTypeC: #'unsigned int'>
> +       <var: #sourceWord type: #'unsigned int'>
>
>         "note: it would be much faster if we could just
>         avoid these stupid tests for being inside sourceForm."
>         (xx < 0 or:[yy < 0 or:[
>                 (x := xx >> BinaryPoint) >= sourceWidth or:[
>                         (y := yy >> BinaryPoint) >= sourceHeight]]])
> ifTrue:[^0]. "out of bounds"
>
>         "Fetch source word.
>         Note: We should really update srcIndex with sx and sy so that
>         we don't have to do the computation below. We might even be
>         able to simplify the out of bounds test from above."
>         srcIndex := sourceBits + (y * sourcePitch) + (x >> warpAlignShift
> * 4).
>         sourceWord := self srcLongAt: srcIndex.
>
>         "Extract pixel from word"
>         srcBitShift := warpBitShiftTable at: (x bitAnd: warpAlignMask).
>         sourcePix := sourceWord >> srcBitShift bitAnd: warpSrcMask.
>         ^sourcePix!
>
> Item was changed:
>   ----- Method: BitBltSimulation>>pixClear:with: (in category 'combination
> rules') -----
>   pixClear: sourceWord with: destinationWord
>         "Clear all pixels in destinationWord for which the pixels of
> sourceWord have the same values. Used to clear areas of some constant color
> to zero."
>         | mask result nBits pv |
>         <inline: false>
> +       <returnTypeC: 'unsigned int'>
> +       <var: #sourceWord type: 'unsigned int'>
> +       <var: #destinationWord type: 'unsigned int'>
> +       <var: #mask type: 'unsigned int'>
> +       <var: #pv type: 'unsigned int'>
> +       <var: #result type: 'unsigned int'>
>         destDepth = 32 ifTrue:[
>                 sourceWord = destinationWord ifTrue:[^0]
> ifFalse:[^destinationWord].
>         ].
>         nBits := destDepth.
>         mask := maskTable at: nBits.  "partition mask starts at the right"
>         result := 0.
>         1 to: destPPW do:[:i |
>                 pv := destinationWord bitAnd: mask.
>                 (sourceWord bitAnd: mask) = pv ifTrue:[pv := 0].
>                 result := result bitOr: pv.
>                 mask := mask << nBits "slide left to next partition"].
>         ^ result!
>
> Item was changed:
>   ----- Method: BitBltSimulation>>pixMask:with: (in category 'combination
> rules') -----
>   pixMask: sourceWord with: destinationWord
>         <inline: false>
> +       <returnTypeC: 'unsigned int'>
> +       <var: #sourceWord type: 'unsigned int'>
> +       <var: #destinationWord type: 'unsigned int'>
>         ^ self partitionedAND: sourceWord bitInvert32 to: destinationWord
>                                         nBits: destDepth nPartitions:
> destPPW!
>
> Item was changed:
>   ----- Method: BitBltSimulation>>pixPaint:with: (in category 'combination
> rules') -----
>   pixPaint: sourceWord with: destinationWord
>         <inline: false>
> +       <returnTypeC: 'unsigned int'>
> +       <var: #sourceWord type: 'unsigned int'>
> +       <var: #destinationWord type: 'unsigned int'>
>         sourceWord = 0 ifTrue: [^ destinationWord].
>         ^ sourceWord bitOr:
>                 (self partitionedAND: sourceWord bitInvert32 to:
> destinationWord
>                                                 nBits: destDepth
> nPartitions: destPPW)!
>
> Item was changed:
>   ----- Method: BitBltSimulation>>pixSwap:with: (in category 'combination
> rules') -----
>   pixSwap: sourceWord with: destWord
>         "Swap the pixels in destWord"
>         | result shift lowMask highMask |
>         <inline: false>
> +       <returnTypeC: 'unsigned int'>
> +       <var: #sourceWord type: 'unsigned int'>
> +       <var: #destWord type: 'unsigned int'>
> +       <var: #lowMask type: 'unsigned int'>
> +       <var: #highMask type: 'unsigned int'>
> +       <var: #result type: 'unsigned int'>
>         destPPW = 1 ifTrue:[^destWord]. "a single pixel per word"
>         result := 0.
>         lowMask := (1 << destDepth) - 1. "mask low pixel"
>         highMask := lowMask << (destPPW-1 * destDepth). "mask high pixel"
>         shift := 32 - destDepth.
>         result := result bitOr: (
>                                 (destWord bitAnd: lowMask) << shift bitOr:
>                                         (destWord bitAnd: highMask) >>
> shift).
>         destPPW <= 2 ifTrue:[^result].
>         2 to: destPPW // 2 do:[:i|
>                 lowMask := lowMask << destDepth.
>                 highMask := highMask >> destDepth.
>                 shift := shift - (destDepth * 2).
>                 result := result bitOr: (
>                                         (destWord bitAnd: lowMask) <<
> shift bitOr:
>                                                 (destWord bitAnd:
> highMask) >> shift)].
>         ^result!
>
> Item was changed:
>   ----- Method: BitBltSimulation>>rgbAdd:with: (in category 'combination
> rules') -----
>   rgbAdd: sourceWord with: destinationWord
>         <inline: false>
> +       <returnTypeC: 'unsigned int'>
>         <var: #sourceWord type: 'unsigned int'>
>         <var: #destinationWord type: 'unsigned int'>
>         <var: #carryOverflowMask type: 'unsigned int'>
>         <var: #componentMask type: 'unsigned int'>
>         | componentMask carryOverflowMask |
>         destDepth < 16 ifTrue:
>                 ["Add each pixel separately"
>                 componentMask := 1<<destDepth-1.
>                 carryOverflowMask :=
> 16rFFFFFFFF//componentMask<<(destDepth-1).
>                 ^ self partitionedAdd: sourceWord to: destinationWord
>                                                 nBits: destDepth
> componentMask: componentMask carryOverflowMask: carryOverflowMask].
>         destDepth = 16 ifTrue:
>                 ["Add RGB components of each pixel separately"
>                 componentMask := 16r1F.
>                 carryOverflowMask := 16r42104210.
>                 ^ (self partitionedAdd: (sourceWord bitAnd: 16r7FFF7FFF)
> to: (destinationWord bitAnd: 16r7FFF7FFF) "make sure that the unused bit is
> at 0"
>                                                 nBits: 5 componentMask:
> componentMask carryOverflowMask: carryOverflowMask)]
>         ifFalse:
>                 ["Add RGBA components of the pixel separately"
>                 componentMask := 16rFF.
>                 carryOverflowMask := 16r80808080.
>                 ^ self partitionedAdd: sourceWord to: destinationWord
>                                                 nBits: 8 componentMask:
> componentMask carryOverflowMask: carryOverflowMask]!
>
> Item was changed:
>   ----- Method: BitBltSimulation>>rgbComponentAlpha16 (in category
> 'combination rules') -----
>   rgbComponentAlpha16
>         "This version assumes
>                 combinationRule = 41
>                 sourcePixSize = 32
>                 destPixSize = 16
>                 sourceForm ~= destForm.
>         "
>         <inline: false>  "This particular method should be optimized in
> itself"
> +       <var: #sourceWord type: #'unsigned int'>
> +       <var: #destWord type: #'unsigned int'>
> +       <var: #dstMask type: #'unsigned int'>
>
>         | srcIndex dstIndex sourceWord srcAlpha destWord deltaX deltaY
>         srcY dstY dstMask srcShift ditherBase ditherIndex ditherThreshold |
>
>         deltaY := bbH + 1. "So we can pre-decrement"
>         srcY := sy.
>         dstY := dy.
>         srcShift := (dx bitAnd: 1) * 16.
>         destMSB ifTrue:[srcShift := 16 - srcShift].
>         mask1 := 16rFFFF << (16 - srcShift).
>         "This is the outer loop"
>         [(deltaY := deltaY - 1) ~= 0] whileTrue:[
>                 srcIndex := sourceBits + (srcY * sourcePitch) + (sx * 4).
>                 dstIndex := destBits + (dstY * destPitch) + (dx // 2 * 4).
>                 ditherBase := (dstY bitAnd: 3) * 4.
>                 ditherIndex := (sx bitAnd: 3) - 1. "For pre-increment"
>                 deltaX := bbW + 1. "So we can pre-decrement"
>                 dstMask := mask1.
>                 dstMask = 16rFFFF ifTrue:[srcShift := 16]
> ifFalse:[srcShift := 0].
>
>                 "This is the inner loop"
>                 [(deltaX := deltaX - 1) ~= 0] whileTrue:[
>                         ditherThreshold := ditherMatrix4x4 at: ditherBase
> + (ditherIndex := ditherIndex + 1 bitAnd: 3).
>                         sourceWord := self srcLongAt: srcIndex.
>                         srcAlpha := sourceWord bitAnd: 16rFFFFFF.
>                                 srcAlpha = 0 ifFalse:[ "0 < srcAlpha"
>                                         "If we have to mix colors then
> just copy a single word"
>                                         destWord := self dstLongAt:
> dstIndex.
>                                         destWord := destWord bitAnd:
> dstMask bitInvert32.
>                                         destWord := destWord >> srcShift.
>                                         "Expand from 16 to 32 bit by
> adding zero bits"
>                                         destWord := (((destWord bitAnd:
> 16r7C00) bitShift: 9) bitOr:
>
> ((destWord bitAnd: 16r3E0) bitShift: 6)) bitOr:
>
> (((destWord bitAnd: 16r1F) bitShift: 3) bitOr:
>
> 16rFF000000).
>                                         "Mix colors"
>                                         sourceWord := self
> rgbComponentAlpha32: sourceWord with: destWord.
>                                         "And dither"
>                                         sourceWord := self dither32To16:
> sourceWord threshold: ditherThreshold.
>                                         sourceWord = 0
>                                                 ifTrue:[sourceWord := 1 <<
> srcShift]
>                                                 ifFalse:[sourceWord :=
> sourceWord << srcShift].
>                                         "Store back"
>                                         self dstLongAt: dstIndex put:
> sourceWord mask: dstMask.
>                                 ].
>                         srcIndex := srcIndex + 4.
>                         destMSB
>                                 ifTrue:[srcShift = 0 ifTrue:[dstIndex :=
> dstIndex + 4]]
>                                 ifFalse:[srcShift = 0 ifFalse:[dstIndex :=
> dstIndex + 4]].
>                         srcShift := srcShift bitXor: 16. "Toggle between 0
> and 16"
>                         dstMask := dstMask bitInvert32. "Mask other half
> word"
>                 ].
>                 srcY := srcY + 1.
>                 dstY := dstY + 1.
>         ].
>   !
>
> Item was changed:
>   ----- Method: BitBltSimulation>>rgbComponentAlpha32 (in category
> 'combination rules') -----
>   rgbComponentAlpha32
>         "This version assumes
>                 combinationRule = 41
>                 sourcePixSize = destPixSize = 32
>                 sourceForm ~= destForm.
>         Note: The inner loop has been optimized for dealing
>                 with the special case of aR = aG = aB = 0
>         "
>         | srcIndex dstIndex sourceWord srcAlpha destWord deltaX deltaY
> srcY dstY |
>
>         <inline: false> "This particular method should be optimized in
> itself"
>
>         "Give the compile a couple of hints"
> -       <var: #sourceWord type: 'register long'>
>         <var: #deltaX type: 'register long'>
> +       <var: #sourceWord type: #'unsigned int'>
> +       <var: #destWord type: #'unsigned int'>
>
>         "The following should be declared as pointers so the compiler will
>         notice that they're used for accessing memory locations
>         (good to know on an Intel architecture) but then the increments
>         would be different between ST code and C code so must hope the
>         compiler notices what happens (MS Visual C does)"
>         <var: #srcIndex type: 'register long'>
>         <var: #dstIndex type: 'register long'>
>
>         deltaY := bbH + 1. "So we can pre-decrement"
>         srcY := sy.
>         dstY := dy.
>
>         "This is the outer loop"
>         [(deltaY := deltaY - 1) ~= 0] whileTrue:[
>                 srcIndex := sourceBits + (srcY * sourcePitch) + (sx * 4).
>                 dstIndex := destBits + (dstY * destPitch) + (dx * 4).
>                 deltaX := bbW + 1. "So we can pre-decrement"
>
>                 "This is the inner loop"
>                 [(deltaX := deltaX - 1) ~= 0] whileTrue:[
>                         sourceWord := self srcLongAt: srcIndex.
>                         srcAlpha := sourceWord bitAnd:16rFFFFFF.
>                                 srcAlpha = 0 ifTrue:[
>                                         srcIndex := srcIndex + 4.
>                                         dstIndex := dstIndex + 4.
>                                         "Now skip as many words as
> possible,"
>                                         [(deltaX := deltaX - 1) ~= 0 and:[
>                                                 ((sourceWord := self
> srcLongAt: srcIndex) bitAnd:16rFFFFFF) = 0]]
>                                                 whileTrue:[
>                                                         srcIndex :=
> srcIndex + 4.
>                                                         dstIndex :=
> dstIndex + 4.
>                                                 ].
>                                         "Adjust deltaX"
>                                         deltaX := deltaX + 1.
>                                 ] ifFalse:[ "0 < srcAlpha"
>                                         "If we have to mix colors then
> just copy a single word"
>                                         destWord := self dstLongAt:
> dstIndex.
>                                         destWord := self
> rgbComponentAlpha32: sourceWord with: destWord.
>                                         self dstLongAt: dstIndex put:
> destWord.
>                                         srcIndex := srcIndex + 4.
>                                         dstIndex := dstIndex + 4.
>                                 ].
>                 ].
>                 srcY := srcY + 1.
>                 dstY := dstY + 1.
>         ].!
>
> Item was changed:
>   ----- Method: BitBltSimulation>>rgbComponentAlpha8 (in category
> 'combination rules') -----
>   rgbComponentAlpha8
>         "This version assumes
>                 combinationRule = 41
>                 sourcePixSize = 32
>                 destPixSize = 8
>                 sourceForm ~= destForm.
>         Note: This is not real blending since we don't have the source
> colors available.
>         "
>
>         | srcIndex dstIndex sourceWord srcAlpha destWord deltaX deltaY
>         srcY dstY dstMask srcShift adjust mappingTable mapperFlags |
>
>         <inline: false>  "This particular method should be optimized in
> itself"
>         <var: #mappingTable declareC:'unsigned int *mappingTable'>
> +       <var: #sourceWord type: #'unsigned int'>
> +       <var: #destWord type: #'unsigned int'>
> +       <var: #dstMask type: #'unsigned int'>
>
>         mappingTable := self default8To32Table.
>         mapperFlags := cmFlags bitAnd: ColorMapNewStyle bitInvert32.
>         deltaY := bbH + 1. "So we can pre-decrement"
>         srcY := sy.
>         dstY := dy.
>         mask1 := ((dx bitAnd: 3) * 8).
>         destMSB ifTrue:[mask1 := 24 - mask1].
>         mask2 := AllOnes bitXor:(16rFF << mask1).
>         (dx bitAnd: 1) = 0
>                 ifTrue:[adjust := 0]
>                 ifFalse:[adjust := 16r1F1F1F1F].
>         (dy bitAnd: 1) = 0
>                 ifTrue:[adjust := adjust bitXor: 16r1F1F1F1F].
>         "This is the outer loop"
>         [(deltaY := deltaY - 1) ~= 0] whileTrue:[
>                 adjust := adjust bitXor: 16r1F1F1F1F.
>                 srcIndex := sourceBits + (srcY * sourcePitch) + (sx * 4).
>                 dstIndex := destBits + (dstY * destPitch) + (dx // 4 * 4).
>                 deltaX := bbW + 1. "So we can pre-decrement"
>                 srcShift := mask1.
>                 dstMask := mask2.
>
>                 "This is the inner loop"
>                 [(deltaX := deltaX - 1) ~= 0] whileTrue:[
>                         sourceWord := ((self srcLongAt: srcIndex) bitAnd:
> (adjust bitInvert32)) + adjust.
>                         srcAlpha := sourceWord bitAnd: 16rFFFFFF.
>                         "set srcAlpha to the average of the 3 separate
> aR,Ag,AB values"
>                         srcAlpha := ((srcAlpha >> 16) + (srcAlpha >> 8
> bitAnd: 16rFF) + (srcAlpha bitAnd: 16rFF)) // 3.
>                         srcAlpha > 31 ifTrue:["Everything below 31 is
> transparent"
>                                 srcAlpha > 224
>                                         ifTrue: ["treat everything above
> 224 as opaque"
>                                                 sourceWord := 16rFFFFFFFF].
>                                 destWord := self dstLongAt: dstIndex.
>                                 destWord := destWord bitAnd: dstMask
> bitInvert32.
>                                 destWord := destWord >> srcShift.
>                                 destWord := mappingTable at: destWord.
>                                 sourceWord := self rgbComponentAlpha32:
> sourceWord with: destWord.
>                                 sourceWord := self mapPixel: sourceWord
> flags: mapperFlags.
>                                 sourceWord := sourceWord << srcShift.
>                                 "Store back"
>                                 self dstLongAt: dstIndex put: sourceWord
> mask: dstMask.
>                         ].
>                         srcIndex := srcIndex + 4.
>                         destMSB ifTrue:[
>                                 srcShift = 0
>                                         ifTrue:[dstIndex := dstIndex + 4.
>                                                         srcShift := 24.
>                                                         dstMask :=
> 16r00FFFFFF]
>                                         ifFalse:[srcShift := srcShift - 8.
>                                                         dstMask :=
> (dstMask >> 8) bitOr: 16rFF000000].
>                         ] ifFalse:[
>                                 srcShift = 32
>                                         ifTrue:[dstIndex := dstIndex + 4.
>                                                         srcShift := 0.
>                                                         dstMask :=
> 16rFFFFFF00]
>                                         ifFalse:[srcShift := srcShift + 8.
>                                                         dstMask := dstMask
> << 8 bitOr: 255].
>                         ].
>                         adjust := adjust bitXor: 16r1F1F1F1F.
>                 ].
>                 srcY := srcY + 1.
>                 dstY := dstY + 1.
>         ].
>   !
>
> Item was changed:
>   ----- Method: BitBltSimulation>>rgbDiff:with: (in category 'combination
> rules') -----
>   rgbDiff: sourceWord with: destinationWord
>         "Subract the pixels in the source and destination, color by color,
>         and return the sum of the absolute value of all the differences.
>         For non-rgb, return the number of differing pixels."
>         | pixMask destShifted sourceShifted destPixVal bitsPerColor
> rgbMask sourcePixVal diff maskShifted |
>         <inline: false>
> +       <returnTypeC: 'unsigned int'>
> +       <var: #sourceWord type: 'unsigned int'>
> +       <var: #destinationWord 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'>
>         pixMask := maskTable at: destDepth.
>         destDepth = 16
>                 ifTrue: [bitsPerColor := 5.  rgbMask := 16r1F]
>                 ifFalse: [bitsPerColor := 8.  rgbMask := 16rFF].
>         maskShifted := destMask.
>         destShifted := destinationWord.
>         sourceShifted := sourceWord.
>         1 to: destPPW do:
>                 [:i |
>                 (maskShifted bitAnd: pixMask) > 0 ifTrue:
>                         ["Only tally pixels within the destination
> rectangle"
>                         destPixVal := destShifted bitAnd: pixMask.
>                         sourcePixVal := sourceShifted bitAnd: pixMask.
>                         destDepth < 16
>                                 ifTrue: [sourcePixVal = destPixVal
>                                                         ifTrue: [diff := 0]
>                                                         ifFalse: [diff :=
> 1]]
>                                 ifFalse: [diff := (self partitionedSub:
> sourcePixVal from: destPixVal
>                                                                 nBits:
> bitsPerColor nPartitions: 3).
>                                                 diff := (diff bitAnd:
> rgbMask)
>                                                         +
> (diff>>bitsPerColor bitAnd: rgbMask)
>                                                         +
> ((diff>>bitsPerColor)>>bitsPerColor bitAnd: rgbMask)].
>                         bitCount := bitCount + diff].
>                 maskShifted := maskShifted >> destDepth.
>                 sourceShifted := sourceShifted >> destDepth.
>                 destShifted := destShifted >> destDepth].
>         ^ destinationWord  "For no effect on dest"
>   !
>
> Item was changed:
>   ----- Method: BitBltSimulation>>rgbMax:with: (in category 'combination
> rules') -----
>   rgbMax: sourceWord with: destinationWord
>         <inline: false>
> +       <returnTypeC: 'unsigned int'>
> +       <var: #sourceWord type: 'unsigned int'>
> +       <var: #destinationWord type: 'unsigned int'>
>         destDepth < 16 ifTrue:
>                 ["Max each pixel separately"
>                 ^ self partitionedMax: sourceWord with: destinationWord
>                                                 nBits: destDepth
> nPartitions: destPPW].
>         destDepth = 16 ifTrue:
>                 ["Max RGB components of each pixel separately"
>                 ^ (self partitionedMax: sourceWord with: destinationWord
>                                                 nBits: 5 nPartitions: 3)
>                 + ((self partitionedMax: sourceWord>>16 with:
> destinationWord>>16
>                                                 nBits: 5 nPartitions: 3)
> << 16)]
>         ifFalse:
>                 ["Max RGBA components of the pixel separately"
>                 ^ self partitionedMax: sourceWord with: destinationWord
>                                                 nBits: 8 nPartitions: 4]!
>
> Item was changed:
>   ----- Method: BitBltSimulation>>rgbMin:with: (in category 'combination
> rules') -----
>   rgbMin: sourceWord with: destinationWord
>         <inline: false>
> +       <returnTypeC: 'unsigned int'>
> +       <var: #sourceWord type: 'unsigned int'>
> +       <var: #destinationWord type: 'unsigned int'>
>         destDepth < 16 ifTrue:
>                 ["Min each pixel separately"
>                 ^ self partitionedMin: sourceWord with: destinationWord
>                                                 nBits: destDepth
> nPartitions: destPPW].
>         destDepth = 16 ifTrue:
>                 ["Min RGB components of each pixel separately"
>                 ^ (self partitionedMin: sourceWord with: destinationWord
>                                                 nBits: 5 nPartitions: 3)
>                 + ((self partitionedMin: sourceWord>>16 with:
> destinationWord>>16
>                                                 nBits: 5 nPartitions: 3)
> << 16)]
>         ifFalse:
>                 ["Min RGBA components of the pixel separately"
>                 ^ self partitionedMin: sourceWord with: destinationWord
>                                                 nBits: 8 nPartitions: 4]!
>
> Item was changed:
>   ----- Method: BitBltSimulation>>rgbMinInvert:with: (in category
> 'combination rules') -----
>   rgbMinInvert: wordToInvert with: destinationWord
>         | sourceWord |
>         <inline: false>
> +       <returnTypeC: 'unsigned int'>
> +       <var: #wordToInvert type: 'unsigned int'>
> +       <var: #sourceWord type: 'unsigned int'>
> +       <var: #destinationWord type: 'unsigned int'>
>         sourceWord := wordToInvert bitInvert32.
>         destDepth < 16 ifTrue:
>                 ["Min each pixel separately"
>                 ^ self partitionedMin: sourceWord with: destinationWord
>                                                 nBits: destDepth
> nPartitions: destPPW].
>         destDepth = 16 ifTrue:
>                 ["Min RGB components of each pixel separately"
>                 ^ (self partitionedMin: sourceWord with: destinationWord
>                                                 nBits: 5 nPartitions: 3)
>                 + ((self partitionedMin: sourceWord>>16 with:
> destinationWord>>16
>                                                 nBits: 5 nPartitions: 3)
> << 16)]
>         ifFalse:
>                 ["Min RGBA components of the pixel separately"
>                 ^ self partitionedMin: sourceWord with: destinationWord
>                                                 nBits: 8 nPartitions: 4]!
>
> Item was changed:
>   ----- Method: BitBltSimulation>>rgbMul:with: (in category 'combination
> rules') -----
>   rgbMul: sourceWord with: destinationWord
>         <inline: false>
> +       <returnTypeC: 'unsigned int'>
> +       <var: #sourceWord type: 'unsigned int'>
> +       <var: #destinationWord type: 'unsigned int'>
>         destDepth < 16 ifTrue:
>                 ["Mul each pixel separately"
>                 ^ self partitionedMul: sourceWord with: destinationWord
>                                                 nBits: destDepth
> nPartitions: destPPW].
>         destDepth = 16 ifTrue:
>                 ["Mul RGB components of each pixel separately"
>                 ^ (self partitionedMul: sourceWord with: destinationWord
>                                                 nBits: 5 nPartitions: 3)
>                 + ((self partitionedMul: sourceWord>>16 with:
> destinationWord>>16
>                                                 nBits: 5 nPartitions: 3)
> << 16)]
>         ifFalse:
>                 ["Mul RGBA components of the pixel separately"
>                 ^ self partitionedMul: sourceWord with: destinationWord
>                                                 nBits: 8 nPartitions: 4]
>
>   "     | scanner |
>         Display repaintMorphicDisplay.
>         scanner := DisplayScanner quickPrintOn: Display.
>         MessageTally time: [0 to: 760 by: 4 do:  [:y |scanner drawString:
> 'qwrepoiuasfd=)(/&()=#!!〕kjzxv.,mn124+09857907QROIYTOAFDJZXNBNB,M-.,Mqwrepoiuasfd=)(/&()=#!!〕kjzxv.,mn124+09857907QROIYTOAFDJZXNBNB,M-.,M1234124356785678'
> at: 0 at y]]. "!
>
> Item was changed:
>   ----- Method: BitBltSimulation>>rgbSub:with: (in category 'combination
> rules') -----
>   rgbSub: sourceWord with: destinationWord
>         <inline: false>
> +       <returnTypeC: 'unsigned int'>
> +       <var: #sourceWord type: 'unsigned int'>
> +       <var: #destinationWord type: 'unsigned int'>
>         destDepth < 16 ifTrue:
>                 ["Sub each pixel separately"
>                 ^ self partitionedSub: sourceWord from: destinationWord
>                                                 nBits: destDepth
> nPartitions: destPPW].
>         destDepth = 16 ifTrue:
>                 ["Sub RGB components of each pixel separately"
>                 ^ (self partitionedSub: sourceWord from: destinationWord
>                                                 nBits: 5 nPartitions: 3)
>                 + ((self partitionedSub: sourceWord>>16 from:
> destinationWord>>16
>                                                 nBits: 5 nPartitions: 3)
> << 16)]
>         ifFalse:
>                 ["Sub RGBA components of the pixel separately"
>                 ^ self partitionedSub: sourceWord from: destinationWord
>                                                 nBits: 8 nPartitions: 4]!
>
> Item was changed:
>   ----- Method: BitBltSimulation>>sourceWord:with: (in category
> 'combination rules') -----
>   sourceWord: sourceWord with: destinationWord
> +       <returnTypeC: 'unsigned int'>
> +       <var: #sourceWord type: 'unsigned int'>
> +       <var: #destinationWord type: 'unsigned int'>
>         ^sourceWord!
>
> Item was changed:
>   ----- Method: BitBltSimulation>>subWord:with: (in category 'combination
> rules') -----
>   subWord: sourceWord with: destinationWord
> +       <returnTypeC: 'unsigned int'>
> +       <var: #sourceWord type: 'unsigned int'>
> +       <var: #destinationWord type: 'unsigned int'>
>         ^sourceWord - destinationWord!
>
> Item was changed:
>   ----- Method: BitBltSimulation>>tallyIntoMap:with: (in category
> 'combination rules') -----
>   tallyIntoMap: sourceWord with: destinationWord
>         "Tally pixels into the color map.  Those tallied are exactly those
>         in the destination rectangle.  Note that the source should be
>         specified == destination, in order for the proper color map checks
>         to be performed at setup."
>         | mapIndex pixMask destShifted maskShifted pixVal |
>         <inline: false>
> +       <returnTypeC: 'unsigned int'>
> +       <var: #sourceWord type: 'unsigned int'>
> +       <var: #destinationWord type: 'unsigned int'>
> +       <var: #pixMask type: 'unsigned int'>
> +       <var: #destShifted type: 'unsigned int'>
> +       <var: #maskShifted type: 'unsigned int'>
>         (cmFlags bitAnd: (ColorMapPresent bitOr: ColorMapIndexedPart)) =
>                 (ColorMapPresent bitOr: ColorMapIndexedPart)
>                         ifFalse: [^ destinationWord "no op"].
>         pixMask := maskTable at: destDepth.
>         destShifted := destinationWord.
>         maskShifted := destMask.
>         1 to: destPPW do:
>                 [:i |
>                 (maskShifted bitAnd: pixMask) = 0 ifFalse:
>                         ["Only tally pixels within the destination
> rectangle"
>                         pixVal := destShifted bitAnd: pixMask.
>                         destDepth < 16
>                                 ifTrue: [mapIndex := pixVal]
>                                 ifFalse: [destDepth = 16
>                                         ifTrue: [mapIndex := self rgbMap:
> pixVal from: 5 to: cmBitsPerColor]
>                                         ifFalse: [mapIndex := self rgbMap:
> pixVal from: 8 to: cmBitsPerColor]].
>                         self tallyMapAt: mapIndex put: (self tallyMapAt:
> mapIndex) + 1].
>                 maskShifted := maskShifted >> destDepth.
>                 destShifted := destShifted >> destDepth].
>         ^ destinationWord  "For no effect on dest"!
>
> Item was changed:
>   ----- Method: BitBltSimulation>>warpLoop (in category 'inner loop') -----
>   warpLoop
>         "This version of the inner loop traverses an arbirary quadrilateral
>         source, thus producing a general affine transformation."
>         | skewWord halftoneWord mergeWord startBits
>           deltaP12x deltaP12y deltaP43x deltaP43y pAx pAy pBx pBy
>           xDelta yDelta smoothingCount sourceMapOop
>           nSteps nPix words destWord endBits mergeFnwith dstShiftInc
> dstShiftLeft mapperFlags |
> +       <inline: false>
> +       <var: #mergeFnwith declareC: 'unsigned int (*mergeFnwith)(unsigned
> int, unsigned int)'>
> +       <var: #skewWord type: #'unsigned int'>
> +       <var: #halftoneWord type: #'unsigned int'>
> +       <var: #mergeWord type: #'unsigned int'>
> +       <var: #destWord type: #'unsigned int'>
> +       mergeFnwith := self cCoerce: (opTable at: combinationRule+1) to:
> 'unsigned int (*)(unsigned int, unsigned int)'.
> -       <inline: false>
> -       <var: #mergeFnwith declareC: 'sqInt (*mergeFnwith)(sqInt, sqInt)'>
> -       mergeFnwith := self cCoerce: (opTable at: combinationRule+1) to:
> 'sqInt (*)(sqInt, sqInt)'.
>         mergeFnwith.  "null ref for compiler"
>
>         (interpreterProxy slotSizeOf: bitBltOop) >= (BBWarpBase+12)
>                 ifFalse: [^ interpreterProxy primitiveFail].
>         nSteps := height-1.  nSteps <= 0 ifTrue: [nSteps := 1].
>
>         pAx := self fetchIntOrFloat: BBWarpBase ofObject: bitBltOop.
>         words := self fetchIntOrFloat: BBWarpBase+3 ofObject: bitBltOop.
>         deltaP12x := self deltaFrom: pAx to: words nSteps: nSteps.
>         deltaP12x < 0 ifTrue: [pAx := words - (nSteps*deltaP12x)].
>
>         pAy := self fetchIntOrFloat: BBWarpBase+1 ofObject: bitBltOop.
>         words := self fetchIntOrFloat: BBWarpBase+4 ofObject: bitBltOop.
>         deltaP12y := self deltaFrom: pAy to: words nSteps: nSteps.
>         deltaP12y < 0 ifTrue: [pAy := words - (nSteps*deltaP12y)].
>
>         pBx := self fetchIntOrFloat: BBWarpBase+9 ofObject: bitBltOop.
>         words := self fetchIntOrFloat: BBWarpBase+6 ofObject: bitBltOop.
>         deltaP43x := self deltaFrom: pBx to: words nSteps: nSteps.
>         deltaP43x < 0 ifTrue: [pBx := words - (nSteps*deltaP43x)].
>
>         pBy := self fetchIntOrFloat: BBWarpBase+10 ofObject: bitBltOop.
>         words := self fetchIntOrFloat: BBWarpBase+7 ofObject: bitBltOop.
>         deltaP43y := self deltaFrom: pBy to: words nSteps: nSteps.
>         deltaP43y < 0 ifTrue: [pBy := words - (nSteps*deltaP43y)].
>
>         interpreterProxy failed ifTrue: [^ false].  "ie if non-integers
> above"
>         interpreterProxy methodArgumentCount = 2
>                 ifTrue: [smoothingCount := interpreterProxy
> stackIntegerValue: 1.
>                                 sourceMapOop := interpreterProxy
> stackValue: 0.
>                                 sourceMapOop = interpreterProxy nilObject
>                                 ifTrue: [sourceDepth < 16 ifTrue:
>                                         ["color map is required to smooth
> non-RGB dest"
>                                         ^ interpreterProxy primitiveFail]]
>                                 ifFalse: [(interpreterProxy slotSizeOf:
> sourceMapOop)
>                                                         < (1 <<
> sourceDepth) ifTrue:
>                                         ["sourceMap must be long enough
> for sourceDepth"
>                                         ^ interpreterProxy primitiveFail].
>                                         sourceMapOop := self
> oopForPointer: (interpreterProxy firstIndexableField: sourceMapOop)]]
>                 ifFalse: [smoothingCount := 1.
>                                 sourceMapOop := interpreterProxy
> nilObject].
>         nSteps := width-1.  nSteps <= 0 ifTrue: [nSteps := 1].
>         startBits := destPPW - (dx bitAnd: destPPW-1).
>         endBits := ((dx + bbW - 1) bitAnd: destPPW-1) + 1.
>         bbW < startBits ifTrue:[startBits := bbW].
>
>         destY < clipY ifTrue:[
>                 "Advance increments if there was clipping in y"
>                 pAx := pAx + (clipY - destY * deltaP12x).
>                 pAy := pAy + (clipY - destY * deltaP12y).
>                 pBx := pBx + (clipY - destY * deltaP43x).
>                 pBy := pBy + (clipY - destY * deltaP43y)].
>
>         "Setup values for faster pixel fetching."
>         self warpLoopSetup.
>         "Setup color mapping if not provided"
>         (smoothingCount > 1 and:[(cmFlags bitAnd: ColorMapNewStyle) = 0])
> ifTrue:[
>                 cmLookupTable == nil ifTrue:[
>                         destDepth = 16 ifTrue:[self setupColorMasksFrom: 8
> to: 5].
>                 ] ifFalse:[
>                         self setupColorMasksFrom: 8 to: cmBitsPerColor.
>                 ].
>         ].
>         mapperFlags := cmFlags bitAnd: ColorMapNewStyle bitInvert32.
>
>         destMSB
>                 ifTrue:[        dstShiftInc := 0 - destDepth.
>                                 dstShiftLeft := 32 - destDepth]
>                 ifFalse:[       dstShiftInc := destDepth.
>                                 dstShiftLeft := 0].
>         1 to: bbH do:
>                 [ :i | "here is the vertical loop..."
>                 xDelta := self deltaFrom: pAx to: pBx nSteps: nSteps.
>                 xDelta >= 0 ifTrue: [sx := pAx] ifFalse: [sx := pBx -
> (nSteps*xDelta)].
>                 yDelta := self deltaFrom: pAy to: pBy nSteps: nSteps.
>                 yDelta >= 0 ifTrue: [sy := pAy] ifFalse: [sy := pBy -
> (nSteps*yDelta)].
>
>                 destMSB
>                         ifTrue:[dstBitShift := 32 - ((dx bitAnd: destPPW -
> 1) + 1 * destDepth)]
>                         ifFalse:[dstBitShift := (dx bitAnd: destPPW - 1) *
> destDepth].
>
>                 (destX < clipX) ifTrue:[
>                         "Advance increments if there was clipping in x"
>                         sx := sx + (clipX - destX * xDelta).
>                         sy := sy + (clipX - destX * yDelta).
>                 ].
>
>                 noHalftone
>                         ifTrue: [halftoneWord := AllOnes]
>                         ifFalse: [halftoneWord := self halftoneAt: dy+i-1].
>                 destMask := mask1.
>                 nPix := startBits.
>                 "Here is the inner loop..."
>                 words := nWords.
>                         ["pick up word"
>                         smoothingCount = 1 ifTrue:["Faster if not
> smoothing"
>                                 skewWord := self warpPickSourcePixels: nPix
>                                                                 xDeltah:
> xDelta yDeltah: yDelta
>                                                                 xDeltav:
> deltaP12x yDeltav: deltaP12y
>
> dstShiftInc: dstShiftInc flags: mapperFlags.
>                         ] ifFalse:["more difficult with smoothing"
>                                 skewWord := self warpPickSmoothPixels: nPix
>                                                 xDeltah: xDelta yDeltah:
> yDelta
>                                                 xDeltav: deltaP12x
> yDeltav: deltaP12y
>                                                 sourceMap: sourceMapOop
>                                                 smoothing: smoothingCount
>                                                 dstShiftInc: dstShiftInc.
>                         ].
>                         "align next word access to left most pixel"
>                         dstBitShift := dstShiftLeft.
>                         destMask = AllOnes ifTrue:["avoid
> read-modify-write"
>                                 mergeWord := self mergeFn: (skewWord
> bitAnd: halftoneWord)
>                                                                 with:
> (self dstLongAt: destIndex).
>                                 self dstLongAt: destIndex put: (destMask
> bitAnd: mergeWord).
>                         ] ifFalse:[ "General version using dest masking"
>                                 destWord := self dstLongAt: destIndex.
>                                 mergeWord := self mergeFn: (skewWord
> bitAnd: halftoneWord)
>                                                                 with:
> (destWord bitAnd: destMask).
>                                 destWord := (destMask bitAnd: mergeWord)
> bitOr:
>                                                                 (destWord
> bitAnd: destMask bitInvert32).
>                                 self dstLongAt: destIndex put: destWord.
>                         ].
>                         self incDestIndex: 4.
>                         words = 2 "e.g., is the next word the last word?"
>                                 ifTrue:["set mask for last word in this
> row"
>                                                 destMask := mask2.
>                                                 nPix := endBits]
>                                 ifFalse:["use fullword mask for inner loop"
>                                                 destMask := AllOnes.
>                                                 nPix := destPPW].
>                         (words := words - 1) = 0] whileFalse.
>                 "--- end of inner loop ---"
>                 pAx := pAx + deltaP12x.
>                 pAy := pAy + deltaP12y.
>                 pBx := pBx + deltaP43x.
>                 pBy := pBy + deltaP43y.
>                 self incDestIndex: destDelta]!
>
> Item was changed:
>   ----- Method:
> BitBltSimulation>>warpPickSmoothPixels:xDeltah:yDeltah:xDeltav:yDeltav:sourceMap:smoothing:dstShiftInc:
> (in category 'pixel mapping') -----
>   warpPickSmoothPixels: nPixels
>         xDeltah: xDeltah yDeltah: yDeltah
>         xDeltav: xDeltav yDeltav: yDeltav
>         sourceMap: sourceMap
>         smoothing: n
>         dstShiftInc: dstShiftInc
>         "Pick n (sub-) pixels from the source form, mapped by sourceMap,
>         average the RGB values, map by colorMap and return the new word.
>         This version is only called from WarpBlt with smoothingCount > 1"
>         | rgb x y a r g b xx yy xdh ydh xdv ydv dstMask destWord i j k
> nPix |
>         <inline: false> "nope - too much stuff in here"
> +       <var: #rgb type: #'unsigned int'>
>         dstMask := maskTable at: destDepth.
>         destWord := 0.
>         n = 2 "Try avoiding divides for most common n (divide by 2 is
> generated as shift)"
>                 ifTrue:[xdh := xDeltah // 2. ydh := yDeltah // 2.
>                                 xdv := xDeltav // 2. ydv := yDeltav // 2]
>                 ifFalse:[xdh := xDeltah // n. ydh := yDeltah // n.
>                                 xdv := xDeltav // n. ydv := yDeltav // n].
>         i := nPixels.
>         [
>                 x := sx. y := sy.
>                 a := r := g := b := 0.
>                 "Pick and average n*n subpixels"
>                 nPix := 0.  "actual number of pixels (not clipped and not
> transparent)"
>                 j := n.
>                 [
>                         xx := x. yy := y.
>                         k := n.
>                         [
>                                 "get a single subpixel"
>                                 rgb := self pickWarpPixelAtX: xx y: yy.
>                                 (combinationRule=25 "PAINT" and: [rgb =
> 0]) ifFalse:[
>                                         "If not clipped and not
> transparent, then tally rgb values"
>                                         nPix := nPix + 1.
>                                         sourceDepth < 16 ifTrue:[
>                                                 "Get RGBA values from
> sourcemap table"
>                                                 rgb := self long32At:
> sourceMap + (rgb << 2).
>                                         ] ifFalse:["Already in RGB format"
>                                                 sourceDepth = 16
>
> ifTrue:[rgb := self rgbMap16To32: rgb]
>
> ifFalse:[rgb := self rgbMap32To32: rgb]].
>                                         b := b + (rgb bitAnd: 255).
>                                         g := g + (rgb >> 8 bitAnd: 255).
>                                         r := r + (rgb >> 16 bitAnd: 255).
>                                         a := a + (rgb >> 24)].
>                                 xx := xx + xdh.
>                                 yy := yy + ydh.
>                         (k := k - 1) = 0] whileFalse.
>                         x := x + xdv.
>                         y := y + ydv.
>                 (j := j - 1) = 0] whileFalse.
>
>                 (nPix = 0 or: [combinationRule=25 "PAINT" and: [nPix < (n
> * n // 2)]]) ifTrue:[
>                         rgb := 0  "All pixels were 0, or most were
> transparent"
>                 ] ifFalse:[
>                         "normalize rgba sums"
>                         nPix = 4 "Try to avoid divides for most common n"
>                                 ifTrue:[r := r >> 2.    g := g >> 2.    b
> := b >> 2.    a := a >> 2]
>                                 ifFalse:[       r := r // nPix. g := g //
> nPix. b := b // nPix. a := a // nPix].
>                         rgb := (a << 24) + (r << 16) + (g << 8) + b.
>
>                         "map the pixel"
>                         rgb = 0 ifTrue: [
>                                 "only generate zero if pixel is really
> transparent"
>                                 (r + g + b + a) > 0 ifTrue: [rgb := 1]].
>                         rgb := self mapPixel: rgb flags: cmFlags.
>                 ].
>                 "Mix it in"
>                 destWord := destWord bitOr: (rgb bitAnd: dstMask) <<
> dstBitShift.
>                 dstBitShift := dstBitShift + dstShiftInc.
>                 sx := sx + xDeltah.
>                 sy := sy + yDeltah.
>         (i := i - 1) = 0] whileFalse.
>
>         ^destWord
>   !
>
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://lists.squeakfoundation.org/pipermail/vm-dev/attachments/20160331/e19e6541/attachment-0001.htm


More information about the Vm-dev mailing list