Merge big cursor support (was: [Vm-dev] coordination between the olpc and official svn branches)

[David T. Lewis]

On Tue, Nov 11, 2008 at 03:06:24PM +0100, Bert Freudenberg wrote:
> 
> On 10.11.2008, at 14:35, David T. Lewis wrote:
> >
> >If there are any OLPC changes that belong in the base VMMaker package,
> >I would like to harvest them in VMMaker on SqueakSource.
> 
> I'm attaching a snapshot of the VMMaker we were using in the OLPC  
> branch. Our full VMMaker image is at
> 
> 	http://etoys.laptop.org/svn/trunk/vmm/
> 
> This started out with some version of Tim's and had various changesets  
> applied ...

Hi Bert,

Your starting point was VMMaker-tpr.58.mcz, which is VMMaker 3.8b6 on
SqueakMap/Universes.

> Of the Interpreter changes, I think only #primitiveBeCursor is still  
> relevant (adds ARGB support), the rest of the differences should come  
> from the sqUInt cleanups.

That looks right, so I'll focus on #primitiveBeCursor first.

I am attaching an update to your bigCursor-bf change set with two
modifications that I think should be made to merge back into newer VMMaker
versions:

1) Changed #fetchWord:ofObject: to #fetchLong32:ofObject: in two places.
The #fetchWord:ofObject: method is deprecated in recent VMMaker versions.

2) Restored check for 64 bit object word size. This makes the primitive
into a no-op for 64 bit images, and is flagged for a fix when bitmap
conversion is implemented. I presume that this has not yet been done,
so I think the check should remain for now.

If you agree with these changes, I will apply them to the *-dtl thread
of updates in SqueakSource VMMaker. The remaining to-do item will be to
implement ioSetCursorARGB() in the win32 and RiscOS platform sources.
These can presumably be no-ops for starters.

I also opened a Mantis issue to track this and provide a record of what
we're doing (http://bugs.squeak.org/view.php?id=7224).

Thanks,
Dave

-------------- next part --------------
'From Squeak3.10.2 of ''5 June 2008'' [latest update: #7179] on 16 November 2008 at 9:46:48 am'!
"Change Set:		bigCursor-bf-dtl
Date:			16 November 2008
Author:			David T. Lewis

Modification to Bert''s bigCursor-bf, with the following changes:

Changed #fetchWord:ofObject: to #fetchLong32:ofObject:, consistent with di original method. The #fetchWord:ofObject: method is deprecated in recent VMMaker versions.

Restored check for 64 bit word size. The primitive is a no-op for 64 bit images, and flagged for a fix when bitmap conversion is implement (I presume that this has not yet been done).

"!


!Interpreter methodsFor: 'I/O primitives' stamp: 'dtl 11/16/2008 08:49'!
primitiveBeCursor
	"Set the cursor to the given shape. The Mac only supports 16x16 pixel cursors. Cursor offsets are handled by Smalltalk."

	| cursorObj maskBitsIndex maskObj bitsObj extentX extentY depth offsetObj offsetX offsetY cursorBitsIndex ourCursor |

self flag: #Dan.  "This is disabled until we convert bitmaps appropriately"
BytesPerWord = 8 ifTrue: [^ self pop: argumentCount].

	argumentCount = 0 ifTrue: [
		cursorObj := self stackTop.
		maskBitsIndex := nil].
	argumentCount = 1 ifTrue: [
		cursorObj := self stackValue: 1.
		maskObj := self stackTop].
	self success: (argumentCount < 2).

	self success: ((self isPointers: cursorObj) and: [(self lengthOf: cursorObj) >= 5]).
	successFlag ifTrue: [
		bitsObj := self fetchPointer: 0 ofObject: cursorObj.
		extentX := self fetchInteger: 1 ofObject: cursorObj.
		extentY := self fetchInteger: 2 ofObject: cursorObj.
		depth := self fetchInteger: 3 ofObject: cursorObj.
		offsetObj := self fetchPointer: 4 ofObject: cursorObj].
		self success: ((self isPointers: offsetObj) and: [(self lengthOf: offsetObj) >= 2]).

	successFlag ifTrue: [
		offsetX := self fetchInteger: 0 ofObject: offsetObj.
		offsetY := self fetchInteger: 1 ofObject: offsetObj.

		(argumentCount = 0 and: [depth = 32])
			ifTrue: [
				"Support arbitrary-sized 32 bit ARGB forms --bf 3/1/2007 23:51"
				self success: ((extentX > 0) and: [extentY > 0]).
				self success: ((offsetX >= (extentX * -1)) and: [offsetX <= 0]).
				self success: ((offsetY >= (extentY * -1)) and: [offsetY <= 0]).
				cursorBitsIndex := bitsObj + BaseHeaderSize.
				self success: ((self isWords: bitsObj) and: [(self lengthOf: bitsObj) = (extentX * extentY)]).
				self cCode: '' inSmalltalk:
					[ourCursor := Cursor
						extent: extentX @ extentY
						depth: 32
						fromArray: ((1 to: extentX * extentY) collect: [:i |
							self fetchLong32: i-1 ofObject: bitsObj])
						offset: offsetX  @ offsetY]]
			ifFalse: [
				self success: ((extentX = 16) and: [extentY = 16 and: [depth = 1]]).
				self success: ((offsetX >= -16) and: [offsetX <= 0]).
				self success: ((offsetY >= -16) and: [offsetY <= 0]).
				self success: ((self isWords: bitsObj) and: [(self lengthOf: bitsObj) = 16]).
				cursorBitsIndex _ bitsObj + BaseHeaderSize.
				self cCode: '' inSmalltalk:
					[ourCursor := Cursor
						extent: extentX @ extentY
						fromArray: ((1 to: 16) collect: [:i |
							((self fetchLong32: i-1 ofObject: bitsObj) >> 16) bitAnd: 16rFFFF])
						offset: offsetX  @ offsetY]]].

	argumentCount = 1 ifTrue: [
		self success: ((self isPointers: maskObj) and: [(self lengthOf: maskObj) >= 5]).
		successFlag ifTrue: [
			bitsObj := self fetchPointer: 0 ofObject: maskObj.
			extentX := self fetchInteger: 1 ofObject: maskObj.
			extentY := self fetchInteger: 2 ofObject: maskObj.
			depth := self fetchInteger: 3 ofObject: maskObj].

		successFlag ifTrue: [
			self success: ((extentX = 16) and: [extentY = 16 and: [depth = 1]]).
			self success: ((self isWords: bitsObj) and: [(self lengthOf: bitsObj) = 16]).
			maskBitsIndex := bitsObj + BaseHeaderSize]].


	successFlag ifTrue: [
		argumentCount = 0
			ifTrue: [
				depth = 32
					ifTrue: [(self cCode: 'ioSetCursorARGB(cursorBitsIndex, extentX, extentY, offsetX, offsetY)'
						inSmalltalk: [ourCursor show. Cursor currentCursor == ourCursor])	
							ifFalse: [^self success: false]]
					ifFalse: [self cCode: 'ioSetCursor(cursorBitsIndex, offsetX, offsetY)'
						inSmalltalk: [ourCursor show]]]
			ifFalse: [self cCode: 'ioSetCursorWithMask(cursorBitsIndex, maskBitsIndex, offsetX, offsetY)'
						inSmalltalk: [ourCursor show]].
		self pop: argumentCount].
! !