VM Maker: VMMaker.oscog-eem.2155.mcz

 
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.2155.mcz

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

Name: VMMaker.oscog-eem.2155
Author: eem
Time: 15 March 2017, 1:19:44.707971 pm
UUID: 3804855a-4ebd-45d2-bf24-82e5336e6005
Ancestors: VMMaker.oscog-cb.2154

InterpreterProxy:
Add statNumGCs to answer the count of GCs so far in execution, used by primitives that may callback efficiently to detect the possible moving of objects.  Update vmProxyMinorVersion to 14 to reflect the new function.  Add PrimErrCallbackError to accompany PrimErrObjectMoved & PrimErrObjectNotPinned for informative error codes.

BitBlt plugin:
Check for GC after the query and lock callbacks, failing with PrimErrObjectMoved is so.  Reload source and dest forms in unlockSurface and showSurface if a GC has occurred, to ensure that the handles are accessed correctly.  Add numGCsOnInvocation bitBltIsReceiver inst vars to track GCs and the origin of the BitBlt oop so that reload works for the BalloonEnginePlugin too.  Add BEBitBltIndex class var for reloading in the context of a balloon primitive.  Nuke the unused JitBltHookSize class var.

=============== Diff against VMMaker.oscog-cb.2154 ===============

Item was changed:
  SmartSyntaxInterpreterPlugin subclass: #BitBltSimulation
+ instanceVariableNames: 'destForm sourceForm halftoneForm combinationRule destX destY width height sourceX sourceY clipX clipY clipWidth clipHeight sourceWidth sourceHeight sourceDepth sourcePitch sourceBits sourcePPW sourceMSB destWidth destHeight destDepth destPitch destBits destPPW destMSB bitCount skew mask1 mask2 preload nWords destMask hDir vDir sourceIndex sourceDelta destIndex destDelta sx sy dx dy bbW bbH halftoneHeight noSource noHalftone halftoneBase sourceAlpha srcBitShift dstBitShift bitBltOop affectedL affectedR affectedT affectedB opTable maskTable ditherMatrix4x4 ditherThresholds16 ditherValues16 hasSurfaceLock warpSrcShift warpSrcMask warpAlignShift warpAlignMask warpBitShiftTable querySurfaceFn lockSurfaceFn unlockSurfaceFn isWarping cmFlags cmMask cmShiftTable cmMaskTable cmLookupTable cmBitsPerColor dither8Lookup componentAlphaModeColor componentAlphaModeAlpha ungammaLookupTable gammaLookupTable numGCsOnInvocation bitBltIsReceiver'
+ classVariableNames: 'AllOnes AlphaIndex BBClipHeightIndex BBClipWidthIndex BBClipXIndex BBClipYIndex BBColorMapIndex BBDestFormIndex BBDestXIndex BBDestYIndex BBHalftoneFormIndex BBHeightIndex BBLastIndex BBRuleIndex BBSourceFormIndex BBSourceXIndex BBSourceYIndex BBWarpBase BBWidthIndex BBXTableIndex BEBitBltIndex BinaryPoint BlueIndex ColorMapFixedPart ColorMapIndexedPart ColorMapNewStyle ColorMapPresent CrossedX EndOfRun FixedPt1 FormBitsIndex FormDepthIndex FormHeightIndex FormWidthIndex GreenIndex OpTable OpTableSize RedIndex'
- instanceVariableNames: 'destForm sourceForm halftoneForm combinationRule destX destY width height sourceX sourceY clipX clipY clipWidth clipHeight sourceWidth sourceHeight sourceDepth sourcePitch sourceBits sourcePPW sourceMSB destWidth destHeight destDepth destPitch destBits destPPW destMSB bitCount skew mask1 mask2 preload nWords destMask hDir vDir sourceIndex sourceDelta destIndex destDelta sx sy dx dy bbW bbH halftoneHeight noSource noHalftone halftoneBase sourceAlpha srcBitShift dstBitShift bitBltOop affectedL affectedR affectedT affectedB opTable maskTable ditherMatrix4x4 ditherThresholds16 ditherValues16 hasSurfaceLock warpSrcShift warpSrcMask warpAlignShift warpAlignMask warpBitShiftTable querySurfaceFn lockSurfaceFn unlockSurfaceFn isWarping cmFlags cmMask cmShiftTable cmMaskTable cmLookupTable cmBitsPerColor dither8Lookup componentAlphaModeColor componentAlphaModeAlpha ungammaLookupTable gammaLookupTable'
- classVariableNames: 'AllOnes AlphaIndex BBClipHeightIndex BBClipWidthIndex BBClipXIndex BBClipYIndex BBColorMapIndex BBDestFormIndex BBDestXIndex BBDestYIndex BBHalftoneFormIndex BBHeightIndex BBLastIndex BBRuleIndex BBSourceFormIndex BBSourceXIndex BBSourceYIndex BBWarpBase BBWidthIndex BBXTableIndex BinaryPoint BlueIndex ColorMapFixedPart ColorMapIndexedPart ColorMapNewStyle ColorMapPresent CrossedX EndOfRun FixedPt1 FormBitsIndex FormDepthIndex FormHeightIndex FormWidthIndex GreenIndex JitBltHookSize OpTable OpTableSize RedIndex'
  poolDictionaries: ''
  category: 'VMMaker-Interpreter'!
 
  !BitBltSimulation commentStamp: 'tpr 3/25/2013 16:50' prior: 0!
  This class implements BitBlt, much as specified in the Blue Book spec.
 
  Performance has been enhanced through the use of pointer variables such as sourceIndex and destIndex, and by separating several special cases of the inner loop.
 
  Operation has been extended to color, with support for 1, 2, 4, 8, 16, and 32-bit pixel sizes.  Conversion between different pixel sizes is facilitated by accepting an optional color map.
 
  In addition to the original 16 combination rules, this BitBlt supports
  16 fail (for old paint mode)
  17 fail (for old mask mode)
  18 sourceWord + destinationWord
  19 sourceWord - destinationWord
  20 rgbAdd: sourceWord with: destinationWord
  21 rgbSub: sourceWord with: destinationWord
  22 OLDrgbDiff: sourceWord with: destinationWord
  23 OLDtallyIntoMap: destinationWord -- old vers doesn't clip to bit boundary
  24 alphaBlend: sourceWord with: destinationWord
  25 pixPaint: sourceWord with: destinationWord
  26 pixMask: sourceWord with: destinationWord
  27 rgbMax: sourceWord with: destinationWord
  28 rgbMin: sourceWord with: destinationWord
  29 rgbMin: sourceWord bitInvert32 with: destinationWord
  30 alphaBlendConst: sourceWord with: destinationWord -- alpha passed as an arg
  31 alphaPaintConst: sourceWord with: destinationWord -- alpha passed as an arg
  32 rgbDiff: sourceWord with: destinationWord
  33 tallyIntoMap: destinationWord
  34 alphaBlendScaled: sourceWord with: destinationWord
  35 alphaBlendScaled: sourceWord with: "unused here - only used by FXBlt"
  36 alphaBlendScaled: sourceWord with: "unused here - only used by FXBlt"
  37 rgbMul: sourceWord with: destinationWord
  38 pixSwap: sourceWord with: destinationWord
  39 pixClear: sourceWord with: destinationWord
  40 fixAlpha: sourceWord with: destinationWord
  41 rgbComponentAlpha: sourceWord with: destinationWord
 
  This implementation has also been fitted with an experimental "warp drive" that allows abritrary scaling and rotation (and even limited affine deformations) with all BitBlt storage modes supported.
 
  To add a new rule to BitBlt...
  1.  add the new rule method or methods in the category 'combination rules' of BBSim
  2.  describe it in the class comment  of BBSim and in the class comment for BitBlt
  3.  add refs to initializeRuleTable in proper positions
  4.  add refs to initBBOpTable, following the pattern
  !

Item was changed:
  ----- Method: BitBltSimulation class>>declareCVarsIn: (in category 'translation') -----
  declareCVarsIn: aCCodeGenerator
 
  "add option of  fast path BitBLT code header"
  aCCodeGenerator
+ addHeaderFile:'"sqAssert.h"';
  addHeaderFile:'#ifdef ENABLE_FAST_BLT
  #include "BitBltDispatch.h"
  #else
  // to handle the unavoidable decl in the spec of copyBitsFallback();
  #define operation_t void
  #endif'.
 
  aCCodeGenerator var: 'opTable'
  declareC: 'void *opTable[' , OpTableSize printString , ']'.
  aCCodeGenerator var: 'maskTable'
  declareC:'int maskTable[33] = {
  0, 1, 3, 0, 15, 31, 0, 0, 255, 0, 0, 0, 0, 0, 0, 0, 65535,
  0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, -1
  }'.
  aCCodeGenerator var: 'ditherMatrix4x4'
  declareC:'const int ditherMatrix4x4[16] = {
  0, 8, 2, 10,
  12, 4, 14, 6,
  3, 11, 1, 9,
  15, 7, 13, 5
  }'.
  aCCodeGenerator var: 'ditherThresholds16'
  declareC:'const int ditherThresholds16[8] = { 0, 2, 4, 6, 8, 12, 14, 16 }'.
  aCCodeGenerator var: 'ditherValues16'
  declareC:'const int ditherValues16[32] = {
  0, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14,
  15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30
  }'.
 
  aCCodeGenerator var: 'warpBitShiftTable'
  declareC:'int warpBitShiftTable[32]'.
 
  aCCodeGenerator var:'cmShiftTable'
  type:'int *'.
  aCCodeGenerator var:'cmMaskTable'
  type:'unsigned int *'.
  aCCodeGenerator var:'cmLookupTable'
  type:'unsigned int *'.
 
  aCCodeGenerator var: 'dither8Lookup'
  declareC:' unsigned char dither8Lookup[4096]'.
 
  aCCodeGenerator var:'ungammaLookupTable'
  type: 'unsigned char *'.
  aCCodeGenerator var:'gammaLookupTable'
  type: 'unsigned char *'.
 
  aCCodeGenerator var: 'querySurfaceFn' type: 'void *'.
  aCCodeGenerator var: 'lockSurfaceFn' type: 'void *'.
  aCCodeGenerator var: 'unlockSurfaceFn' type: 'void *'.
 
  #(sourcePitch sourceWidth sourceHeight sourceDepth sourceMSB sx sy
  destPitch destWidth destHeight destDepth destMSB dx dy bbW bbH)
+ do: [:ivar | aCCodeGenerator var: ivar type: 'int']!
- do: [:ivar | aCCodeGenerator var: ivar type: 'int'.]!

Item was changed:
  ----- Method: BitBltSimulation class>>initialize (in category 'initialization') -----
  initialize
  "BitBltSimulation initialize"
 
  self initializeRuleTable.
 
  "Mask constants"
  AllOnes := 16rFFFFFFFF.
  BinaryPoint := 14.
  FixedPt1 := 1 << BinaryPoint.  "Value of 1.0 in Warp's fixed-point representation"
   
  "Indices into stopConditions for scanning"
  EndOfRun := 257.
  CrossedX := 258.
   
  "Form fields"
  FormBitsIndex := 0.
  FormWidthIndex := 1.
  FormHeightIndex := 2.
  FormDepthIndex := 3.
   
  "BitBlt fields"
  BBDestFormIndex := 0.
  BBSourceFormIndex := 1.
  BBHalftoneFormIndex := 2.
  BBRuleIndex := 3.
  BBDestXIndex := 4.
  BBDestYIndex := 5.
  BBWidthIndex := 6.
  BBHeightIndex := 7.
  BBSourceXIndex := 8.
  BBSourceYIndex := 9.
  BBClipXIndex := 10.
  BBClipYIndex := 11.
  BBClipWidthIndex := 12.
  BBClipHeightIndex := 13.
  BBColorMapIndex := 14.
  BBWarpBase := 15.
  BBLastIndex := 15.
  BBXTableIndex := 16.
 
+ "BalloonEngineFields"
+ BEBitBltIndex := (Smalltalk classNamed: #BalloonEngine)
+ ifNil: [2]
+ ifNotNil: [:be| (be allInstVarNames indexOf: 'bitBlt') - 1].
+
  "RGBA indexes"
  RedIndex := 0.
  GreenIndex := 1.
  BlueIndex := 2.
  AlphaIndex := 3.
 
  "Color map flags"
  ColorMapPresent := 1. "do we have one?"
  ColorMapFixedPart := 2. "does it have a fixed part?"
  ColorMapIndexedPart := 4. "does it have an indexed part?"
  ColorMapNewStyle := 8. "new style color map"!

Item was added:
+ ----- Method: BitBltSimulation>>ensureDestAndSourceFormsAreValid (in category 'setup') -----
+ ensureDestAndSourceFormsAreValid
+ "If a GC has occurred, update destForm and sourceForm from the stack."
+ <inline: #always>
+ numGCsOnInvocation ~= interpreterProxy statNumGCs ifTrue:
+ [self reloadDestAndSourceForms]!

Item was changed:
  ----- Method: BitBltSimulation>>loadBitBltDestForm (in category 'interpreter interface') -----
  loadBitBltDestForm
  "Load the dest form for BitBlt. Return false if anything is wrong, true otherwise."
 
  | destBitsSize |
  <inline: true>
  destBits := interpreterProxy fetchPointer: FormBitsIndex ofObject: destForm.
  destWidth := interpreterProxy fetchInteger: FormWidthIndex ofObject: destForm.
  destHeight := interpreterProxy fetchInteger: FormHeightIndex ofObject: destForm.
  (destWidth >= 0 and: [destHeight >= 0])
  ifFalse: [^ false].
  destDepth := interpreterProxy fetchInteger: FormDepthIndex ofObject: destForm.
  destMSB := destDepth > 0.
  destDepth < 0 ifTrue:[destDepth := 0 - destDepth].
  "Ignore an integer bits handle for Display in which case
  the appropriate values will be obtained by calling ioLockSurfaceBits()."
  (interpreterProxy isIntegerObject: destBits) ifTrue:[
  "Query for actual surface dimensions"
  (self queryDestSurface: (interpreterProxy integerValueOf: destBits))
+ ifFalse:
+ [interpreterProxy primitiveFailFor: PrimErrCallbackError.
+ ^false].
- ifFalse:[^false].
  destPPW := 32 // destDepth.
  destBits := destPitch := 0.
  ] ifFalse:[
  destPPW := 32 // destDepth.
  destPitch := destWidth + (destPPW-1) // destPPW * 4.
  destBitsSize := interpreterProxy byteSizeOf: destBits.
  ((interpreterProxy isWordsOrBytes: destBits)
  and: [destBitsSize >= (destPitch * destHeight)])
  ifFalse: [^ false].
  "Skip header since external bits don't have one"
  destBits := self oopForPointer: (interpreterProxy firstIndexableField: destBits).
  ].
  ^true!

Item was changed:
  ----- Method: BitBltSimulation>>loadBitBltFrom:warping: (in category 'interpreter interface') -----
  loadBitBltFrom: bbObj warping: aBool
  "Load context from BitBlt instance.  Return false if anything is amiss"
  "NOTE this should all be changed to minX/maxX coordinates for simpler clipping
  -- once it works!!"
  | ok |
  <inline: false>
  bitBltOop := bbObj.
  isWarping := aBool.
+ bitBltIsReceiver := bbObj = (interpreterProxy stackValue: interpreterProxy methodArgumentCount).
+ numGCsOnInvocation := interpreterProxy statNumGCs.
  combinationRule := interpreterProxy fetchInteger: BBRuleIndex ofObject: bitBltOop.
  (interpreterProxy failed
  or: [combinationRule < 0 or: [combinationRule > (OpTableSize - 2)]])
  ifTrue: [^ false  "operation out of range"].
  (combinationRule >= 16 and: [combinationRule <= 17])
  ifTrue: [^ false  "fail for old simulated paint, erase modes"].
  sourceForm := interpreterProxy fetchPointer: BBSourceFormIndex ofObject: bitBltOop.
  noSource := self ignoreSourceOrHalftone: sourceForm.
  halftoneForm := interpreterProxy fetchPointer: BBHalftoneFormIndex ofObject: bitBltOop.
  noHalftone := self ignoreSourceOrHalftone: halftoneForm.
 
  destForm := interpreterProxy fetchPointer: BBDestFormIndex ofObject: bbObj.
  ((interpreterProxy isPointers: destForm) and: [(interpreterProxy slotSizeOf: destForm) >= 4])
  ifFalse: [^ false].
  ok := self loadBitBltDestForm.
  ok ifFalse:[^false].
 
  destX := self fetchIntOrFloat: BBDestXIndex ofObject: bitBltOop ifNil: 0.
  destY := self fetchIntOrFloat: BBDestYIndex ofObject: bitBltOop ifNil: 0.
  width := self fetchIntOrFloat: BBWidthIndex ofObject: bitBltOop ifNil: destWidth.
  height := self fetchIntOrFloat: BBHeightIndex ofObject: bitBltOop ifNil: destHeight.
  interpreterProxy failed ifTrue: [^ false  "non-integer value"].
 
  noSource ifTrue:
  [sourceX := sourceY := 0]
  ifFalse:
  [((interpreterProxy isPointers: sourceForm) and: [(interpreterProxy slotSizeOf: sourceForm) >= 4])
  ifFalse: [^ false].
  ok := self loadBitBltSourceForm.
  ok ifFalse:[^false].
  ok := self loadColorMap.
  ok ifFalse:[^false].
  "Need the implicit setup here in case of 16<->32 bit conversions"
  (cmFlags bitAnd: ColorMapNewStyle) = 0 ifTrue:[self setupColorMasks].
  sourceX := self fetchIntOrFloat: BBSourceXIndex ofObject: bitBltOop ifNil: 0.
  sourceY := self fetchIntOrFloat: BBSourceYIndex ofObject: bitBltOop ifNil: 0].
 
  ok := self loadHalftoneForm.
  ok ifFalse:[^false].
  clipX := self fetchIntOrFloat: BBClipXIndex ofObject: bitBltOop ifNil: 0.
  clipY := self fetchIntOrFloat: BBClipYIndex ofObject: bitBltOop ifNil: 0.
  clipWidth := self fetchIntOrFloat: BBClipWidthIndex ofObject: bitBltOop ifNil: destWidth.
  clipHeight := self fetchIntOrFloat: BBClipHeightIndex ofObject: bitBltOop ifNil: destHeight.
  interpreterProxy failed ifTrue: [^ false  "non-integer value"].
  clipX < 0 ifTrue: [clipWidth := clipWidth + clipX.  clipX := 0].
  clipY < 0 ifTrue: [clipHeight := clipHeight + clipY.  clipY := 0].
  clipX+clipWidth > destWidth ifTrue: [clipWidth := destWidth - clipX].
  clipY+clipHeight > destHeight ifTrue: [clipHeight := destHeight - clipY].
+
+ numGCsOnInvocation ~= interpreterProxy statNumGCs ifTrue: "querySurface could be a callback in loadSourceFor: and loadDestForm:"
+ [interpreterProxy primitiveFailFor: PrimErrObjectMoved.
+ ^false].
  ^ true!

Item was changed:
  ----- Method: BitBltSimulation>>loadBitBltSourceForm (in category 'interpreter interface') -----
  loadBitBltSourceForm
  "Load the source form for BitBlt. Return false if anything is wrong, true otherwise."
  | sourceBitsSize |
  <inline: true>
  sourceBits := interpreterProxy fetchPointer: FormBitsIndex ofObject: sourceForm.
  sourceWidth := self fetchIntOrFloat: FormWidthIndex ofObject: sourceForm.
  sourceHeight := self fetchIntOrFloat: FormHeightIndex ofObject: sourceForm.
  (sourceWidth >= 0 and: [sourceHeight >= 0])
  ifFalse: [^ false].
  sourceDepth := interpreterProxy fetchInteger: FormDepthIndex ofObject: sourceForm.
  sourceMSB := sourceDepth > 0.
  sourceDepth < 0 ifTrue:[sourceDepth := 0 - sourceDepth].
  "Ignore an integer bits handle for Display in which case
  the appropriate values will be obtained by calling ioLockSurfaceBits()."
  (interpreterProxy isIntegerObject: sourceBits) ifTrue:[
  "Query for actual surface dimensions"
  (self querySourceSurface: (interpreterProxy integerValueOf: sourceBits))
+ ifFalse:
+ [interpreterProxy primitiveFailFor: PrimErrCallbackError.
+ ^false].
- ifFalse:[^false].
  sourcePPW := 32 // sourceDepth.
  sourceBits := sourcePitch := 0.
  ] ifFalse:[
  sourcePPW := 32 // sourceDepth.
  sourcePitch := sourceWidth + (sourcePPW-1) // sourcePPW * 4.
  sourceBitsSize := interpreterProxy byteSizeOf: sourceBits.
  ((interpreterProxy isWordsOrBytes: sourceBits)
  and: [sourceBitsSize >= (sourcePitch * sourceHeight)])
  ifFalse: [^ false].
  "Skip header since external bits don't have one"
  sourceBits := self oopForPointer: (interpreterProxy firstIndexableField: sourceBits).
  ].
  ^true!

Item was changed:
  ----- Method: BitBltSimulation>>lockSurfaces (in category 'surface support') -----
  lockSurfaces
  "Get a pointer to the bits of any OS surfaces."
  "Notes:
  * For equal source/dest handles only one locking operation is performed.
  This is to prevent locking of overlapping areas which does not work with
  certain APIs (as an example, DirectDraw prevents locking of overlapping areas).
  A special case for non-overlapping but equal source/dest handle would
  be possible but we would have to transfer this information over to
  unlockSurfaces somehow (currently, only one unlock operation is
  performed for equal source and dest handles). Also, this would require
  a change in the notion of ioLockSurface() which is right now interpreted
  as a hint and not as a requirement to lock only the specific portion of
  the surface.
 
  * The arguments in ioLockSurface() provide the implementation with
  an explicit hint what area is affected. It can be very useful to
  know the max. affected area beforehand if getting the bits requires expensive
  copy operations (e.g., like a roundtrip to the X server or a glReadPixel op).
  However, the returned pointer *MUST* point to the virtual origin of the surface
  and not to the beginning of the rectangle. The promise made by BitBlt
  is to never access data outside the given rectangle (aligned to 4byte boundaries!!)
  so it is okay to return a pointer to the virtual origin that is actually outside
  the valid memory area.
 
  * The area provided in ioLockSurface() is already clipped (e.g., it will always
  be inside the source and dest boundingBox) but it is not aligned to word boundaries
  yet. It is up to the support code to compute accurate alignment if necessary.
 
  * Warping always requires the entire source surface to be locked because
  there is no beforehand knowledge about what area will actually be traversed.
 
+ * Fail if a GC has occurred since the primitive started (presumably in the lockSurface
+   function), because one or more of the primitives' parameters may have been moved.
  "
  | sourceHandle destHandle l r t b fn |
  <inline: true>
  <var: #fn declareC:'sqIntptr_t (*fn)(sqIntptr_t, int*, int, int, int, int)'>
+ self assert: numGCsOnInvocation = interpreterProxy statNumGCs.
  hasSurfaceLock := false.
  destBits = 0 ifTrue:["Blitting *to* OS surface"
+ lockSurfaceFn = 0 ifTrue:[self loadSurfacePlugin ifFalse:[^false]].
- lockSurfaceFn = 0 ifTrue:[self loadSurfacePlugin ifFalse:[^nil]].
  fn := self cCoerce: lockSurfaceFn to: 'sqIntptr_t (*)(sqIntptr_t, int*, int, int, int, int)'.
  destHandle := interpreterProxy fetchInteger: FormBitsIndex ofObject: destForm.
  (sourceBits = 0 and:[noSource not]) ifTrue:[
  sourceHandle := interpreterProxy fetchInteger: FormBitsIndex ofObject: sourceForm.
  "Handle the special case of equal source and dest handles"
  (sourceHandle = destHandle) ifTrue:[
  "If we have overlapping source/dest we lock the entire area
  so that there is only one area transmitted"
  isWarping ifFalse:[
  "When warping we always need the entire surface for the source"
  sourceBits := self cCode:'fn(sourceHandle, &sourcePitch, 0,0, sourceWidth, sourceHeight)'.
  ] ifTrue:[
  "Otherwise use overlapping area"
  l := sx min: dx. r := (sx max: dx) + bbW.
  t := sy min: dy. b := (sy max: dy) + bbH.
  sourceBits := self cCode:'fn(sourceHandle, &sourcePitch, l, t, r-l, b-t)'.
  ].
  destBits := sourceBits.
  destPitch := sourcePitch.
  hasSurfaceLock := true.
+ numGCsOnInvocation ~= interpreterProxy statNumGCs ifTrue:
+ [interpreterProxy primitiveFailFor: PrimErrObjectMoved.
+ ^false].
+ destBits = 0 ifTrue:
+ [interpreterProxy primitiveFailFor: PrimErrCallbackError].
+ ^destBits ~= 0
- ^destBits ~~ 0
  ].
  "Fall through - if not equal it'll be handled below"
  ].
  destBits := self cCode:'fn(destHandle, &destPitch, dx, dy, bbW, bbH)'.
  hasSurfaceLock := true.
+ numGCsOnInvocation ~= interpreterProxy statNumGCs ifTrue:
+ [interpreterProxy primitiveFailFor: PrimErrObjectMoved.
+ ^false].
  ].
+ (sourceBits = 0 and:[noSource not]) ifTrue:["Blitting *from* OS surface"
- (sourceBits == 0 and:[noSource not]) ifTrue:["Blitting *from* OS surface"
  sourceHandle := interpreterProxy fetchInteger: FormBitsIndex ofObject: sourceForm.
  interpreterProxy failed ifTrue:[^nil]. "fetch sourceHandle could fail"
+ lockSurfaceFn = 0 ifTrue:[self loadSurfacePlugin ifFalse:[^false]].
- lockSurfaceFn = 0 ifTrue:[self loadSurfacePlugin ifFalse:[^nil]].
  fn := self cCoerce: lockSurfaceFn to: 'sqIntptr_t (*)(sqIntptr_t, int*, int, int, int, int)'.
  "Warping requiring the entire surface"
  isWarping ifTrue:[
  sourceBits := self cCode:'fn(sourceHandle, &sourcePitch, 0, 0, sourceWidth, sourceHeight)'.
  ] ifFalse:[
  sourceBits := self cCode:'fn(sourceHandle, &sourcePitch, sx, sy, bbW, bbH)'.
  ].
  hasSurfaceLock := true.
+ numGCsOnInvocation ~= interpreterProxy statNumGCs ifTrue:
+ [interpreterProxy primitiveFailFor: PrimErrObjectMoved.
+ ^false].
+ sourceBits = 0 ifTrue:
+ [interpreterProxy primitiveFailFor: PrimErrCallbackError].
  ].
+ ^destBits ~= 0 and: [sourceBits ~= 0 or:[noSource]]!
- ^destBits ~~ 0 and:[sourceBits ~~ 0 or:[noSource]].!

Item was added:
+ ----- Method: BitBltSimulation>>reloadDestAndSourceForms (in category 'setup') -----
+ reloadDestAndSourceForms
+ "A GC has occurred.  The destForm must be updated.  But where to derive it from?
+  For copyBits and warpBits it is derived from the receiver.  But for a BalloonEnginePlugin
+  it should be obtained from (interpreterProxy fetchPointer: BEBitBltIndex ofObject: engine).
+  For the moment implement something that works for these two cases."
+ <inline: false>
+ | receiver |
+ receiver := interpreterProxy stackValue: interpreterProxy methodArgumentCount.
+ bitBltIsReceiver ifFalse: [receiver := interpreterProxy fetchPointer: BEBitBltIndex ofObject: receiver].
+ destForm := interpreterProxy fetchPointer: BBDestFormIndex ofObject: receiver.
+ sourceForm := interpreterProxy fetchPointer: BBSourceFormIndex ofObject: receiver!

Item was changed:
  ----- Method: BitBltSimulation>>showDisplayBits (in category 'interpreter interface') -----
  showDisplayBits
+ self ensureDestAndSourceFormsAreValid.
  interpreterProxy
  showDisplayBits: destForm
  Left: affectedL
  Top: affectedT
  Right: affectedR
  Bottom: affectedB!

Item was changed:
  ----- Method: BitBltSimulation>>unlockSurfaces (in category 'surface support') -----
  unlockSurfaces
  "Unlock the bits of any OS surfaces."
  "See the comment in lockSurfaces. Similar rules apply. That is, the area provided in ioUnlockSurface can be used to determine the dirty region after drawing. If a source is unlocked, then the area will be (0,0,0,0) to indicate that no portion is dirty."
  | sourceHandle destHandle destLocked fn |
  <var: #fn declareC:'int (*fn)(sqIntptr_t, int, int, int, int)'>
  hasSurfaceLock ifTrue:[
  unlockSurfaceFn = 0 ifTrue:[self loadSurfacePlugin ifFalse:[^nil]].
+ self ensureDestAndSourceFormsAreValid.
  fn := self cCoerce: unlockSurfaceFn to: 'int (*)(sqIntptr_t, int, int, int, int)'.
  destLocked := false.
  destHandle := interpreterProxy fetchPointer: FormBitsIndex ofObject: destForm.
  (interpreterProxy isIntegerObject: destHandle) ifTrue:[
  destHandle := interpreterProxy integerValueOf: destHandle.
  "The destBits are always assumed to be dirty"
  self cCode:'fn(destHandle, affectedL, affectedT, affectedR-affectedL, affectedB-affectedT)'.
  destBits := destPitch := 0.
  destLocked := true.
  ].
  noSource ifFalse:[
+ self ensureDestAndSourceFormsAreValid.
  sourceHandle := interpreterProxy fetchPointer: FormBitsIndex ofObject: sourceForm.
  (interpreterProxy isIntegerObject: sourceHandle) ifTrue:[
  sourceHandle := interpreterProxy integerValueOf: sourceHandle.
  "Only unlock sourceHandle if different from destHandle"
  (destLocked and:[sourceHandle = destHandle])
  ifFalse:[self cCode: 'fn(sourceHandle, 0, 0, 0, 0)'].
  sourceBits := sourcePitch := 0.
  ].
  ].
  hasSurfaceLock := false.
  self cCode: [] inSmalltalk:
  [self touch: fn.
  interpreterProxy displayObject = destForm ifTrue:
  [interpreterProxy getDeferDisplayUpdates "for some reason this is true..."
  ifTrue:
  [interpreterProxy fullDisplayUpdate]
  ifFalse:
  [interpreterProxy fullDisplayUpdate]]].
  ].!

Item was changed:
  ----- Method: IA32ABIPlugin>>setInterpreter: (in category 'initialize') -----
  setInterpreter: anInterpreter
  "Note: This is coded so that is can be run from Squeak."
  | ok |
  <export: true>
  <var: #anInterpreter type: #'struct VirtualMachine*'>
  interpreterProxy := anInterpreter.
+ ok := interpreterProxy majorVersion > 1
+ or: [interpreterProxy minorVersion >= 12]. "There was no version 0"
- ok := interpreterProxy majorVersion = 1
- and: [interpreterProxy minorVersion >= 12].
  ok ifTrue:
  [self expandDereferenceInterpreterProxyFunctionTable].
  ^ok!

Item was added:
+ ----- Method: InterpreterProxy>>statNumGCs (in category 'other') -----
+ statNumGCs
+ ^(Smalltalk vmParameterAt: 7 "statFullGCs") + (Smalltalk vmParameterAt: 9 "statScavenges/statIncrGCs")!

Item was changed:
  ----- Method: ObjectMemory>>statNumGCs (in category 'accessing') -----
  statNumGCs
+ "Part of InterpreterProxy's 1.14 API"
+ <export: true>
  ^statIncrGCs + statFullGCs!

Item was changed:
  ----- Method: SpurMemoryManager>>statNumGCs (in category 'accessing') -----
  statNumGCs
+ "Part of InterpreterProxy's 1.14 API"
+ <export: true>
  ^statScavenges + statIncrGCs + statFullGCs!

Item was changed:
  ----- Method: StackInterpreter class>>vmProxyMinorVersion (in category 'api version') -----
  vmProxyMinorVersion
  "Define the  VM_PROXY_MINOR version for this VM as used to
  define the api in platforms/Cross/vm/sqVirtualMachine.[ch]"
+ ^14 "statNumGCs added"!
- ^false
- ifTrue:
- [(initializationOptions at: #SpurObjectMemory ifAbsent: [false])
- ifTrue: [13]
- ifFalse: [12]]
- ifFalse: [13] "As of 4/11/2014 ObjectMemory supports the new API"!

Item was changed:
  SharedPool subclass: #VMBasicConstants
  instanceVariableNames: ''
+ classVariableNames: 'BaseHeaderSize BytecodeSetHasExtensions BytesPerOop BytesPerWord COGMTVM COGVM DisownVMLockOutFullGC DoAssertionChecks DoExpensiveAssertionChecks GCCheckPrimCall GCModeBecome GCModeFreeSpace GCModeFull GCModeImageSegment GCModeIncremental GCModeNewSpace IMMUTABILITY LowcodeVM MULTIPLEBYTECODESETS NewspeakVM PharoVM PrimErrBadArgument PrimErrBadIndex PrimErrBadMethod PrimErrBadNumArgs PrimErrBadReceiver PrimErrCallbackError PrimErrGenericFailure PrimErrInappropriate PrimErrLimitExceeded PrimErrNamedInternal PrimErrNoCMemory PrimErrNoMemory PrimErrNoModification PrimErrNotFound PrimErrObjectIsPinned PrimErrObjectMayMove PrimErrObjectMoved PrimErrObjectNotPinned PrimErrUnsupported PrimErrWritePastObject PrimNoErr SPURVM STACKVM SistaVM VMBIGENDIAN'
- classVariableNames: 'BaseHeaderSize BytecodeSetHasExtensions BytesPerOop BytesPerWord COGMTVM COGVM DisownVMLockOutFullGC DoAssertionChecks DoExpensiveAssertionChecks GCCheckPrimCall GCModeBecome GCModeFreeSpace GCModeFull GCModeImageSegment GCModeIncremental GCModeNewSpace IMMUTABILITY LowcodeVM MULTIPLEBYTECODESETS NewspeakVM PharoVM PrimErrBadArgument PrimErrBadIndex PrimErrBadMethod PrimErrBadNumArgs PrimErrBadReceiver PrimErrGenericFailure PrimErrInappropriate PrimErrLimitExceeded PrimErrNamedInternal PrimErrNoCMemory PrimErrNoMemory PrimErrNoModification PrimErrNotFound PrimErrObjectIsPinned PrimErrObjectMayMove PrimErrObjectMoved PrimErrObjectNotPinned PrimErrUnsupported PrimErrWritePastObject PrimNoErr SPURVM STACKVM SistaVM VMBIGENDIAN'
  poolDictionaries: ''
  category: 'VMMaker-Interpreter'!
 
  !VMBasicConstants commentStamp: '<historical>' prior: 0!
  I am a shared pool for basic constants upon which the VM as a whole depends.
 
  self ensureClassPool.
  self classPool declare: #BytesPerWord from: VMSqueakV3ObjectRepresentationConstants classPool.
  self classPool declare: #BaseHeaderSize from: VMSqueakV3ObjectRepresentationConstants classPool
  (ObjectMemory classPool keys select: [:k| k beginsWith: 'Byte']) do:
  [:k| self classPool declare: k from: ObjectMemory classPool]!

Item was changed:
  ----- Method: VMClass class>>initializePrimitiveErrorCodes (in category 'initialization') -----
  initializePrimitiveErrorCodes
  "Define the VM's primitive error codes.  N.B. these are
  replicated in platforms/Cross/vm/sqVirtualMachine.h."
  "VMClass initializePrimitiveErrorCodes"
  | pet |
  PrimErrTableIndex := 51. "Zero-relative"
  "See SmalltalkImage>>recreateSpecialObjectsArray for the table definition.
  If the table exists and is large enough the corresponding entry is returned as
  the primitive error, otherwise the error is answered numerically."
  pet := Smalltalk specialObjectsArray at: PrimErrTableIndex + 1 ifAbsent: [#()].
  pet isArray ifFalse: [pet := #()].
  PrimNoErr := 0. "for helper methods that need to answer success or an error code."
  PrimErrGenericFailure := pet indexOf: nil ifAbsent: 1.
  PrimErrBadReceiver := pet indexOf: #'bad receiver' ifAbsent: 2.
  PrimErrBadArgument := pet indexOf: #'bad argument' ifAbsent: 3.
  PrimErrBadIndex := pet indexOf: #'bad index' ifAbsent: 4.
  PrimErrBadNumArgs := pet indexOf: #'bad number of arguments' ifAbsent: 5.
  PrimErrInappropriate := pet indexOf: #'inappropriate operation' ifAbsent: 6.
  PrimErrUnsupported := pet indexOf: #'unsupported operation' ifAbsent: 7.
  PrimErrNoModification := pet indexOf: #'no modification' ifAbsent: 8.
  PrimErrNoMemory := pet indexOf: #'insufficient object memory' ifAbsent: 9.
  PrimErrNoCMemory := pet indexOf: #'insufficient C memory' ifAbsent: 10.
  PrimErrNotFound := pet indexOf: #'not found' ifAbsent: 11.
  PrimErrBadMethod := pet indexOf: #'bad method' ifAbsent: 12.
  PrimErrNamedInternal := pet indexOf: #'internal error in named primitive machinery' ifAbsent: 13.
  PrimErrObjectMayMove := pet indexOf: #'object may move' ifAbsent: 14.
  PrimErrLimitExceeded := pet indexOf: #'resource limit exceeded' ifAbsent: 15.
  PrimErrObjectIsPinned := pet indexOf: #'object is pinned' ifAbsent: 16.
  PrimErrWritePastObject := pet indexOf: #'primitive write beyond end of object' ifAbsent: 17.
  PrimErrObjectMoved := pet indexOf: #'object moved' ifAbsent: 18.
+ PrimErrObjectNotPinned := pet indexOf: #'object not pinned' ifAbsent: 19.
+ PrimErrCallbackError := pet indexOf: #'error in callback' ifAbsent: 20!
- PrimErrObjectNotPinned := pet indexOf: #'object not pinned' ifAbsent: 19!