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

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

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

Name: VMMaker.oscog-eem.2402
Author: eem
Time: 6 June 2018, 9:23:15.073864 am
UUID: f67d4acd-2c6e-4533-a895-7817e4e95fc1
Ancestors: VMMaker.oscog-eem.2401

BitBltPlugin: The new primitiveDisplayString short cut has exposed an old bug: both loadBitBltDestForm & loadBitBltSourceForm sent byteSizeOf: to the form bits before checking if form bits isWordsOrBytes:.  Also simplify loadHalftoneForm which comntained a superfluous (interpreterProxy isPointers: halftoneForm) not.

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

Item was changed:
  ----- Method: BitBltSimulation>>loadBitBltDestForm (in category 'interpreter interface') -----
  loadBitBltDestForm
  "Load the dest form for BitBlt. Answer 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"
  [querySurfaceFn = 0 ifTrue: [self loadSurfacePlugin ifFalse: [^false]].
  (self query: (interpreterProxy integerValueOf: destBits)
  Sur: (self addressOf: destWidth)
  fa: (self addressOf: destHeight)
  ce: (self addressOf: destDepth)
  Fn: (self addressOf: destMSB)) ifFalse:
  [interpreterProxy primitiveFailFor: PrimErrCallbackError.
  ^false].
  destPPW := 32 // destDepth.
  destBits := destPitch := 0]
  ifFalse:
+ [(interpreterProxy isWordsOrBytes: destBits) ifFalse:
+ [^false].
+ destPPW := 32 // destDepth.
- [destPPW := 32 // destDepth.
  destPitch := destWidth + (destPPW-1) // destPPW * 4.
  destBitsSize := interpreterProxy byteSizeOf: destBits.
+ destBitsSize >= (destPitch * destHeight) ifFalse:
- ((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>>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"
  [querySurfaceFn = 0 ifTrue: [self loadSurfacePlugin ifFalse:[^false]].
  (self query: (interpreterProxy integerValueOf: sourceBits)
  Sur: (self addressOf: sourceWidth)
  fa: (self addressOf: sourceHeight)
  ce: (self addressOf: sourceDepth)
  Fn: (self addressOf: sourceMSB)) ifFalse:
  [interpreterProxy primitiveFailFor: PrimErrCallbackError.
  ^false].
  sourcePPW := 32 // sourceDepth.
  sourceBits := sourcePitch := 0]
  ifFalse:
+ [(interpreterProxy isWordsOrBytes: sourceBits) ifFalse:
+ [^false].
+ sourcePPW := 32 // sourceDepth.
- [sourcePPW := 32 // sourceDepth.
  sourcePitch := sourceWidth + (sourcePPW-1) // sourcePPW * 4.
  sourceBitsSize := interpreterProxy byteSizeOf: sourceBits.
+ sourceBitsSize >= (sourcePitch * sourceHeight) ifFalse:
- ((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>>loadHalftoneForm (in category 'interpreter interface') -----
  loadHalftoneForm
  "Load the halftone form"
  | halftoneBits |
  <inline: true>
+ noHalftone ifTrue:
+ [halftoneBase := nil.
- noHalftone ifTrue:[
- halftoneBase := nil.
  ^true].
+ ((interpreterProxy isPointers: halftoneForm)
+ and: [(interpreterProxy slotSizeOf: halftoneForm) >= 4])
- ((interpreterProxy isPointers: halftoneForm) and: [(interpreterProxy slotSizeOf: halftoneForm) >= 4])
  ifTrue:
+ ["Old-style 32xN monochrome halftone Forms"
+ halftoneBits := interpreterProxy fetchPointer: FormBitsIndex ofObject: halftoneForm.
+ halftoneHeight := interpreterProxy fetchInteger: FormHeightIndex ofObject: halftoneForm.
+ (interpreterProxy isWords: halftoneBits) ifFalse:
+ [noHalftone := true]]
- ["Old-style 32xN monochrome halftone Forms"
- halftoneBits := interpreterProxy fetchPointer: FormBitsIndex ofObject: halftoneForm.
- halftoneHeight := interpreterProxy fetchInteger: FormHeightIndex ofObject: halftoneForm.
- (interpreterProxy isWords: halftoneBits)
- ifFalse: [noHalftone := true]]
  ifFalse:
+ ["New spec accepts, basically, a word array"
+ (interpreterProxy isWords: halftoneForm) ifFalse:
+ [^false].
+ halftoneBits := halftoneForm.
+ halftoneHeight := interpreterProxy slotSizeOf: halftoneBits].
- ["New spec accepts, basically, a word array"
- ((interpreterProxy isPointers: halftoneForm) not
- and: [interpreterProxy isWords: halftoneForm])
- ifFalse: [^ false].
- halftoneBits := halftoneForm.
- halftoneHeight := interpreterProxy slotSizeOf: halftoneBits].
  halftoneBase := self oopForPointer: (interpreterProxy firstIndexableField: halftoneBits).
  ^true!