Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.3183.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.3183 Author: eem Time: 18 April 2022, 6:18:23.56464 pm UUID: c5c103b4-2c5c-44e7-8e32-030e79600ca6 Ancestors: VMMaker.oscog-mt.3182
BitBltPlugin: implement primitivePixelValueAtX:y:put: to complement primitivePixelValueAtX:y:. (in the platform code reuse the obsolete sendInvokeCallback:Stack:Registers:Jmpbuf: function to access storeLong32:ofObject:withValue:).
=============== Diff against VMMaker.oscog-mt.3182 ===============
Item was added: + ----- Method: BitBltSimulation>>primitivePixelValueAtX:y:put: (in category 'primitives') ----- + primitivePixelValueAtX: xVal y: yVal put: pixel + "Sets the single pixel at x@y. Answers the previous value of the pixel. + It does not handle LSB bitmaps right now. + If x or y are < 0, return 0 to indicate transparent (cf BitBlt>bitPeekerFromForm: usage). + Likewise if x>width or y>depth. + Fail if the rcvr doesn't seem to be a Form, or x|y seem wrong" + <primitiveMetadata: #FastCPrimitiveFlag> + | rcvr bitmap depth ppW stride bitsSize word mask shift oldPixel | + rcvr := self primitive: 'primitivePixelValueAtPut' parameters: #(SmallInteger SmallInteger SmallInteger) receiver: #Oop. + + "check that rcvr is plausibly a Form or subclass" + rcvr := interpreterProxy stackValue: interpreterProxy methodArgumentCount. + ((interpreterProxy isPointers: rcvr) + and: [(interpreterProxy slotSizeOf: rcvr) >= 4]) ifFalse: + [^interpreterProxy primitiveFailFor: PrimErrBadReceiver]. + + "get the bits oop and width/height/depth" + bitmap := interpreterProxy fetchPointer: FormBitsIndex ofObject: rcvr. + (interpreterProxy isWordsOrBytes: bitmap) ifFalse: + [^interpreterProxy primitiveFailFor: PrimErrBadReceiver]. + width := interpreterProxy fetchInteger: FormWidthIndex ofObject: rcvr. + height := interpreterProxy fetchInteger: FormHeightIndex ofObject: rcvr. + depth := interpreterProxy fetchInteger: FormDepthIndex ofObject: rcvr. + "if width/height/depth are not integer, fail" + (interpreterProxy failed + or: [depth < 0 "we don't handle LSB Forms yet"]) ifTrue: + [^interpreterProxy primitiveFailFor: PrimErrBadReceiver]. + + (xVal < 0 or: [ xVal >= width + or: [yVal < 0 or: [ yVal >= height + or: [pixel < 0]]]] ) ifTrue:[^interpreterProxy primitiveFailFor: PrimErrBadArgument]. + + "OK so now we know we have a plausible Form, the width/height/depth/x/y are all reasonable and it's time to plunder the bitmap" + ppW := 32//depth. "pixels in each word" + stride := (width + (ppW -1)) // ppW. "how many words per row of pixels" + bitsSize := interpreterProxy byteSizeOf: bitmap. + bitsSize >= (stride * height * 4 "bytes per word") ifFalse: + [^interpreterProxy primitiveFailFor: PrimErrBadReceiver]. + word := interpreterProxy fetchLong32: (yVal * stride) + (xVal//ppW) ofObject: bitmap. "load the word that contains our target" + mask := 16rFFFFFFFF >> (32 - depth). "make a mask to isolate the pixel within that word" + shift := 32 - (((xVal bitAnd: ppW-1) + 1) * depth). "this is the tricky MSB part - we mask the xVal to find how far into the word we need, then add 1 for the pixel we're looking for, then * depth to get the bit shift" + oldPixel := word >> shift bitAnd: mask. "shift, mask and dim the lights" + word := ((word bitOr: mask << shift) - (mask << shift)) + (pixel << shift). + interpreterProxy storeLong32: (yVal * stride) + (xVal//ppW) ofObject: bitmap withValue: word. + ^oldPixel asPositiveIntegerObj "pop the incoming and push our answer" + !
Item was removed: - ----- Method: CoInterpreter>>sendInvokeCallback:Stack:Registers:Jmpbuf: (in category 'callback support') ----- - sendInvokeCallback: thunkPtr Stack: stackPtr Registers: regsPtr Jmpbuf: jmpBufPtr - "Override to log and check stack alignment. Since this is an implicit send we need to - log it explicitly. The return side is done via a primitive so that gets logged normally." - cogit assertCStackWellAligned. - cogit recordPrimTrace ifTrue: - [self fastLogPrim: (objectMemory splObj: SelectorInvokeCallback)]. - ^super sendInvokeCallback: thunkPtr Stack: stackPtr Registers: regsPtr Jmpbuf: jmpBufPtr!
Item was removed: - ----- Method: Interpreter>>sendInvokeCallback:Stack:Registers:Jmpbuf: (in category 'callback support') ----- - sendInvokeCallback: thunkPtr Stack: stackPtr Registers: regsPtr Jmpbuf: jmpBufPtr - "Send the 4 argument callback message invokeCallback:stack:registers:jmpbuf: - to Alien class with the supplied args. The arguments are raw C addresses - and are converted to integer objects on the way." - | where | - <export: true> - self pushRemappableOop: (self positive32BitIntegerFor: jmpBufPtr). - self pushRemappableOop: (self positive32BitIntegerFor: regsPtr). - self pushRemappableOop: (self positive32BitIntegerFor: stackPtr). - self pushRemappableOop: (self positive32BitIntegerFor: thunkPtr). - receiver := self splObj: ClassAlien. - lkupClass := self fetchClassOfNonImm: receiver. - messageSelector := self splObj: SelectorInvokeCallback. - (self lookupInMethodCacheSel: messageSelector class: lkupClass) ifFalse: - [(self lookupMethodNoMNUEtcInClass: lkupClass) ifFalse: - [^false]]. - primitiveIndex ~= 0 ifTrue: - [^false]. - self storeContextRegisters: activeContext. - self justActivateNewMethod. - where := activeContext + self baseHeaderSize + (ReceiverIndex << self shiftForWord). - self longAt: where + (1 << self shiftForWord) put: self popRemappableOop. - self longAt: where + (2 << self shiftForWord) put: self popRemappableOop. - self longAt: where + (3 << self shiftForWord) put: self popRemappableOop. - self longAt: where + (4 << self shiftForWord) put: self popRemappableOop. - self interpret. - "not reached" - ^true!
Item was removed: - ----- Method: InterpreterProxy>>sendInvokeCallback:Stack:Registers:Jmpbuf: (in category 'callback support') ----- - sendInvokeCallback: thunkPtr Stack: stackPtr Registers: regsPtr Jmpbuf: jmpBufPtr - "Send the 4 argument callback message invokeCallback:stack:registers:jmpbuf: - to Alien class with the supplied args. The arguments are raw C addresses - and are converted to integer objects on the way." - <returnTypeC: #sqInt> - self notYetImplemented!
Item was added: + ----- Method: InterpreterProxy>>storeLong32:ofObject:withValue: (in category 'object access') ----- + storeLong32: fieldIndex ofObject: oop withValue: anInteger + <var: #anInteger type: #usqInt> + <returnTypeC: #usqInt> + <option: #(atLeastVMProxyMajor:minor: 1 16)> + ((self isIntegerValue: anInteger) + and: [anInteger between: 0 and: 16rFFFFFFFF]) + ifTrue:[^oop instVarAt: fieldIndex+1 put: anInteger] + ifFalse:[^self primitiveFail]!
Item was changed: ----- Method: ObjectMemory>>storeLong32:ofObject:withValue: (in category 'object access') ----- storeLong32: fieldIndex ofObject: oop withValue: valueWord + <export: true> - ^ self long32At: oop + self baseHeaderSize + (fieldIndex << 2) put: valueWord!
Item was changed: ----- Method: SpurMemoryManager>>storeLong32:ofObject:withValue: (in category 'object access') ----- storeLong32: fieldIndex ofObject: obj withValue: valueWord + <api> ^self long32At: obj + self baseHeaderSize + (fieldIndex << 2) put: valueWord!
Item was removed: - ----- Method: StackInterpreter>>sendInvokeCallback:Stack:Registers:Jmpbuf: (in category 'callback support') ----- - sendInvokeCallback: thunkPtr Stack: stackPtr Registers: regsPtr Jmpbuf: jmpBufPtr - "Send the 4 argument callback message invokeCallback:stack:registers:jmpbuf: - to Alien class with the supplied args. The arguments are raw C addresses - and are converted to integer objects on the way." - <export: true> - | classTag | - classTag := self fetchClassTagOfNonImm: (objectMemory splObj: ClassAlien). - messageSelector := self splObj: SelectorInvokeCallback. - argumentCount := 4. - (self lookupInMethodCacheSel: messageSelector classTag: classTag) ifFalse: - [(self lookupOrdinaryNoMNUEtcInClass: (objectMemory classForClassTag: classTag)) ~= 0 ifTrue: - [^false]]. - ((self argumentCountOf: newMethod) = 4 - and: [primitiveFunctionPointer = 0]) ifFalse: - [^false]. - self push: (self splObj: ClassAlien). "receiver" - self push: (self positiveMachineIntegerFor: thunkPtr). - self push: (self positiveMachineIntegerFor: stackPtr). - self push: (self positiveMachineIntegerFor: regsPtr). - self push: (self positiveMachineIntegerFor: jmpBufPtr). - self ifAppropriateCompileToNativeCode: newMethod selector: messageSelector. - self justActivateNewMethod: false. "either interpreted or machine code" - (self isMachineCodeFrame: framePointer) ifFalse: - [self maybeFlagMethodAsInterpreted: newMethod]. - self checkForStackOverflow. - self enterSmalltalkExecutiveFromCallback. - "not reached" - ^true!
vm-dev@lists.squeakfoundation.org