[Vm-dev] VM Maker: VMMaker.oscog-tpr.571.mcz

commits at source.squeak.org commits at source.squeak.org
Thu Dec 26 20:20:40 UTC 2013


tim Rowledge uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-tpr.571.mcz

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

Name: VMMaker.oscog-tpr.571
Author: tpr
Time: 26 December 2013, 12:17:06.519 pm
UUID: 3bc0517d-14b9-481c-b6ad-fd6f9752d8c1
Ancestors: VMMaker.oscog-eem.566, VMMaker.oscog-eem.570

Merged changes to add assorted Scratch pluguns and skiped from 566 to 570 - alwatys some possibility of a screwup when merging, so take care

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

Item was changed:
  ----- Method: BitBltSimulation>>primitivePixelValueAtX:y: (in category 'primitives') -----
  primitivePixelValueAtX: xVal y: yVal
  	"returns the single pixel at x at y.
  	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"
+ 	| rcvr bitmap depth ppW stride bitsSize word mask shift pixel |
- 	| rcvr bitmap depth ppW stride word mask shift pixel |
  	rcvr := self primitive: 'primitivePixelValueAt' parameters: #(SmallInteger SmallInteger) receiver: #Oop.
  	
  	"possible quick exit if x or y is -ve"
  	(xVal < 0 or: [ yVal < 0 ] ) ifTrue:[^interpreterProxy integerObjectOf: 0].
  	"check that rcvr is plausibly a Form or subclass"	
  	rcvr := interpreterProxy stackValue: interpreterProxy methodArgumentCount.
  	((interpreterProxy isPointers: rcvr) and: [(interpreterProxy slotSizeOf: rcvr) >= 4])
  		ifFalse: [^interpreterProxy primitiveFail].
  
  	"get the bits oop and width/height/depth"
  	bitmap := interpreterProxy fetchPointer: FormBitsIndex ofObject: rcvr.
+ 	(interpreterProxy isWordsOrBytes: bitmap) ifFalse: [^interpreterProxy primitiveFail].
  	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 ifTrue:[^nil].
  
  	"possible quick exit if x or y is >= extent of form. This also catches cases where the width/height are < 0"
  	(xVal >= width or: [ yVal >= height ] ) ifTrue:[^interpreterProxy integerObjectOf: 0].
  
  	"we don't handle LSB Forms yet"
  	depth < 0 ifTrue:[^interpreterProxy primitiveFail].
  	
  	"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 primitiveFail].
- 	stride := (width + (ppW  -1)) // ppW. "how many words per rox of pixels"
  	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"
  	pixel := (word >> shift) bitAnd: mask. "shift, mask and dim the lights"
  	^ pixel asPositiveIntegerObj "pop the incoming and push our answer"
  !

Item was added:
+ InterpreterPlugin subclass: #CameraPlugin
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'VMMaker-Plugins'!

Item was added:
+ ----- Method: CameraPlugin class>>hasHeaderFile (in category 'translation') -----
+ hasHeaderFile
+ 
+ 	^true!

Item was added:
+ ----- Method: CameraPlugin>>primCameraName (in category 'primitives') -----
+ primCameraName
+ 	"Get the name for the camera with the given number. Fail if the camera number is greater than the number of available cameras."
+ 
+ 	| cameraNum nameStr count resultOop dst |
+ 	self export: true.
+ 	self var: 'nameStr' declareC: 'char* nameStr'.
+ 	self var: 'dst' declareC: 'char* dst'.
+ 
+ 	cameraNum := interpreterProxy stackIntegerValue: 0.
+ 	interpreterProxy failed ifTrue: [^ 0].
+ 
+ 	nameStr := self cCode: 'CameraName(cameraNum)'.
+ 	nameStr = nil ifTrue: [
+ 		interpreterProxy success: false.
+ 		^ 0].
+ 
+ 	count := self cCode: '(int) strlen(nameStr)'.
+ 	resultOop := interpreterProxy instantiateClass: interpreterProxy classString indexableSize: count.
+ 	dst := self cCoerce: (interpreterProxy firstIndexableField: resultOop) to: 'char *'.
+ 	0 to: count - 1 do: [:i | dst at: i put: (nameStr at: i)].
+ 
+ 	interpreterProxy pop: 2 thenPush: resultOop.  "pop arg and rcvr, push result"
+ 	^ 0
+ !

Item was added:
+ ----- Method: CameraPlugin>>primCloseCamera (in category 'primitives') -----
+ primCloseCamera
+ 	"Close the camera. Do nothing if it was not open."
+ 
+ 	| cameraNum |
+ 	self export: true.
+ 	cameraNum := interpreterProxy stackIntegerValue: 0.
+ 	interpreterProxy failed ifTrue: [^ 0].
+ 
+ 	self cCode: 'CameraClose(cameraNum)'.
+ 
+ 	interpreterProxy pop: 1.  "pop arg, leave rcvr on stack"
+ 	^ 0
+ !

Item was added:
+ ----- Method: CameraPlugin>>primFrameExtent (in category 'primitives') -----
+ primFrameExtent
+ 	"Answer the frame extent of the given camera, or zero if the camera is not open. The extent is 16 bits of width and height packed into a single integer."
+ 
+ 	| cameraNum e |
+ 	self export: true.
+ 	cameraNum := interpreterProxy stackIntegerValue: 0.
+ 	interpreterProxy failed ifTrue: [^ 0].
+ 
+ 	e := self cCode: 'CameraExtent(cameraNum)'.
+ 
+ 	interpreterProxy pop: 2 thenPush: (interpreterProxy integerObjectOf: e).  "pop rcvr & arg, push int result"
+ 	^ 0
+ !

Item was added:
+ ----- Method: CameraPlugin>>primGetFrame (in category 'primitives') -----
+ primGetFrame
+ 	"Copy a camera frame into the given Bitmap. The Bitmap should be for a Form of depth 32 that is the same width and height as the current camera frame. Fail if the camera is not open or if the bitmap is not the right size. If successful, answer the number of frames received from the camera since the last call. If this is zero, then there has been no change."
+ 
+ 	| cameraNum bitmapOop bitmap pixCount result |
+ 	self export: true.
+ 	self var: 'bitmap' declareC: 'unsigned char *bitmap'.
+ 
+ 	cameraNum := interpreterProxy stackIntegerValue: 1.
+ 	bitmapOop := interpreterProxy stackValue: 0.
+ 	((interpreterProxy isIntegerObject: bitmapOop) or:
+ 	 [(interpreterProxy isWords: bitmapOop) not]) ifTrue: [
+ 		interpreterProxy success: false.
+ 		^ 0].
+ 	bitmap := self cCoerce: (interpreterProxy firstIndexableField: bitmapOop) to: 'unsigned char *'.
+ 	pixCount := interpreterProxy stSizeOf: bitmapOop.
+ 
+ 	result := self cCode: 'CameraGetFrame(cameraNum, bitmap, pixCount)'.
+ 	result < 0 ifTrue: [
+ 		interpreterProxy success: false.
+ 		^ 0].
+ 
+ 	interpreterProxy pop: 3 thenPush: (interpreterProxy integerObjectOf: result).  "pop rcvr & args, push int result"
+ 	^ 0
+ 
+ !

Item was added:
+ ----- Method: CameraPlugin>>primGetParam (in category 'primitives') -----
+ primGetParam
+ 	"Answer the given integer parameter of the given camera."
+ 
+ 	| cameraNum paramNum result |
+ 	self export: true.
+ 	cameraNum := interpreterProxy stackIntegerValue: 1.
+ 	paramNum := interpreterProxy stackIntegerValue: 0.
+ 	interpreterProxy failed ifTrue: [^ 0].
+ 
+ 	result := self cCode: 'CameraGetParam(cameraNum, paramNum)'.
+ 
+ 	interpreterProxy pop: 3 thenPush: (interpreterProxy integerObjectOf: result).  "pop rcvr & args, push int result"
+ 	^ 0
+ !

Item was added:
+ ----- Method: CameraPlugin>>primOpenCamera (in category 'primitives') -----
+ primOpenCamera
+ 	"Open a camera. Takes one argument, the index of the device to open."
+ 
+ 	| cameraNum desiredFrameWidth desiredFrameHeight ok |
+ 	self export: true.
+ 
+ 	cameraNum := interpreterProxy stackIntegerValue: 2.
+ 	desiredFrameWidth := interpreterProxy stackIntegerValue: 1.
+ 	desiredFrameHeight := interpreterProxy stackIntegerValue: 0.
+ 	interpreterProxy failed ifTrue: [^ 0].
+ 
+ 	ok := self cCode: 'CameraOpen(cameraNum, desiredFrameWidth, desiredFrameHeight)'.
+ 	ok = 0 ifTrue: [
+ 		interpreterProxy success: false.
+ 		^ 0].
+ 
+ 	interpreterProxy pop: 3.  "pop args, leave rcvr on stack"
+ 	^ 0
+ !

Item was changed:
  ----- Method: CoInterpreter>>printPrimLogEntryAt: (in category 'debug support') -----
  printPrimLogEntryAt: i
  	<inline: false>
  	| intOrSelector |
  	intOrSelector := primTraceLog at: i.
  	(objectMemory isImmediate: intOrSelector)
  		ifTrue:
+ 			[intOrSelector = TraceIncrementalGC ifTrue:
- 			[ intOrSelector = TraceIncrementalGC ifTrue:
  				[self print: '**IncrementalGC**'. ^nil].
  			 intOrSelector = TraceFullGC ifTrue:
  				[self print: '**FullGC**'. ^nil].
  			 intOrSelector = TraceCodeCompaction ifTrue:
  				[self print: '**CompactCode**'. ^nil].
  			 self print: '???']
  		ifFalse:
  			[objectMemory safePrintStringOf: intOrSelector]!

Item was added:
+ ----- Method: CogObjectRepresentation>>genInnerPrimitiveAsCharacter:inReg: (in category 'primitive generators') -----
+ genInnerPrimitiveAsCharacter: retNOffset inReg: reg
+ 	"subclasses override if they can"
+ 	^cogit unimplementedPrimitive!

Item was added:
+ ----- Method: CogObjectRepresentation>>genInnerPrimitiveCharacterValue: (in category 'primitive generators') -----
+ genInnerPrimitiveCharacterValue: retNOffset
+ 	"subclasses override if they can"
+ 	^cogit unimplementedPrimitive!

Item was removed:
- ----- Method: CogObjectRepresentation>>isHashSetOnInstanceCreation (in category 'testing') -----
- isHashSetOnInstanceCreation
- 	self subclassResponsibility!

Item was added:
+ ----- Method: CogObjectRepresentationFor32BitSpur>>genConvertCharacterToSmallIntegerInReg: (in category 'compile abstract instructions') -----
+ genConvertCharacterToSmallIntegerInReg: reg
+ 	"Convert the SmallInteger in reg to a Character, assuming
+ 	 the SmallInteger's value is a valid character."
+ 	"self assume: objectMemory smallIntegerTag = 1"
+ 	self assert: (objectMemory characterTag = 2
+ 				 and: [self numCharacterBits + 1 = self numSmallIntegerBits]).
+ 	cogit LogicalShiftRightCq: 1 R: reg!

Item was added:
+ ----- Method: CogObjectRepresentationFor32BitSpur>>genConvertSmallIntegerToCharacterInReg: (in category 'compile abstract instructions') -----
+ genConvertSmallIntegerToCharacterInReg: reg
+ 	"Convert the SmallInteger in reg to a Character, assuming
+ 	 the SmallInteger's value is a valid character."
+ 	"self assume: objectMemory smallIntegerTag = 1"
+ 	self assert: (objectMemory characterTag = 2
+ 				 and: [self numCharacterBits + 1 = self numSmallIntegerBits]).
+ 	cogit LogicalShiftLeftCq: 1 R: reg!

Item was changed:
  ----- Method: CogObjectRepresentationFor32BitSpur>>getInlineCacheClassTagFrom:into: (in category 'compile abstract instructions') -----
  getInlineCacheClassTagFrom: sourceReg into: destReg
  	"Extract the inline cache tag for the object in sourceReg into destReg. The inline
  	 cache tag for a given object is the value loaded in inline caches to distinguish
  	 objects of different classes.  In Spur this is either the tags for immediates, (with
  	 1 & 3 collapsed to 1 for SmallIntegers, and 2 collapsed to 0 for Characters), or
  	 the receiver's classIndex.  Generate something like this:
+ 		Limm:
+ 			andl $0x1, rDest
+ 			j Lcmp
  		Lentry:
  			movl rSource, rDest
  			andl $0x3, rDest
+ 			jnz Limm
- 			jz LnotImm
- 			andl $1, rDest
- 			j Lcmp
- 		LnotImm:
  			movl 0(%edx), rDest
  			andl $0x3fffff, rDest
  		Lcmp:
+ 	 At least on a 2.2GHz Intel Core i7 the following is slightly faster than the above,
+ 	 136m sends/sec vs 130m sends/sec for nfib in tinyBenchmarks
- 	 At least on a 2.2GHz Intel Core i7 it is slightly faster,
- 	 136m sends/sec vs 130m sends/sec for nfib in tinyBenchmarks, than
- 		Limm:
- 			andl $0x1, rDest
- 			j Lcmp
  		Lentry:
  			movl rSource, rDest
  			andl $0x3, rDest
+ 			jz LnotImm
+ 			andl $1, rDest
+ 			j Lcmp
+ 		LnotImm:
- 			jnz Limm
  			movl 0(%edx), rDest
  			andl $0x3fffff, rDest
  		Lcmp:
+ 	 But we expect most SMallInteger arithmetic to be performwd in-line and so prefer the
+ 	 version that is faster for non-immediates (because it branches for immediates only)."
- 	"
  	| immLabel jumpNotImm entryLabel jumpCompare |
  	<var: #immLabel type: #'AbstractInstruction *'>
  	<var: #jumpNotImm type: #'AbstractInstruction *'>
  	<var: #entryLabel type: #'AbstractInstruction *'>
  	<var: #jumpCompare type: #'AbstractInstruction *'>
+ 	false
- 	true
  		ifTrue:
+ 			[cogit AlignmentNops: BytesPerWord.
- 			[cogit AlignmentNops: (BytesPerWord max: self entryAlignment).
  			 entryLabel := cogit Label.
  			 cogit MoveR: sourceReg R: destReg.
  			 cogit AndCq: objectMemory tagMask R: destReg.
  			 jumpNotImm := cogit JumpZero: 0.
  			 cogit AndCq: 1 R: destReg.
  			 jumpCompare := cogit Jump: 0.
  			 "Get least significant half of header word in destReg"
  			 self flag: #endianness.
  			 jumpNotImm jmpTarget:
  				(cogit MoveMw: 0 r: sourceReg R: destReg).
  			 jumpCompare jmpTarget:
  				(cogit AndCq: objectMemory classIndexMask R: destReg)]
  		ifFalse:
  			[cogit AlignmentNops: BytesPerWord.
  			 immLabel := cogit Label.
  			 cogit AndCq: 1 R: destReg.
  			 jumpCompare := cogit Jump: 0.
  			 cogit AlignmentNops: BytesPerWord.
  			 entryLabel := cogit Label.
  			 cogit MoveR: sourceReg R: destReg.
  			 cogit AndCq: objectMemory tagMask R: destReg.
  			 cogit JumpNonZero: immLabel.
  			 self flag: #endianness.
  			 "Get least significant half of header word in destReg"
  			 cogit MoveMw: 0 r: sourceReg R: destReg.
  			 cogit AndCq: objectMemory classIndexMask R: destReg.
  			 jumpCompare jmpTarget: cogit Label].
  	^entryLabel!

Item was added:
+ ----- Method: CogObjectRepresentationFor32BitSpur>>numCharacterBits (in category 'compile abstract instructions') -----
+ numCharacterBits
+ 	^30!

Item was added:
+ ----- Method: CogObjectRepresentationForSpur>>genConvertSmallIntegerToCharacterInReg: (in category 'compile abstract instructions') -----
+ genConvertSmallIntegerToCharacterInReg: reg
+ 	self subclassResponsibility!

Item was added:
+ ----- Method: CogObjectRepresentationForSpur>>genInnerPrimitiveAsCharacter:inReg: (in category 'primitive generators') -----
+ genInnerPrimitiveAsCharacter: retNOffset inReg: reg
+ 	| jumpNotInt jumpOutOfRange |
+ 	<var: 'jumpNotInt' type: #'AbstractInstruction *'>
+ 	<var: 'jumpOutOfRange' type: #'AbstractInstruction *'>
+ 	reg ~= ReceiverResultReg ifTrue:
+ 		[cogit MoveR: reg R: TempReg.
+ 		 jumpNotInt := self genJumpNotSmallIntegerInScratchReg: TempReg].
+ 	cogit MoveR: reg R: TempReg.
+ 	self genConvertSmallIntegerToIntegerInReg: TempReg.
+ 	cogit CmpCq: (1 << 30) - 1 R: TempReg.
+ 	jumpOutOfRange := cogit JumpAbove: 0.
+ 	self genConvertSmallIntegerToCharacterInReg: reg.
+ 	reg ~= ReceiverResultReg ifTrue:
+ 		[cogit MoveR: reg R: ReceiverResultReg].
+ 	cogit RetN: retNOffset.
+ 	jumpOutOfRange jmpTarget: cogit Label.
+ 	reg ~= ReceiverResultReg ifTrue:
+ 		[jumpNotInt jmpTarget: jumpOutOfRange getJmpTarget].
+ 	^0!

Item was added:
+ ----- Method: CogObjectRepresentationForSpur>>genInnerPrimitiveCharacterValue: (in category 'primitive generators') -----
+ genInnerPrimitiveCharacterValue: retNOffset
+ 	self genConvertCharacterToSmallIntegerInReg: ReceiverResultReg.
+ 	cogit RetN: retNOffset.
+ 	^0!

Item was added:
+ ----- Method: CogObjectRepresentationForSpur>>genInnerPrimitiveIdentical:orNotIf: (in category 'primitive generators') -----
+ genInnerPrimitiveIdentical: retNoffset orNotIf: orNot
+ 	| jumpImmediate jumpCmp |
+ 	<var: #jumpCmp type: #'AbstractInstruction *'>
+ 	<var: #jumpImmediate type: #'AbstractInstruction *'>
+ 	cogit MoveR: Arg0Reg R: TempReg.
+ 	jumpImmediate := self genJumpImmediateInScratchReg: TempReg.
+ 	self genEnsureObjInRegRegNotForwarded: Arg0Reg scratchReg: TempReg.
+ 	jumpImmediate jmpTarget:
+ 		(cogit CmpR: Arg0Reg R: ReceiverResultReg).
+ 	jumpCmp := orNot
+ 					ifTrue: [cogit JumpZero: 0]
+ 					ifFalse: [cogit JumpNonZero: 0].
+ 	cogit annotate: (cogit MoveCw: objectMemory trueObject R: ReceiverResultReg)
+ 		objRef: objectMemory trueObject.
+ 	cogit RetN: retNoffset.
+ 	jumpCmp jmpTarget: (cogit annotate: (cogit MoveCw: objectMemory falseObject R: ReceiverResultReg)
+ 								objRef: objectMemory falseObject).
+ 	cogit RetN: retNoffset.
+ 	^0!

Item was added:
+ ----- Method: CogObjectRepresentationForSpur>>genInnerPrimitiveIdentityHash: (in category 'primitive generators') -----
+ genInnerPrimitiveIdentityHash: retNoffset
+ 	| jumpImm jumpSI jumpNotSet ret |
+ 	<var: #jumpSI type: #'AbstractInstruction *'>
+ 	<var: #jumpImm type: #'AbstractInstruction *'>
+ 	<var: #jumpNotSet type: #'AbstractInstruction *'>
+ 	cogit MoveR: ReceiverResultReg R: ClassReg.
+ 	jumpImm := self genJumpImmediateInScratchReg: ClassReg.
+ 	self genGetHashFieldNonImmOf: ReceiverResultReg asSmallIntegerInto: TempReg.
+ 	cogit CmpCq: ConstZero R: TempReg.
+ 	jumpNotSet := cogit JumpZero: 0.
+ 	cogit MoveR: TempReg R: ReceiverResultReg.
+ 	ret := cogit RetN: 0.
+ 	cogit MoveR: ReceiverResultReg R: ClassReg.
+ 	jumpSI := self genJumpSmallIntegerInScratchReg: ClassReg.
+ 	jumpSI jmpTarget: ret.
+ 	jumpImm jmpTarget: cogit Label.
+ 	self genRemoveSmallIntegerTagsInScratchReg: ReceiverResultReg.
+ 	self genSetCharacterTagsIn: ReceiverResultReg.
+ 	cogit Jump: ret.
+ 	jumpNotSet jmpTarget: cogit Label.
+ 	^0!

Item was added:
+ ----- Method: CogObjectRepresentationForSpur>>genRemoveCharacterTagsInScratchReg: (in category 'compile abstract instructions') -----
+ genRemoveCharacterTagsInScratchReg: scratchReg
+ 	cogit SubCq: objectMemory characterTag R: scratchReg!

Item was added:
+ ----- Method: CogObjectRepresentationForSpur>>genSetCharacterTagsIn: (in category 'compile abstract instructions') -----
+ genSetCharacterTagsIn: reg
+ 	cogit OrCq: objectMemory characterTag R: reg!

Item was removed:
- ----- Method: CogObjectRepresentationForSpur>>isHashSetOnInstanceCreation (in category 'testing') -----
- isHashSetOnInstanceCreation
- 	^false!

Item was added:
+ ----- Method: CogObjectRepresentationForSqueakV3>>genInnerPrimitiveIdentical:orNotIf: (in category 'primitive generators') -----
+ genInnerPrimitiveIdentical: retNoffset orNotIf: orNot
+ 	| jumpCmp |
+ 	<var: #jumpCmp type: #'AbstractInstruction *'>
+ 	cogit CmpR: Arg0Reg R: ReceiverResultReg.
+ 	jumpCmp := orNot
+ 					ifTrue: [cogit JumpZero: 0]
+ 					ifFalse: [cogit JumpNonZero: 0].
+ 	cogit annotate: (cogit MoveCw: objectMemory trueObject R: ReceiverResultReg)
+ 		objRef: objectMemory trueObject.
+ 	cogit RetN: retNoffset.
+ 	jumpCmp jmpTarget: (cogit annotate: (cogit MoveCw: objectMemory falseObject R: ReceiverResultReg)
+ 								objRef: objectMemory falseObject).
+ 	cogit RetN: retNoffset.
+ 	^0!

Item was added:
+ ----- Method: CogObjectRepresentationForSqueakV3>>genInnerPrimitiveIdentityHash: (in category 'primitive generators') -----
+ genInnerPrimitiveIdentityHash: retNOffset
+ 	| jumpSI |
+ 	<var: #jumpSI type: #'AbstractInstruction *'>
+ 	cogit MoveR: ReceiverResultReg R: ClassReg.
+ 	jumpSI := self genJumpSmallIntegerInScratchReg: ClassReg.
+ 	self genGetHashFieldNonImmOf: ReceiverResultReg asSmallIntegerInto: TempReg.
+ 	cogit MoveR: TempReg R: ReceiverResultReg.
+ 	cogit RetN: retNOffset.
+ 	jumpSI jmpTarget: cogit Label.
+ 	^0!

Item was removed:
- ----- Method: CogObjectRepresentationForSqueakV3>>isHashSetOnInstanceCreation (in category 'testing') -----
- isHashSetOnInstanceCreation
- 	^true!

Item was changed:
  ----- Method: CogVMSimulator>>utilitiesMenu: (in category 'UI') -----
  utilitiesMenu: aMenuMorph
  	aMenuMorph
  		add: 'toggle transcript' action: #toggleTranscript;
  		add: 'clone VM' action: #cloneSimulation;
  		addLine;
  		add: 'print ext head frame' action: #printExternalHeadFrame;
  		add: 'print int head frame' action: #printHeadFrame;
  		add: 'print mc/cog frame' action: [self printFrame: cogit processor fp WithSP: cogit processor sp];
  		add: 'short print ext frame & callers' action: [self shortPrintFrameAndCallers: framePointer];
  		add: 'short print int frame & callers' action: [self shortPrintFrameAndCallers: localFP];
  		add: 'short print mc/cog frame & callers' action: [self shortPrintFrameAndCallers: cogit processor fp];
  		add: 'long print ext frame & callers' action: [self printFrameAndCallers: framePointer SP: stackPointer];
  		add: 'long print int frame & callers' action: [self printFrameAndCallers: localFP SP: localSP];
  		add: 'long print mc/cog frame & callers' action: [self printFrameAndCallers: cogit processor fp SP: cogit processor sp];
  		add: 'print frame...' action: [(self promptHex: 'print frame') ifNotNil: [:fp| self printFrame: fp]];
  		add: 'print call stack' action: #printCallStack;
  		add: 'print stack call stack' action: #printStackCallStack;
+ 		add: 'print stack call stack of...' action: [(self promptHex: 'frame') ifNotNil: [:fp| self printStackCallStackOf: fp]];
  		add: 'print call stack of...' action: [(self promptHex: 'context or process oop') ifNotNil: [:obj| self printCallStackOf: obj]];
  		add: 'print call stack of frame...' action: [(self promptHex: 'frame') ifNotNil: [:fp| self printCallStackFP: fp]];
  		add: 'print all stacks' action: #printAllStacks;
  		add: 'write back local ptrs' action: [stackPointer := localSP. framePointer := localFP. instructionPointer := localIP.
  											self writeBackHeadFramePointers];
  		add: 'write back mc ptrs' action: [stackPointer := cogit processor sp. framePointer := cogit processor fp. instructionPointer := cogit processor eip.
  											self writeBackHeadFramePointers];
  		addLine;
  		add: 'print registers' action: [cogit processor printRegistersOn: transcript];
  		add: 'print register map' action: [cogit printRegisterMapOn: transcript];
  		add: 'disassemble method/trampoline...' action: [(self promptHex: 'pc') ifNotNil: [:pc| cogit disassembleCodeAt: pc]];
  		add: 'disassemble method/trampoline at pc' action: [cogit disassembleCodeAt: cogit processor pc];
  		add: 'disassemble ext head frame method' action: [cogit disassembleMethod: (self frameMethod: framePointer)];
  		add: 'print oop...' action: [(self promptHex: 'print oop') ifNotNil: [:oop| self printOop: oop]];
  		add: 'long print oop...' action: [(self promptHex: 'print oop') ifNotNil: [:oop| self longPrintOop: oop]];
  		addLine;
  		add: 'inspect object memory' target: objectMemory action: #inspect;
  		add: 'inspect cointerpreter' action: #inspect;
  		add: 'inspect cogit' target: cogit action: #inspect;
  		add: 'inspect method zone' target: cogit methodZone action: #inspect.
  	self isThreadedVM ifTrue:
  		[aMenuMorph add: 'inspect thread manager' target: self threadManager action: #inspect].
  	aMenuMorph
  		addLine;
  		add: 'print cog methods' target: cogMethodZone action: #printCogMethods;
  		add: 'print cog methods with prim...' action: [(self promptNum: 'prim index') ifNotNil: [:pix| cogMethodZone printCogMethodsWithPrimitive: pix]];
  		add: 'print trampoline table' target: cogit action: #printTrampolineTable;
  		add: 'print prim trace log' action: #dumpPrimTraceLog;
  		add: 'report recent instructions' target: cogit action: #reportLastNInstructions;
  		add: 'set break pc (', (cogit breakPC isInteger ifTrue: [cogit breakPC hex] ifFalse: [cogit breakPC printString]), ')...' action: [(self promptHex: 'break pc') ifNotNil: [:bpc| cogit breakPC: bpc]];
  		add: (cogit singleStep
  				ifTrue: ['no single step']
  				ifFalse: ['single step'])
  			action: [cogit singleStep: cogit singleStep not];
  		add: (cogit printRegisters
  				ifTrue: ['no print registers each instruction']
  				ifFalse: ['print registers each instruction'])
  			action: [cogit printRegisters: cogit printRegisters not];
  		add: (cogit printInstructions
  				ifTrue: ['no print instructions each instruction']
  				ifFalse: ['print instructions each instruction'])
  			action: [cogit printInstructions: cogit printInstructions not];
  		addLine;
  		add: 'set break count...' action: [|s| s := UIManager default request: 'break count (dec)'.
  											s notEmpty ifTrue: [breakCount := Integer readFrom: s readStream]];
  		add: 'set break selector...' action: [|s| s := UIManager default request: 'break selector'.
  											s notEmpty ifTrue: [self setBreakSelector: s]];
  		add: 'set break block...' action: [|s| s := UIManager default request: 'break block'.
  											s notEmpty ifTrue: [self setBreakBlockFromString: s]];
  		add: (printBytecodeAtEachStep
  				ifTrue: ['no print bytecode each bytecode']
  				ifFalse: ['print bytecode each bytecode'])
  			action: [self ensureDebugAtEachStepBlock.
  					printBytecodeAtEachStep := printBytecodeAtEachStep not];
  		add: (printFrameAtEachStep
  				ifTrue: ['no print frame each bytecode']
  				ifFalse: ['print frame each bytecode'])
  			action: [self ensureDebugAtEachStepBlock.
  					printFrameAtEachStep := printFrameAtEachStep not].
  	^aMenuMorph!

Item was changed:
  ----- Method: Interpreter>>dumpImage: (in category 'image save/restore') -----
  dumpImage: fileName
  	"Dump the entire image out to the given file. Intended for debugging only."
  	| f dataSize result |
  	<export: true>
  	<var: #f type: 'sqImageFile'>
  
  	f := self cCode: 'sqImageFileOpen(fileName, "wb")'.
  	f = nil ifTrue: [^-1].
  	dataSize := endOfMemory - self startOfMemory.
+ 	result := self cCode: 'sqImageFileWrite(pointerForOop(memory()), sizeof(unsigned char), dataSize, f)'.
- 	result := self cCode: 'sqImageFileWrite(pointerForOop(memory), sizeof(unsigned char), dataSize, f)'.
  	self cCode: 'sqImageFileClose(f)'.
  	^result
  !

Item was changed:
  ----- Method: ObjectMemory>>memory (in category 'accessing') -----
  memory
+ 	<cmacro: '() GIV(memory)'>
- 	<cmacro: '() memory'>
  	^memory!

Item was changed:
  ----- Method: ObjectMemory>>startOfMemory (in category 'object enumeration') -----
  startOfMemory
  	"Return the start of object memory. Use a macro so as not to punish the debug VM."
+ 	<cmacro: '() GIV(memory)'>
- 	<cmacro: '() memory'>
  	<returnTypeC: #usqInt>
  	^memory!

Item was added:
+ InterpreterPlugin subclass: #ScratchPlugin
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'VMMaker-Plugins'!
+ 
+ !ScratchPlugin commentStamp: 'jm 11/8/2006 18:33' prior: 0!
+ This plugin combines a number of primitives needed by Scratch including:
+ 
+   a. primitives that manipulate 24-bit color images (i.e. 32-bit deep Forms but alpha is ignored)
+   b. primitive to open browsers, find the user's documents folder, set the window title and other host OS functions
+ 
+ This plugin includes new serial port primitives, including support for named serial ports. The underlying plugin code can support up to 32 simultaenously open ports.
+ 
+ Port options for Set/GetOption primitives:
+   1. baud rate
+   2. data bits
+   3. stop bits
+   4. parity type
+   5. input flow control type
+   6. output flow control type
+ 
+ Handshake lines (options 20-25 for Set/GetOption primitives):
+   20. DTR	(output line)
+   21. RTS	(output line)
+   22. CTS	(input line)
+   23. DSR	(input line)
+   24. CD		(input line)
+   25. RI		(input line)
+ 
+ !

Item was added:
+ ----- Method: ScratchPlugin class>>hasHeaderFile (in category 'translation') -----
+ hasHeaderFile
+ 
+ 	^true!

Item was added:
+ ----- Method: ScratchPlugin>>bitmap:at:putH:s:v: (in category 'private') -----
+ bitmap: bitmap at: i putH: hue s: saturation v: brightness
+ 
+ 	| hI hF p q t v outPix |
+ 	self inline: true.
+ 	self var: 'bitmap' declareC: 'unsigned int *bitmap'.
+ 
+ 	hI := hue // 60.  "integer part of hue (0..5)"
+ 	hF := hue \\ 60.  "fractional part ofhue"
+ 	p := (1000 - saturation) * brightness.
+ 	q := (1000 - ((saturation * hF) // 60)) * brightness.
+ 	t := (1000 - ((saturation * (60 - hF)) // 60)) * brightness.
+ 
+ 	v := (brightness * 1000) // 3922.
+ 	p := p // 3922.
+ 	q := q // 3922.
+ 	t := t // 3922.
+ 
+ 	0 = hI ifTrue: [outPix := ((v bitShift: 16) + (t bitShift: 8) + p)].
+ 	1 = hI ifTrue: [outPix := ((q bitShift: 16) + (v bitShift: 8) + p)].
+ 	2 = hI ifTrue: [outPix := ((p bitShift: 16) + (v bitShift: 8) + t)].
+ 	3 = hI ifTrue: [outPix := ((p bitShift: 16) + (q bitShift: 8) + v)].
+ 	4 = hI ifTrue: [outPix := ((t bitShift: 16) + (p bitShift: 8) + v)].
+ 	5 = hI ifTrue: [outPix := ((v bitShift: 16) + (p bitShift: 8) + q)].
+ 
+ 	outPix = 0 ifTrue: [outPix := 1].  "convert transparent to 1"
+ 	bitmap at: i put: outPix.
+ 	^ 0
+ !

Item was added:
+ ----- Method: ScratchPlugin>>checkedFloatPtrOf: (in category 'private') -----
+ checkedFloatPtrOf: oop
+ 	"Return an unsigned int pointer to the first indexable word of oop, which must be a words object."
+ 
+ 	self inline: true.
+ 	self returnTypeC: 'double *'.
+ 
+ 	interpreterProxy success: (interpreterProxy isWordsOrBytes: oop).
+ 	interpreterProxy failed ifTrue: [^ 0].
+ 	^ self cCoerce: (interpreterProxy firstIndexableField: oop) to: 'double *'
+ !

Item was added:
+ ----- Method: ScratchPlugin>>checkedUnsignedIntPtrOf: (in category 'private') -----
+ checkedUnsignedIntPtrOf: oop
+ 	"Return an unsigned int pointer to the first indexable word of oop, which must be a words object."
+ 
+ 	self inline: true.
+ 	self returnTypeC: 'unsigned int *'.
+ 
+ 	interpreterProxy success: (interpreterProxy isWords: oop).
+ 	interpreterProxy failed ifTrue: [^ 0].
+ 	^ self cCoerce: (interpreterProxy firstIndexableField: oop) to: 'unsigned int *'
+ !

Item was added:
+ ----- Method: ScratchPlugin>>hueFromR:G:B:min:max: (in category 'private') -----
+ hueFromR: r G: g B: b min: min max: max
+ 	"Answer the hue, an angle between 0 and 360."
+ 
+ 	| span result |
+ 	self inline: true.
+ 
+ 	span := max - min.
+ 	span = 0 ifTrue: [^ 0].
+ 
+ 	r = max
+ 		ifTrue: [result := ((60 * (g - b)) // span)]
+ 		ifFalse: [
+ 			g = max
+ 				ifTrue: [result := 120 + ((60 * (b - r)) // span)]
+ 				ifFalse: [result := 240 + ((60 * (r - g)) // span)]].
+ 
+ 	result < 0 ifTrue: [^ result + 360].
+ 	^ result
+ !

Item was added:
+ ----- Method: ScratchPlugin>>interpolate:and:frac: (in category 'private') -----
+ interpolate: pix1 and: pix2 frac: frac2
+ 	"Answer the interpolated pixel value between the given two pixel values. If either pixel is zero (transparent) answer the other pixel. If both pixels are  transparent, answer transparent. The fraction is between 0 and 1023, out of a total range of 1024."
+ 
+ 	| frac1 r g b result |
+ 	self inline: true.
+ 
+ 	pix1 = 0 ifTrue: [^ pix2].  "pix1 is transparent"
+ 	pix2 = 0 ifTrue: [^ pix1].  "pix2 is transparent"
+ 
+ 	frac1 := 1024 - frac2.
+ 	r := ((frac1 * ((pix1 bitShift: -16) bitAnd: 16rFF)) + (frac2 * ((pix2 bitShift: -16) bitAnd: 16rFF))) // 1024.
+ 	g := ((frac1 * ((pix1 bitShift: -8) bitAnd: 16rFF)) + (frac2 * ((pix2 bitShift: -8) bitAnd: 16rFF))) // 1024.
+ 	b := ((frac1 * (pix1 bitAnd: 16rFF)) + (frac2 * (pix2 bitAnd: 16rFF))) // 1024.
+ 	result := (r bitShift: 16) + (g bitShift: 8) + b.
+ 	result = 0 ifTrue: [result := 1].
+ 	^ result
+ !

Item was added:
+ ----- Method: ScratchPlugin>>interpolatedFrom:x:y:width:height: (in category 'private') -----
+ interpolatedFrom: bitmap x: xFixed y: yFixed width: w height: h
+ 	"Answer the interpolated pixel value from the given bitmap at the given point. The x and y coordinates are fixed-point integers with 10 bits of fraction (i.e. they were multiplied by 1024, then truncated). If the given point is right on an edge, answer the nearest edge pixel value. If it is entirely outside of the image, answer 0 (transparent)."
+ 
+ 	| x y xFrac yFrac index topPix bottomPix |
+ 	self inline: true.
+ 	self var: 'bitmap' declareC: 'unsigned int *bitmap'.
+ 
+ 	x := xFixed bitShift: -10.
+ 	(x < -1 or: [x >= w]) ifTrue: [^ 0].
+ 	y := yFixed bitShift: -10.
+ 	(y < -1 or: [y >= h]) ifTrue: [^ 0].
+ 
+ 	xFrac := xFixed bitAnd: 1023.
+ 	x = -1 ifTrue: [x := 0. xFrac := 0].  "left edge"
+ 	x = (w - 1) ifTrue: [xFrac := 0].  "right edge"
+ 
+ 	yFrac := yFixed bitAnd: 1023.
+ 	y = -1 ifTrue: [y := 0. yFrac := 0].  "top edge"
+ 	y = (h - 1) ifTrue: [yFrac := 0].  "bottom edge"
+ 
+ 	index := (y * w) + x "for squeak: + 1".
+ 	topPix := (bitmap at: index) bitAnd: 16rFFFFFF.
+ 	xFrac > 0 ifTrue: [
+ 		topPix := self interpolate: topPix and: ((bitmap at: index + 1) bitAnd: 16rFFFFFF) frac: xFrac].
+ 
+ 	yFrac = 0 ifTrue: [^ topPix].  "no y fraction, so just use value from top row"
+ 
+ 	index := ((y + 1) * w) + x "for squeak: + 1".
+ 	bottomPix := (bitmap at: index) bitAnd: 16rFFFFFF.
+ 	xFrac > 0 ifTrue: [
+ 		bottomPix := self interpolate: bottomPix and: ((bitmap at: index + 1) bitAnd: 16rFFFFFF) frac: xFrac].
+ 
+ 	^ self interpolate: topPix and: bottomPix frac: yFrac
+ !

Item was added:
+ ----- Method: ScratchPlugin>>primClose (in category 'serial port') -----
+ primClose
+ 	"Close the given serial port."
+ 
+ 	| portNum |
+ 	self export: true.
+ 	portNum := interpreterProxy stackIntegerValue: 0.
+ 	interpreterProxy failed ifTrue: [^ nil].
+ 
+ 	self cCode: 'SerialPortClose(portNum)'.
+ 
+ 	interpreterProxy pop: 1.  "pop arg, leave rcvr on stack"
+ 	^ 0
+ !

Item was added:
+ ----- Method: ScratchPlugin>>primGetOption (in category 'serial port') -----
+ primGetOption
+ 	"Return the given option value for the given serial port."
+ 
+ 	| portNum attrNum result |
+ 	self export: true.
+ 	portNum := interpreterProxy stackIntegerValue: 1.
+ 	attrNum := interpreterProxy stackIntegerValue: 0.
+ 	interpreterProxy failed ifTrue: [^ nil].
+ 
+ 	result := self cCode: 'SerialPortGetOption(portNum, attrNum)'.
+ 	result = -1 ifTrue: [interpreterProxy success: false. ^ 0].
+ 
+ 	interpreterProxy pop: 3.  "pop args and rcvr, push result"
+ 	interpreterProxy pushInteger: result.
+ 	^ 0
+ !

Item was added:
+ ----- Method: ScratchPlugin>>primIsPortOpen (in category 'serial port') -----
+ primIsPortOpen
+ 	"Answer the true if the given port is open."
+ 
+ 	| portNum result |
+ 	self export: true.
+ 	portNum := interpreterProxy stackIntegerValue: 0.
+ 	interpreterProxy failed ifTrue: [^ 0].
+ 
+ 	result := self cCode: 'SerialPortIsOpen(portNum)'.
+ 
+ 	interpreterProxy pop: 2.  "pop arg and rcvr"
+ 	interpreterProxy pushBool: result ~= 0.  "push result"
+ 	^ 0
+ !

Item was added:
+ ----- Method: ScratchPlugin>>primOpenPortNamed (in category 'serial port') -----
+ primOpenPortNamed
+ 	"Open the port with the given name and baud rate."
+ 
+ 	| nameStr src nameOop baudRate count portNum |
+ 	self export: true.
+ 	self var: 'nameStr' declareC: 'char nameStr[1000]'.
+ 	self var: 'src' declareC: 'char * src'.
+ 
+ 	nameOop := interpreterProxy stackValue: 1.
+ 	baudRate := interpreterProxy stackIntegerValue: 0.
+ 
+ 	((interpreterProxy isIntegerObject: nameOop) or:
+ 	 [(interpreterProxy isBytes: nameOop) not]) ifTrue: [
+ 		interpreterProxy success: false.
+ 		^ 0].
+ 
+ 	interpreterProxy failed ifTrue: [^ 0].
+ 
+ 	src := self cCoerce: (interpreterProxy firstIndexableField: nameOop) to: 'char *'.
+ 	count := interpreterProxy stSizeOf: nameOop.
+ 	0 to: count - 1 do: [:i | nameStr at: i put: (src at: i)].
+ 	nameStr at: count put: 0.
+ 
+ 	portNum := self cCode: 'SerialPortOpenPortNamed(nameStr, baudRate)'.
+ 	portNum = -1 ifTrue: [interpreterProxy success: false. ^ 0].
+ 
+ 	interpreterProxy	"pop args and rcvr, push result"
+ 		pop: 3
+ 		thenPush: (interpreterProxy integerObjectOf: portNum).
+ 
+ 	^ 0
+ !

Item was added:
+ ----- Method: ScratchPlugin>>primPortCount (in category 'serial port') -----
+ primPortCount
+ 	"Answer the number of serial ports."
+ 
+ 	| result |
+ 	self export: true.
+ 
+ 	result := self cCode: 'SerialPortCount()'.
+ 	result = -1 ifTrue: [interpreterProxy success: false. ^ 0].
+ 
+ 	interpreterProxy
+ 		pop: 1 thenPush: (interpreterProxy integerObjectOf: result).  "pop rcvr, push result"
+ 	^ 0
+ !

Item was added:
+ ----- Method: ScratchPlugin>>primPortName (in category 'serial port') -----
+ primPortName
+ 	"Get the name for the port with the given number. Fail if the port number is greater than the number of available ports. Port numbering starts with 1."
+ 
+ 	| portIndex nameStr count resultOop dst |
+ 	self export: true.
+ 	self var: 'nameStr' declareC: 'char nameStr[1000]'.
+ 	self var: 'dst' declareC: 'char* dst'.
+ 
+ 	portIndex := interpreterProxy stackIntegerValue: 0.
+ 	interpreterProxy failed ifTrue: [^ 0].
+ 
+ 	self cCode: 'SerialPortName(portIndex, nameStr, 1000)'.
+ 
+ 	count := self cCode: 'strlen(nameStr)'.
+ 	count = 0 ifTrue: [
+ 		interpreterProxy success: false.
+ 		^ 0].
+ 
+ 	resultOop := interpreterProxy instantiateClass: interpreterProxy classString indexableSize: count.
+ 	dst := self cCoerce: (interpreterProxy firstIndexableField: resultOop) to: 'char *'.
+ 	0 to: count - 1 do: [:i | dst at: i put: (nameStr at: i)].
+ 
+ 	interpreterProxy pop: 2 thenPush: resultOop.  "pop arg and rcvr, push result"
+ 	^ 0
+ !

Item was added:
+ ----- Method: ScratchPlugin>>primRead (in category 'serial port') -----
+ primRead
+ 	"Read data from the given serial port into the given buffer (a ByteArray or String). Answer the number of bytes read."
+ 
+ 	| portNum bufOop bufPtr bufSize bytesRead |
+ 	self export: true.
+ 	self var: 'bufPtr' declareC: 'char *bufPtr'.
+ 
+ 	portNum := interpreterProxy stackIntegerValue: 1.
+ 	bufOop := interpreterProxy stackValue: 0.
+ 
+ 	((interpreterProxy isIntegerObject: bufOop) or:
+ 	 [(interpreterProxy isBytes: bufOop) not]) ifTrue: [
+ 		interpreterProxy success: false.
+ 		^ 0].
+ 	bufPtr := self cCoerce: (interpreterProxy firstIndexableField: bufOop) to: 'char *'.
+ 	bufSize := interpreterProxy stSizeOf: bufOop.
+ 	interpreterProxy failed ifTrue: [^ nil].
+ 
+ 	bytesRead := self cCode: 'SerialPortRead(portNum, bufPtr, bufSize)'.
+ 
+ 	interpreterProxy pop: 3.  					"pop args and rcvr"
+ 	interpreterProxy pushInteger: bytesRead.	"push result"
+ 	^ 0
+ !

Item was added:
+ ----- Method: ScratchPlugin>>primSetOption (in category 'serial port') -----
+ primSetOption
+ 	"Return the given option value for the given serial port."
+ 
+ 	| portNum attrNum attrValue result |
+ 	self export: true.
+ 	portNum := interpreterProxy stackIntegerValue: 2.
+ 	attrNum := interpreterProxy stackIntegerValue: 1.
+ 	attrValue := interpreterProxy stackIntegerValue: 0.
+ 	interpreterProxy failed ifTrue: [^ nil].
+ 
+ 	result := self cCode: 'SerialPortSetOption(portNum, attrNum, attrValue)'.
+ 	result = -1 ifTrue: [interpreterProxy success: false. ^ 0].
+ 
+ 	interpreterProxy pop: 3.  "pop args; leave rcvr on stack"
+ 	^ 0
+ !

Item was added:
+ ----- Method: ScratchPlugin>>primWrite (in category 'serial port') -----
+ primWrite
+ 	"Write data to the given serial port from the given buffer (a ByteArray or String). Answer the number of bytes written."
+ 
+ 	| portNum bufOop bufPtr bufSize bytesWritten |
+ 	self export: true.
+ 	self var: 'bufPtr' declareC: 'char *bufPtr'.
+ 
+ 	portNum := interpreterProxy stackIntegerValue: 1.
+ 	bufOop := interpreterProxy stackValue: 0.
+ 
+ 	((interpreterProxy isIntegerObject: bufOop) or:
+ 	 [(interpreterProxy isBytes: bufOop) not]) ifTrue: [
+ 		interpreterProxy success: false.
+ 		^ 0].
+ 	bufPtr := self cCoerce: (interpreterProxy firstIndexableField: bufOop) to: 'char *'.
+ 	bufSize := interpreterProxy stSizeOf: bufOop.
+ 	interpreterProxy failed ifTrue: [^ nil].
+ 
+ 	bytesWritten := self cCode: 'SerialPortWrite(portNum, bufPtr, bufSize)'.
+ 
+ 	interpreterProxy pop: 3.  					"pop args and rcvr"
+ 	interpreterProxy pushInteger: bytesWritten.	"push result"
+ 	^ 0
+ !

Item was added:
+ ----- Method: ScratchPlugin>>primitiveBlur (in category 'other filters') -----
+ primitiveBlur
+ 
+ 	| inOop outOop width in out sz height n rTotal gTotal bTotal pix outPix |
+ 	self export: true.
+ 	self var: 'in' declareC: 'unsigned int *in'.
+ 	self var: 'out' declareC: 'unsigned int *out'.
+ 
+ 	inOop := interpreterProxy stackValue: 2.
+ 	outOop := interpreterProxy stackValue: 1.
+ 	width := interpreterProxy stackIntegerValue: 0.
+ 	in := self checkedUnsignedIntPtrOf: inOop.
+ 	out := self checkedUnsignedIntPtrOf: outOop.
+ 	sz := interpreterProxy stSizeOf: inOop.
+ 	interpreterProxy success: ((interpreterProxy stSizeOf: outOop) = sz).
+ 	interpreterProxy failed ifTrue: [^ nil].
+ 
+ 	height := sz // width.
+ 	1 to: height - 2 do: [:y |
+ 		1 to: width - 2 do: [:x |
+ 			n := rTotal := gTotal := bTotal := 0.
+ 			-1 to: 1 do: [:dY |
+ 				-1 to: 1 do: [:dX |
+ 					pix := (in at: ((y + dY) * width) + (x + dX) "add 1 when testing in Squeak") bitAnd: 16rFFFFFF.
+ 					pix = 0 ifFalse: [  "skip transparent pixels"
+ 						rTotal := rTotal + ((pix bitShift: -16) bitAnd: 16rFF).
+ 						gTotal := gTotal + ((pix bitShift: -8) bitAnd: 16rFF).
+ 						bTotal := bTotal + (pix bitAnd: 16rFF).
+ 						n := n + 1]]].
+ 			n = 0
+ 				ifTrue: [outPix :=  0]
+ 				ifFalse: [outPix := ((rTotal // n) bitShift: 16) + ((gTotal // n) bitShift: 8) +  (bTotal // n)].
+ 			out at: ((y * width) + x "add 1 when testing in Squeak") put: outPix]].
+ 
+ 	interpreterProxy pop: 3.  "pop args, leave rcvr on stack"
+ 	^ 0
+ !

Item was added:
+ ----- Method: ScratchPlugin>>primitiveBrightnessShift (in category 'hsv filters') -----
+ primitiveBrightnessShift
+ 
+ 	| inOop outOop shift in sz out pix r g b max min hue saturation brightness |
+ 	self export: true.
+ 	self var: 'in' declareC: 'unsigned int *in'.
+ 	self var: 'out' declareC: 'unsigned int *out'.
+ 
+ 	inOop := interpreterProxy stackValue: 2.
+ 	outOop := interpreterProxy stackValue: 1.
+ 	shift := interpreterProxy stackIntegerValue: 0.
+ 	in := self checkedUnsignedIntPtrOf: inOop.
+ 	sz := interpreterProxy stSizeOf: inOop.
+ 	out := self checkedUnsignedIntPtrOf: outOop.
+ 	interpreterProxy success: ((interpreterProxy stSizeOf: outOop) = sz).
+ 	interpreterProxy failed ifTrue: [^ nil].
+ 
+ 	0 to: sz - 1 do: [:i |
+ 		pix := (in at: i) bitAnd: 16rFFFFFF.
+ 		pix = 0 ifFalse: [  "skip pixel values of 0 (transparent)"
+ 			r := (pix bitShift: -16) bitAnd: 16rFF.
+ 			g := (pix bitShift: -8) bitAnd: 16rFF.
+ 			b := pix bitAnd: 16rFF.
+ 
+ 			"find min and max color components"
+ 			max := min := r.
+ 			g > max ifTrue: [max := g].
+ 			b > max ifTrue: [max := b].
+ 			g < min ifTrue: [min := g].
+ 			b < min ifTrue: [min := b].
+ 
+ 			"find current hue with range 0 to 360"
+ 			hue := self hueFromR: r G: g B: b min: min max: max.
+ 
+ 			"find current saturation and brightness with range 0 to 1000"
+ 			max = 0 ifTrue: [saturation := 0] ifFalse: [saturation := ((max - min) * 1000) // max].
+ 			brightness := (max * 1000) // 255.
+ 
+ 			"compute new brigthness"
+ 			brightness := brightness + (shift * 10).
+ 			brightness > 1000 ifTrue: [brightness := 1000].
+ 			brightness < 0 ifTrue: [brightness := 0].
+ 
+ 			self bitmap: out at: i putH: hue s: saturation v: brightness]].
+ 
+ 	interpreterProxy pop: 3.  "pop args, leave rcvr on stack"
+ 	^ 0
+ !

Item was added:
+ ----- Method: ScratchPlugin>>primitiveCondenseSound (in category 'sound') -----
+ primitiveCondenseSound
+ 
+ 	| srcOop dstOop factor sz src dst count max v |
+ 	self export: true.
+ 	self var: 'src' declareC: 'short *src'.
+ 	self var: 'dst' declareC: 'short *dst'.
+ 
+ 	srcOop := interpreterProxy stackValue: 2.
+ 	dstOop := interpreterProxy stackValue: 1.
+ 	factor := interpreterProxy stackIntegerValue: 0.
+ 	interpreterProxy success: (interpreterProxy isWords: srcOop).
+ 	interpreterProxy success: (interpreterProxy isWords: dstOop).
+ 
+ 	count := (2 * (interpreterProxy stSizeOf: srcOop)) // factor.
+ 	sz := 2 * (interpreterProxy stSizeOf: dstOop).
+ 	interpreterProxy success: (sz >= count).
+ 	interpreterProxy failed ifTrue: [^ nil].
+ 
+ 	src := self cCoerce: (interpreterProxy firstIndexableField: srcOop) to: 'short *'.
+ 	dst := self cCoerce: (interpreterProxy firstIndexableField: dstOop) to: 'short *'.
+ 
+ 	1 to: count do: [:i |
+ 		max := 0.
+ 		1 to: factor do: [:j |
+ 			v := self cCode: '*src++'.
+ 			v < 0 ifTrue: [v := 0 - v].
+ 			v > max ifTrue: [max := v]].
+ 		self cCode: '*dst++ = max'].
+ 
+ 	interpreterProxy pop: 3.  "pop args, leave rcvr on stack"
+ 	^ 0
+ !

Item was added:
+ ----- Method: ScratchPlugin>>primitiveDoubleSize (in category 'scaling') -----
+ primitiveDoubleSize
+ 
+ 	| in out inOop outOop inW inH outW outH dstX dstY baseIndex pix i |
+ 	self export: true.
+ 	self var: 'in' declareC: 'int *in'.
+ 	self var: 'out' declareC: 'int *out'.
+ 
+ 	inOop := interpreterProxy stackValue: 7.
+ 	inW := interpreterProxy stackIntegerValue: 6.
+ 	inH := interpreterProxy stackIntegerValue: 5.
+ 	outOop := interpreterProxy stackValue: 4.
+ 	outW := interpreterProxy stackIntegerValue: 3.
+ 	outH := interpreterProxy stackIntegerValue: 2.
+ 	dstX := interpreterProxy stackIntegerValue: 1.
+ 	dstY := interpreterProxy stackIntegerValue: 0.
+ 
+ 	in := self checkedUnsignedIntPtrOf: inOop.
+ 	out := self checkedUnsignedIntPtrOf: outOop.
+ 	interpreterProxy success: (dstX + (2 * inW)) < outW.
+ 	interpreterProxy success: (dstY + (2 * inH)) < outH.
+ 	interpreterProxy failed ifTrue: [^ nil].
+ 
+ 	0 to: inH - 1 do: [:y |
+ 		baseIndex := ((dstY + (2 * y)) * outW) + dstX.
+ 		0 to: inW - 1 do: [:x |
+ 			pix := in at: x + (y * inW).
+ 			i := baseIndex + (2 * x).
+ 			out at: i put: pix.
+ 			out at: i + 1 put: pix.
+ 			out at: i + outW put: pix.
+ 			out at: i + outW + 1 put: pix]].
+ 
+ 	interpreterProxy pop: 8.  "pop args, leave rcvr on stack"
+ 	^ 0
+ !

Item was added:
+ ----- Method: ScratchPlugin>>primitiveExtractChannel (in category 'sound') -----
+ primitiveExtractChannel
+ 
+ 	| srcOop dstOop rightFlag sz src dst |
+ 	self export: true.
+ 	self var: 'src' declareC: 'short *src'.
+ 	self var: 'dst' declareC: 'short *dst'.
+ 
+ 	srcOop := interpreterProxy stackValue: 2.
+ 	dstOop := interpreterProxy stackValue: 1.
+ 	rightFlag := interpreterProxy booleanValueOf: (interpreterProxy stackValue: 0).
+ 	interpreterProxy success: (interpreterProxy isWords: srcOop).
+ 	interpreterProxy success: (interpreterProxy isWords: dstOop).
+ 
+ 	sz := interpreterProxy stSizeOf: srcOop.
+ 	interpreterProxy success: ((interpreterProxy stSizeOf: dstOop) >= (sz // 2)).
+ 	interpreterProxy failed ifTrue: [^ nil].
+ 
+ 	src := self cCoerce: (interpreterProxy firstIndexableField: srcOop) to: 'short *'.
+ 	dst := self cCoerce: (interpreterProxy firstIndexableField: dstOop) to: 'short *'.
+ 
+ 	rightFlag ifTrue: [self cCode: 'src++']. 
+ 	1 to: sz do: [:i | self cCode: '*dst++ = *src; src += 2'].
+ 
+ 	interpreterProxy pop: 3.  "pop args, leave rcvr on stack"
+ 	^ 0
+ !

Item was added:
+ ----- Method: ScratchPlugin>>primitiveFisheye (in category 'other filters') -----
+ primitiveFisheye
+ 
+ 	| inOop outOop width in out sz height centerX centerY dx dy ang pix power r srcX srcY scaledPower |
+ 	self export: true.
+ 	self var: 'in' declareC: 'unsigned int *in'.
+ 	self var: 'out' declareC: 'unsigned int *out'.
+ 	self var: 'scaleX' declareC: 'double scaleX'.
+ 	self var: 'scaleY' declareC: 'double scaleY'.
+ 	self var: 'whirlRadians' declareC: 'double whirlRadians'.
+ 	self var: 'radiusSquared' declareC: 'double radiusSquared'.
+ 	self var: 'dx' declareC: 'double dx'.
+ 	self var: 'dy' declareC: 'double dy'.
+ 	self var: 'd' declareC: 'double d'.
+ 	self var: 'factor' declareC: 'double factor'.
+ 	self var: 'ang' declareC: 'double ang'.
+ 	self var: 'sina' declareC: 'double sina'.
+ 	self var: 'cosa' declareC: 'double cosa'.
+ 	self var: 'r' declareC: 'double r'.
+ 	self var: 'scaledPower' declareC: 'double scaledPower'.
+ 
+ 	inOop := interpreterProxy stackValue: 3.
+ 	outOop := interpreterProxy stackValue: 2.
+ 	width := interpreterProxy stackIntegerValue: 1.
+ 	power := interpreterProxy stackIntegerValue: 0.
+ 	in := self checkedUnsignedIntPtrOf: inOop.
+ 	out := self checkedUnsignedIntPtrOf: outOop.
+ 	sz := interpreterProxy stSizeOf: inOop.
+ 	interpreterProxy success: ((interpreterProxy stSizeOf: outOop) = sz).
+ 	interpreterProxy failed ifTrue: [^ nil].
+ 
+ 	"calculate height, center, scales, radius, whirlRadians, and radiusSquared"
+ 	height := sz // width.
+ 	centerX := width // 2.
+ 	centerY := height // 2.
+ 
+ 	height := sz // width.
+ 	centerX := width // 2.
+ 	centerY := height // 2.
+ 	scaledPower := power / 100.0.
+ 
+ 	0 to: width - 1 do: [:x |
+ 		0 to: height - 1 do: [:y |
+ 			dx := (x - centerX) / centerX asFloat.
+ 			dy := (y - centerY) / centerY asFloat.
+ 			r := ((dx * dx) + (dy * dy)) sqrt raisedTo: scaledPower.
+ 			r <= 1.0
+ 				ifTrue: [
+ 					ang := self cCode: 'atan2(dy,dx)'.
+ 					srcX := (1024 * (centerX + ((r * ang cos) * centerX))) asInteger.
+ 					srcY := (1024 * (centerY + ((r * ang sin) * centerY))) asInteger]
+ 				ifFalse: [
+ 					srcX := 1024 * x.
+ 					srcY := 1024 * y].
+ 			pix := self interpolatedFrom: in
+ 					x: srcX
+ 					y: srcY
+ 					width: width
+ 					height: height.
+ 			out at: ((y * width) + x "+ 1 for Squeak") put: pix]].
+ 
+ 	interpreterProxy pop: 4.  "pop args, leave rcvr on stack"
+ 	^ 0
+ !

Item was added:
+ ----- Method: ScratchPlugin>>primitiveGetFolderPath (in category 'os functions') -----
+ primitiveGetFolderPath
+ 	"Get the path for the special folder with given ID. Fail if the folder ID is out of range."
+ 
+ 	| nameStr dst folderID count resultOop |
+ 	self export: true.
+ 	self var: 'nameStr' declareC: 'char nameStr[2000]'.
+ 	self var: 'dst' declareC: 'char* dst'.
+ 
+ 	folderID := interpreterProxy stackIntegerValue: 0.
+ 	interpreterProxy failed ifTrue: [^ 0].
+ 
+ 	self cCode: 'GetFolderPathForID(folderID, nameStr, 2000)'.
+ 
+ 	count := self cCode: 'strlen(nameStr)'.
+ 	resultOop := interpreterProxy instantiateClass: interpreterProxy classString indexableSize: count.
+ 	dst := self cCoerce: (interpreterProxy firstIndexableField: resultOop) to: 'char *'.
+ 	0 to: count - 1 do: [:i | dst at: i put: (nameStr at: i)].
+ 
+ 	interpreterProxy pop: 2 thenPush: resultOop.  "pop arg and rcvr, push result"
+ 	^ 0
+ !

Item was added:
+ ----- Method: ScratchPlugin>>primitiveHalfSizeAverage (in category 'scaling') -----
+ primitiveHalfSizeAverage
+ 
+ 	| in inW inH out outW outH srcX srcY dstX dstY dstW dstH srcIndex dstIndex pixel r g b |
+ 	self export: true.
+ 	self var: 'in' declareC: 'int *in'.
+ 	self var: 'out' declareC: 'int *out'.
+ 
+ 	in := self checkedUnsignedIntPtrOf: (interpreterProxy stackValue: 11).
+ 	inW := interpreterProxy stackIntegerValue: 10.
+ 	inH := interpreterProxy stackIntegerValue: 9.
+ 	out := self checkedUnsignedIntPtrOf: (interpreterProxy stackValue: 8).
+ 	outW := interpreterProxy stackIntegerValue: 7.
+ 	outH := interpreterProxy stackIntegerValue: 6.
+ 	srcX := interpreterProxy stackIntegerValue: 5.
+ 	srcY := interpreterProxy stackIntegerValue: 4.
+ 	dstX := interpreterProxy stackIntegerValue: 3.
+ 	dstY := interpreterProxy stackIntegerValue: 2.
+ 	dstW := interpreterProxy stackIntegerValue: 1.
+ 	dstH := interpreterProxy stackIntegerValue: 0.
+ 
+ 	interpreterProxy success: (srcX >= 0) & (srcY >= 0).
+ 	interpreterProxy success: (srcX + (2 * dstW)) <= inW.
+ 	interpreterProxy success: (srcY + (2 * dstH)) <= inH.
+ 	interpreterProxy success: (dstX >= 0) & (dstY >= 0).
+ 	interpreterProxy success: (dstX + dstW) <= outW.
+ 	interpreterProxy success: (dstY + dstH) <= outH.
+ 	interpreterProxy failed ifTrue: [^ nil].
+ 
+ 	0 to: dstH - 1 do: [:y |
+ 		srcIndex := (inW * (srcY + (2 * y))) + srcX.
+ 		dstIndex := (outW * (dstY + y)) + dstX.
+ 		0 to: dstW - 1 do: [:x |
+ 			pixel := in at: srcIndex.
+ 			r := pixel bitAnd: 16rFF0000.
+ 			g := pixel bitAnd: 16rFF00.
+ 			b := pixel bitAnd: 16rFF.
+ 
+ 			pixel := in at: srcIndex + 1.
+ 			r := r + (pixel bitAnd: 16rFF0000).
+ 			g := g + (pixel bitAnd: 16rFF00).
+ 			b := b + (pixel bitAnd: 16rFF).
+ 
+ 			pixel := in at: srcIndex + inW.
+ 			r := r + (pixel bitAnd: 16rFF0000).
+ 			g := g + (pixel bitAnd: 16rFF00).
+ 			b := b + (pixel bitAnd: 16rFF).
+ 
+ 			pixel := in at: srcIndex + inW + 1.
+ 			r := r + (pixel bitAnd: 16rFF0000).
+ 			g := g + (pixel bitAnd: 16rFF00).
+ 			b := b + (pixel bitAnd: 16rFF).
+ 
+ 			"store combined RGB into target bitmap"
+ 			out at: dstIndex put:
+ 				(((r bitShift: -2) bitAnd: 16rFF0000) bitOr:
+ 				(((g bitShift: -2) bitAnd: 16rFF00) bitOr: (b bitShift: -2))).
+ 
+ 			srcIndex := srcIndex + 2.
+ 			dstIndex := dstIndex + 1]].
+ 
+ 	interpreterProxy pop: 12.  "pop args, leave rcvr on stack"
+ 	^ 0
+ !

Item was added:
+ ----- Method: ScratchPlugin>>primitiveHalfSizeDiagonal (in category 'scaling') -----
+ primitiveHalfSizeDiagonal
+ 
+ 	| in inW inH out outW outH srcX srcY dstX dstY dstW dstH srcIndex dstIndex p1 p2 r g b |
+ 	self export: true.
+ 	self var: 'in' declareC: 'int *in'.
+ 	self var: 'out' declareC: 'int *out'.
+ 
+ 	in := self checkedUnsignedIntPtrOf: (interpreterProxy stackValue: 11).
+ 	inW := interpreterProxy stackIntegerValue: 10.
+ 	inH := interpreterProxy stackIntegerValue: 9.
+ 	out := self checkedUnsignedIntPtrOf: (interpreterProxy stackValue: 8).
+ 	outW := interpreterProxy stackIntegerValue: 7.
+ 	outH := interpreterProxy stackIntegerValue: 6.
+ 	srcX := interpreterProxy stackIntegerValue: 5.
+ 	srcY := interpreterProxy stackIntegerValue: 4.
+ 	dstX := interpreterProxy stackIntegerValue: 3.
+ 	dstY := interpreterProxy stackIntegerValue: 2.
+ 	dstW := interpreterProxy stackIntegerValue: 1.
+ 	dstH := interpreterProxy stackIntegerValue: 0.
+ 
+ 	interpreterProxy success: (srcX >= 0) & (srcY >= 0).
+ 	interpreterProxy success: (srcX + (2 * dstW)) <= inW.
+ 	interpreterProxy success: (srcY + (2 * dstH)) <= inH.
+ 	interpreterProxy success: (dstX >= 0) & (dstY >= 0).
+ 	interpreterProxy success: (dstX + dstW) <= outW.
+ 	interpreterProxy success: (dstY + dstH) <= outH.
+ 	interpreterProxy failed ifTrue: [^ nil].
+ 
+ 	0 to: dstH - 1 do: [:y |
+ 		srcIndex := (inW * (srcY + (2 * y))) + srcX.
+ 		dstIndex := (outW * (dstY + y)) + dstX.
+ 		0 to: dstW - 1 do: [:x |
+ 			p1 := in at: srcIndex.
+ 			p2 := in at: srcIndex + inW + 1.
+ 
+ 			r := (((p1 bitAnd: 16rFF0000) + (p2 bitAnd: 16rFF0000)) bitShift: -1) bitAnd: 16rFF0000.
+ 			g := (((p1 bitAnd: 16rFF00) + (p2 bitAnd: 16rFF00)) bitShift: -1) bitAnd: 16rFF00.
+ 			b := ((p1 bitAnd: 16rFF) + (p2 bitAnd: 16rFF)) bitShift: -1.
+ 
+ 			"store combined RGB into target bitmap"
+ 			out at: dstIndex put: (r bitOr: (g bitOr: b)).
+ 
+ 			srcIndex := srcIndex + 2.
+ 			dstIndex := dstIndex + 1]].
+ 
+ 	interpreterProxy pop: 12.  "pop args, leave rcvr on stack"
+ 	^ 0
+ !

Item was added:
+ ----- Method: ScratchPlugin>>primitiveHueShift (in category 'hsv filters') -----
+ primitiveHueShift
+ 
+ 	| inOop outOop shift in sz out pix r g b max min brightness saturation hue |
+ 	self export: true.
+ 	self var: 'in' declareC: 'unsigned int *in'.
+ 	self var: 'out' declareC: 'unsigned int *out'.
+ 
+ 	inOop := interpreterProxy stackValue: 2.
+ 	outOop := interpreterProxy stackValue: 1.
+ 	shift := interpreterProxy stackIntegerValue: 0.
+ 	in := self checkedUnsignedIntPtrOf: inOop.
+ 	sz := interpreterProxy stSizeOf: inOop.
+ 	out := self checkedUnsignedIntPtrOf: outOop.
+ 	interpreterProxy success: ((interpreterProxy stSizeOf: outOop) = sz).
+ 	interpreterProxy failed ifTrue: [^ nil].
+ 
+ 	0 to: sz - 1 do: [:i |
+ 		pix := (in at: i) bitAnd: 16rFFFFFF.
+ 		pix = 0 ifFalse: [  "skip pixel values of 0 (transparent)"
+ 			r := (pix bitShift: -16) bitAnd: 16rFF.
+ 			g := (pix bitShift: -8) bitAnd: 16rFF.
+ 			b := pix bitAnd: 16rFF.
+ 
+ 			"find min and max color components"
+ 			max := min := r.
+ 			g > max ifTrue: [max := g].
+ 			b > max ifTrue: [max := b].
+ 			g < min ifTrue: [min := g].
+ 			b < min ifTrue: [min := b].
+ 
+ 			"find current brightness (v) and  saturation with range 0 to 1000"
+ 			brightness := (max * 1000) // 255.
+ 			max = 0 ifTrue: [saturation := 0] ifFalse: [saturation := ((max - min) * 1000) // max].
+ 
+ 			brightness < 110 ifTrue: [					"force black to a very dark, saturated gray"
+ 				brightness := 110. saturation := 1000].	
+ 			saturation < 90 ifTrue: [saturation := 90].		"force a small color change on grays"
+ 			((brightness = 110) | (saturation = 90))		"tint all blacks and grays the same"
+ 				ifTrue: [hue := 0]
+ 				ifFalse: [hue := self hueFromR: r G: g B: b min: min max: max].
+ 
+ 			hue := (hue + shift + 360000000) \\ 360.  "compute new hue"
+ 			self bitmap: out at: i putH: hue s: saturation v: brightness]].
+ 
+ 	interpreterProxy pop: 3.  "pop args, leave rcvr on stack"
+ 	^ 0
+ !

Item was added:
+ ----- Method: ScratchPlugin>>primitiveInterpolate (in category 'bilinear interpolation') -----
+ primitiveInterpolate
+ 
+ 	| inOop xFixed yFixed width in sz result |
+ 	self export: true.
+ 	self var: 'in' declareC: 'unsigned int *in'.
+ 
+ 	inOop := interpreterProxy stackValue: 3.
+ 	width := interpreterProxy stackIntegerValue: 2.
+ 	xFixed := interpreterProxy stackIntegerValue: 1.
+ 	yFixed := interpreterProxy stackIntegerValue: 0.
+ 	in := self checkedUnsignedIntPtrOf: inOop.
+ 	sz := interpreterProxy stSizeOf: inOop.
+ 	interpreterProxy failed ifTrue: [^ nil].
+ 
+ 	result := self interpolatedFrom: in x: xFixed y: yFixed width: width height: sz // width.
+ 
+ 	interpreterProxy pop: 5.  "pop args and rcvr"
+ 	interpreterProxy pushInteger: result.
+ 	^ 0
+ !

Item was added:
+ ----- Method: ScratchPlugin>>primitiveIsHidden (in category 'os functions') -----
+ primitiveIsHidden
+ 	"Answer true if the file or folder with the given path should be hidden from the user. On Windows, this is the value of the 'hidden' file property."
+ 
+ 	| pathOop src count fullPath result |
+ 	self export: true.
+ 	self var: 'fullPath' declareC: 'char fullPath[1000]'.
+ 	self var: 'src' declareC: 'char * src'.
+ 
+ 	pathOop := interpreterProxy stackValue: 0.
+ 
+ 	((interpreterProxy isIntegerObject: pathOop) or:
+ 	 [(interpreterProxy isBytes: pathOop) not]) ifTrue: [
+ 		interpreterProxy success: false].
+ 
+ 	interpreterProxy failed ifTrue: [^ 0].
+ 
+ 	src := self cCoerce: (interpreterProxy firstIndexableField: pathOop) to: 'char *'.
+ 	count := interpreterProxy stSizeOf: pathOop.
+ 	count >= 1000 ifTrue: [interpreterProxy success: false. ^ 0].
+ 	0 to: count - 1 do: [:i | fullPath at: i put: (src at: i)].
+ 	fullPath at: count put: 0.
+ 
+ 	result := self cCode: 'IsFileOrFolderHidden(fullPath)'.
+ 
+ 	interpreterProxy pop: 2.  "pop arg and rcvr"
+ 	interpreterProxy pushBool: result ~= 0.  "push result"
+ 	^ 0
+ 
+ !

Item was added:
+ ----- Method: ScratchPlugin>>primitiveOpenURL (in category 'os functions') -----
+ primitiveOpenURL
+ 	"Open a web browser on the given URL."
+ 
+ 	| urlStr src urlOop count |
+ 	self export: true.
+ 	self var: 'urlStr' declareC: 'char urlStr[2000]'.
+ 	self var: 'src' declareC: 'char * src'.
+ 
+ 	urlOop := interpreterProxy stackValue: 0.
+ 
+ 	((interpreterProxy isIntegerObject: urlOop) or:
+ 	 [(interpreterProxy isBytes: urlOop) not]) ifTrue: [
+ 		interpreterProxy success: false].
+ 
+ 	interpreterProxy failed ifTrue: [^ 0].
+ 
+ 	src := self cCoerce: (interpreterProxy firstIndexableField: urlOop) to: 'char *'.
+ 	count := interpreterProxy stSizeOf: urlOop.
+ 	count >= 2000 ifTrue: [interpreterProxy success: false. ^ 0].
+ 	0 to: count - 1 do: [:i | urlStr at: i put: (src at: i)].
+ 	urlStr at: count put: 0.
+ 
+ 	self cCode: 'OpenURL(urlStr)'.
+ 
+ 	interpreterProxy pop: 1.  "pop arg, leave rcvr on stack"
+ 	^ 0
+ 
+ !

Item was added:
+ ----- Method: ScratchPlugin>>primitiveSaturationShift (in category 'hsv filters') -----
+ primitiveSaturationShift
+ 
+ 	| inOop outOop shift in sz out pix r g b max min brightness saturation hue |
+ 	self export: true.
+ 	self var: 'in' declareC: 'unsigned int *in'.
+ 	self var: 'out' declareC: 'unsigned int *out'.
+ 
+ 	inOop := interpreterProxy stackValue: 2.
+ 	outOop := interpreterProxy stackValue: 1.
+ 	shift := interpreterProxy stackIntegerValue: 0.
+ 	in := self checkedUnsignedIntPtrOf: inOop.
+ 	sz := interpreterProxy stSizeOf: inOop.
+ 	out := self checkedUnsignedIntPtrOf: outOop.
+ 	interpreterProxy success: ((interpreterProxy stSizeOf: outOop) = sz).
+ 	interpreterProxy failed ifTrue: [^ nil].
+ 
+ 	0 to: sz - 1 do: [:i |
+ 		pix := (in at: i) bitAnd: 16rFFFFFF.
+ 		pix < 2 ifFalse: [  "skip pixel values of 0 (transparent) and 1 (black)"
+ 			r := (pix bitShift: -16) bitAnd: 16rFF.
+ 			g := (pix bitShift: -8) bitAnd: 16rFF.
+ 			b := pix bitAnd: 16rFF.
+ 
+ 			"find min and max color components"
+ 			max := min := r.
+ 			g > max ifTrue: [max := g].
+ 			b > max ifTrue: [max := b].
+ 			g < min ifTrue: [min := g].
+ 			b < min ifTrue: [min := b].
+ 
+ 			"find current brightness (v) and  saturation with range 0 to 1000"
+ 			brightness := (max * 1000) // 255.
+ 			max = 0 ifTrue: [saturation := 0] ifFalse: [saturation := ((max - min) * 1000) // max].
+ 
+ 			saturation > 0 ifTrue: [  "do nothing if pixel is unsaturated (gray)"
+ 				hue := self hueFromR: r G: g B: b min: min max: max.
+ 
+ 				"compute new saturation"
+ 				saturation := saturation + (shift * 10).
+ 				saturation > 1000 ifTrue: [saturation := 1000].
+ 				saturation < 0 ifTrue: [saturation := 0].
+ 				self bitmap: out at: i putH: hue s: saturation v: brightness]]].
+ 
+ 	interpreterProxy pop: 3.  "pop args, leave rcvr on stack"
+ 	^ 0
+ !

Item was added:
+ ----- Method: ScratchPlugin>>primitiveScale (in category 'scaling') -----
+ primitiveScale
+ 	"Scale using bilinear interpolation."
+ 
+ 	| inOop inW inH outOop outW outH in out inX inY xIncr yIncr outPix w1 w2 w3 w4 t p1 p2 p3 p4 tWeight |
+ 	self export: true.
+ 	self var: 'in' declareC: 'int *in'.
+ 	self var: 'out' declareC: 'int *out'.
+ 
+ 	inOop := interpreterProxy stackValue: 5.
+ 	inW := interpreterProxy stackIntegerValue: 4.
+ 	inH := interpreterProxy stackIntegerValue: 3.
+ 	outOop := interpreterProxy stackValue: 2.
+ 	outW := interpreterProxy stackIntegerValue: 1.
+ 	outH := interpreterProxy stackIntegerValue: 0.
+ 
+ 	interpreterProxy success: (interpreterProxy stSizeOf: inOop) = (inW * inH).
+ 	interpreterProxy success: (interpreterProxy stSizeOf: outOop) = (outW * outH).
+ 	in := self checkedUnsignedIntPtrOf: inOop.
+ 	out := self checkedUnsignedIntPtrOf: outOop.
+ 	interpreterProxy failed ifTrue: [^ nil].
+ 
+ 	inX := inY := 0.					"source x and y, scaled by 1024"
+ 	xIncr := (inW * 1024) // outW.	"source x increment, scaled by 1024"
+ 	yIncr := (inH * 1024) // outH.		"source y increment, scaled by 1024"
+ 
+ 	0 to: (outH - 1) do: [:outY |
+ 		inX := 0.
+ 		0 to: (outW - 1) do: [:outX |
+ 			"compute weights, scaled by 2^20"
+ 			w1 := (1024 - (inX bitAnd: 1023))	* (1024 - (inY bitAnd: 1023)).
+ 			w2 := (inX bitAnd: 1023)			* (1024 - (inY bitAnd: 1023)).
+ 			w3 := (1024 - (inX bitAnd: 1023))	* (inY bitAnd: 1023).
+ 			w4 := (inX bitAnd: 1023)			* (inY bitAnd: 1023).
+ 
+ 			"get source pixels"
+ 			t := ((inY >> 10) * inW) + (inX >> 10).
+ 			p1 := in at: t.
+ 			((inX >> 10) < (inW - 1)) ifTrue: [p2 := in at: t + 1] ifFalse: [p2 := p1].
+ 			(inY >> 10) < (inH - 1) ifTrue: [t := t + inW].  "next row"
+ 			p3 := in at: t.
+ 			((inX >> 10) < (inW - 1)) ifTrue: [p4 := in at: t + 1] ifFalse: [p4 := p3].
+ 
+ 			"deal with transparent pixels"
+ 			tWeight := 0.
+ 			p1 = 0 ifTrue: [p1 := p2. tWeight := tWeight + w1].
+ 			p2 = 0 ifTrue: [p2 := p1. tWeight := tWeight + w2].
+ 			p3 = 0 ifTrue: [p3 := p4. tWeight := tWeight + w3].
+ 			p4 = 0 ifTrue: [p4 := p3. tWeight := tWeight + w4].
+ 			p1 = 0 ifTrue: [p1 := p3. p2 := p4].  "both top pixels were transparent; use bottom row"
+ 			p3 = 0 ifTrue: [p3 := p1. p4 := p2].  "both bottom pixels were transparent; use top row"
+ 
+ 			outPix := 0.
+ 			tWeight < 500000 ifTrue: [  "compute an (opaque) output pixel if less than 50% transparent"
+ 				t := (w1 * ((p1 >> 16) bitAnd: 255)) + (w2 * ((p2 >> 16) bitAnd: 255)) + (w3 * ((p3 >> 16) bitAnd: 255)) + (w4 * ((p4 >> 16) bitAnd: 255)).
+ 				outPix := ((t >> 20) bitAnd: 255) << 16.
+ 				t := (w1 * ((p1 >> 8) bitAnd: 255)) + (w2 * ((p2 >> 8) bitAnd: 255)) + (w3 * ((p3 >> 8) bitAnd: 255)) + (w4 * ((p4 >> 8) bitAnd: 255)).
+ 				outPix := outPix bitOr: (((t >> 20) bitAnd: 255) << 8).
+ 				t := (w1 * (p1 bitAnd: 255)) + (w2 * (p2 bitAnd: 255)) + (w3 * (p3 bitAnd: 255)) + (w4 * (p4 bitAnd: 255)).
+ 				outPix := outPix bitOr: ((t >> 20) bitAnd: 255).
+ 				outPix = 0 ifTrue: [outPix := 1]].
+ 
+ 			out at: (outY * outW) + outX put: outPix.
+ 			inX := inX + xIncr].
+ 		inY := inY + yIncr].
+ 
+ 	interpreterProxy pop: 6.  "pop args, leave rcvr on stack"
+ 	^ 0
+ !

Item was added:
+ ----- Method: ScratchPlugin>>primitiveSetUnicodePasteBuffer (in category 'os functions') -----
+ primitiveSetUnicodePasteBuffer
+ 	"Set the Mac OS X Unicode paste buffer."
+ 
+ 	| utf16 strOop count |
+ 	self export: true.
+ 	self var: 'utf16' declareC: 'short int *utf16'.
+ 
+ 	strOop := interpreterProxy stackValue: 0.
+ 
+ 	((interpreterProxy isIntegerObject: strOop) or:
+ 	 [(interpreterProxy isBytes: strOop) not]) ifTrue: [
+ 		interpreterProxy success: false].
+ 
+ 	interpreterProxy failed ifTrue: [^ 0].
+ 
+ 	utf16 := self cCoerce: (interpreterProxy firstIndexableField: strOop) to: 'short int *'.
+ 	count := interpreterProxy stSizeOf: strOop.
+ 
+ 	self cCode: 'SetUnicodePasteBuffer(utf16, count)'.
+ 
+ 	interpreterProxy pop: 1.  "pop arg, leave rcvr on stack"
+ 	^ 0
+ 
+ !

Item was added:
+ ----- Method: ScratchPlugin>>primitiveSetWindowTitle (in category 'os functions') -----
+ primitiveSetWindowTitle
+ 	"Set the title of the Scratch window."
+ 
+ 	| titleStr src titleOop count |
+ 	self export: true.
+ 	self var: 'titleStr' declareC: 'char titleStr[1000]'.
+ 	self var: 'src' declareC: 'char * src'.
+ 
+ 	titleOop := interpreterProxy stackValue: 0.
+ 
+ 	((interpreterProxy isIntegerObject: titleOop) or:
+ 	 [(interpreterProxy isBytes: titleOop) not]) ifTrue: [
+ 		interpreterProxy success: false].
+ 
+ 	interpreterProxy failed ifTrue: [^ 0].
+ 
+ 	src := self cCoerce: (interpreterProxy firstIndexableField: titleOop) to: 'char *'.
+ 	count := interpreterProxy stSizeOf: titleOop.
+ 	count >= 1000 ifTrue: [interpreterProxy success: false. ^ 0].
+ 	0 to: count - 1 do: [:i | titleStr at: i put: (src at: i)].
+ 	titleStr at: count put: 0.
+ 
+ 	self cCode: 'SetScratchWindowTitle(titleStr)'.
+ 
+ 	interpreterProxy pop: 1.  "pop arg, leave rcvr on stack"
+ 	^ 0
+ 
+ !

Item was added:
+ ----- Method: ScratchPlugin>>primitiveShortToLongPath (in category 'os functions') -----
+ primitiveShortToLongPath
+ 	"On Windows, convert a short file/path name into a long one. Fail on other platforms."
+ 
+ 	| shortPath longPath ptr shortPathOop result count resultOop |
+ 	self export: true.
+ 	self var: 'shortPath' declareC: 'char shortPath[1000]'.
+ 	self var: 'longPath' declareC: 'char longPath[1000]'.
+ 	self var: 'ptr' declareC: 'char * ptr'.
+ 
+ 	shortPathOop := interpreterProxy stackValue: 0.
+ 
+ 	((interpreterProxy isIntegerObject: shortPathOop) or:
+ 	 [(interpreterProxy isBytes: shortPathOop) not]) ifTrue: [
+ 		interpreterProxy success: false. ^ 0].
+ 
+ 	ptr := self cCoerce: (interpreterProxy firstIndexableField: shortPathOop) to: 'char *'.
+ 	count := interpreterProxy stSizeOf: shortPathOop.
+ 	count >= 1000 ifTrue: [interpreterProxy success: false. ^ 0].
+ 	0 to: count - 1 do: [:i | shortPath at: i put: (ptr at: i)].
+ 	shortPath at: count put: 0.
+ 
+ 	result := self cCode: 'WinShortToLongPath(shortPath, longPath, 1000)'.
+ 	result = -1 ifTrue: [interpreterProxy success: false. ^ 0].
+ 
+ 	count := self cCode: 'strlen(longPath)'.
+ 	resultOop := interpreterProxy instantiateClass: interpreterProxy classString indexableSize: count.
+ 	ptr := self cCoerce: (interpreterProxy firstIndexableField: resultOop) to: 'char *'.
+ 	0 to: count - 1 do: [:i | ptr at: i put: (longPath at: i)].
+ 
+ 	interpreterProxy pop: 2 thenPush: resultOop.  "pop arg and rcvr, push result"
+ 	^ 0
+ !

Item was added:
+ ----- Method: ScratchPlugin>>primitiveWaterRipples1 (in category 'other filters') -----
+ primitiveWaterRipples1
+  
+ 	| in out aArray bArray ripply temp pix dx dy dist inOop outOop width allPix aArOop bArOop height t1 blops x y power val val2 dx2 dy2 newLoc |
+ 	self export: true.
+ 	self var: 'in' declareC: 'unsigned int *in'.
+ 	self var: 'out' declareC: 'unsigned int *out'.
+ 	self var: 'aArray' declareC: 'double *aArray'.
+ 	self var: 'bArray' declareC: 'double *bArray'.
+ 	self var: 'ripply' declareC: 'int ripply'.
+ 	self var: 'temp' declareC: 'double temp'.
+ 	self var: 'pix' declareC: 'unsigned int pix'.
+ 	self var: 'dist' declareC: 'double dist'.
+ 	self var: 'dx2' declareC: 'double dx2'.
+ 	self var: 'dy2' declareC: 'double dy2'.
+ 
+ 	inOop := interpreterProxy stackValue: 5.
+ 	outOop := interpreterProxy stackValue: 4.
+ 	width := interpreterProxy stackIntegerValue: 3.
+ 	in := self checkedUnsignedIntPtrOf: inOop.
+ 	out := self checkedUnsignedIntPtrOf: outOop.
+ 	allPix := interpreterProxy stSizeOf: inOop.
+ 	ripply := interpreterProxy stackIntegerValue: 2.
+ 	aArOop := interpreterProxy stackValue: 1.
+ 	bArOop := interpreterProxy stackValue: 0.
+ 	aArray := self checkedFloatPtrOf: aArOop.
+ 	bArray := self checkedFloatPtrOf: bArOop.
+ 	interpreterProxy success: ((interpreterProxy stSizeOf: outOop) = allPix).
+ 	interpreterProxy failed ifTrue: [^ nil].
+ 
+ 	height := allPix // width.
+ 
+ 	t1 := self cCode: 'rand()'.
+ 	blops := t1 \\ ripply -1.
+ 	0 to: blops /2-1 do: [:t |
+ 		t1 := self cCode: 'rand()'.
+ 		x := t1 \\ width.
+ 		t1 := self cCode: 'rand()'.
+ 		y := t1 \\ height.
+ 		t1 := self cCode: 'rand()'.
+ 		power := t1 \\ 8.
+ 		-4 to: 4 do: [:g |
+ 			-4 to: 4 do: [:h |
+ 				dist := ((g*g) + (h*h)) asFloat.
+ 				((dist < 25) and: [dist > 0]) ifTrue: [
+ 						dx := (x + g) asInteger.
+ 						dy := (y + h) asInteger.
+ 						((dx >0) and: [(dy>0) and: [(dy < height) and: [dx < width]]]) ifTrue: [
+ 							aArray at: ((dy)*width + dx) put: (power *(1.0 asFloat -(dist/(25.0 asFloat))) asFloat).
+ 						].
+ 					].
+ 				].
+ 			].
+ 		].
+ 	
+ 		1 to: width -2 do: [:f |
+ 			1 to: height -2 do: [:d |
+ 			val := (d)*width + f.
+ 			aArray at: val put: (((
+ 				(bArray at: (val+1)) + (bArray at: (val-1)) + (bArray at: (val + width)) + (bArray at: (val - width)) +
+ 				((bArray at: (val -1 -width))/2) + ((bArray at: (val-1+width))/2) + ((bArray at: (val+1-width))/2) + ((bArray at: (val+1+width))/2)) /4) - (aArray at: (val))).
+ 			aArray at: (val) put: ((aArray at: (val))*(0.9 asFloat)).
+ 			].
+ 		].
+ 	
+ 		"temp := bArray.
+ 		bArray := aArray.
+ 		aArray := temp."
+ 		0 to: width*height do: [:q |
+ 			temp := bArray at: q.
+ 			bArray at: q put: (aArray at: q).
+ 			aArray at: q put: temp.
+ 		].
+ 
+ 		0 to: height-1 do: [:j |
+ 			0 to: width-1 do: [:i |
+ 				((i > 1) and: [(i<(width-1)) and: [(j>1) and: [(j<(height-1))]]]) ifTrue: [
+ 					val2 := (j)*width + i.
+ 					dx2 := ((((aArray at: (val2)) - (aArray at: (val2-1))) + ((aArray at: (val2+1)) - (aArray at: (val2)))) *64) asFloat.
+ 					dy2 := ((((aArray at: (val2)) - (aArray at: (val2-width))) + ((aArray at: (val2+width)) - (aArray at: (val2)))) /64) asFloat.
+ 					(dx2<-2) ifTrue: [dx2 := -2].
+ 					(dx2>2) ifTrue: [dx2 := 2].
+ 					(dy2<-2) ifTrue: [dy2 := -2].
+ 					(dy2>2) ifTrue: [dy2 := 2].
+ 					newLoc := ((j+dy2)*width + (i+dx2)) asInteger.
+ 					((newLoc < (width*height)) and: [newLoc >=0]) ifTrue: [
+ 						pix := in at: newLoc]
+ 					ifFalse: [
+ 						pix := in at: (i +(j*width)) ].
+ 				]
+ 				ifFalse: [
+ 					pix := in at: (i +(j*width)) ].
+ 			out at: (i + (j*width)) put: pix.
+ 		]].
+ 
+ 	interpreterProxy pop: 6.  "pop args, leave rcvr on stack"
+ 	^ 0
+ !

Item was added:
+ ----- Method: ScratchPlugin>>primitiveWhirl (in category 'other filters') -----
+ primitiveWhirl
+ 
+ 	| inOop outOop width degrees in out sz height centerX centerY radius scaleX scaleY whirlRadians radiusSquared dx dy d factor ang sina cosa pix |
+ 	self export: true.
+ 	self var: 'in' declareC: 'unsigned int *in'.
+ 	self var: 'out' declareC: 'unsigned int *out'.
+ 	self var: 'scaleX' declareC: 'double scaleX'.
+ 	self var: 'scaleY' declareC: 'double scaleY'.
+ 	self var: 'whirlRadians' declareC: 'double whirlRadians'.
+ 	self var: 'radiusSquared' declareC: 'double radiusSquared'.
+ 	self var: 'dx' declareC: 'double dx'.
+ 	self var: 'dy' declareC: 'double dy'.
+ 	self var: 'd' declareC: 'double d'.
+ 	self var: 'factor' declareC: 'double factor'.
+ 	self var: 'ang' declareC: 'double ang'.
+ 	self var: 'sina' declareC: 'double sina'.
+ 	self var: 'cosa' declareC: 'double cosa'.
+ 
+ 	inOop := interpreterProxy stackValue: 3.
+ 	outOop := interpreterProxy stackValue: 2.
+ 	width := interpreterProxy stackIntegerValue: 1.
+ 	degrees := interpreterProxy stackIntegerValue: 0.
+ 	in := self checkedUnsignedIntPtrOf: inOop.
+ 	out := self checkedUnsignedIntPtrOf: outOop.
+ 	sz := interpreterProxy stSizeOf: inOop.
+ 	interpreterProxy success: ((interpreterProxy stSizeOf: outOop) = sz).
+ 	interpreterProxy failed ifTrue: [^ nil].
+ 
+ 	"calculate height, center, scales, radius, whirlRadians, and radiusSquared"
+ 	height := sz // width.
+ 	centerX := width // 2.
+ 	centerY := height // 2.
+ 	centerX < centerY
+ 		ifTrue: [
+ 			radius := centerX.
+ 			scaleX := centerY asFloat / centerX. 
+ 			scaleY := 1.0]
+ 		ifFalse: [
+ 			radius := centerY.
+ 			scaleX := 1.0.
+ 			centerY < centerX
+ 				ifTrue: [scaleY := centerX asFloat / centerY]
+ 				ifFalse: [scaleY := 1.0]].
+ 	whirlRadians := (-3.141592653589793 * degrees) / 180.0.
+ 	radiusSquared := (radius * radius) asFloat.
+ 
+ 	0 to: width - 1 do: [:x |
+ 		0 to: height - 1 do: [:y |
+ 			dx := scaleX * (x - centerX) asFloat.
+ 			dy := scaleY * (y - centerY) asFloat.
+ 			d := (dx * dx) + (dy * dy).
+ 			d < radiusSquared ifTrue: [  "inside the whirl circle"
+ 				factor := 1.0 - (d sqrt / radius).
+ 				ang := whirlRadians * (factor * factor).
+ 				sina := ang sin.
+ 				cosa := ang cos.
+ 				pix := self interpolatedFrom: in
+ 					x: (1024.0 * ((((cosa * dx) - (sina * dy)) / scaleX) + centerX)) asInteger
+ 					y: (1024.0 * ((((sina * dx) + (cosa * dy)) / scaleY) + centerY)) asInteger
+ 					width: width
+ 					height: height.
+ 				out at: ((width * y) + x "for Squeak: + 1") put: pix]]].
+ 
+ 	interpreterProxy pop: 4.  "pop args, leave rcvr on stack"
+ 	^ 0
+ !

Item was changed:
  ----- Method: SimpleStackBasedCogit class>>initializePrimitiveTableForSqueakV3 (in category 'class initialization') -----
  initializePrimitiveTableForSqueakV3
  	"Initialize the table of primitive generators.  This does not include normal primitives implemened in the coInterpreter."
  	"SimpleStackBasedCogit initializePrimitiveTableForSqueakV3"
  	MaxCompiledPrimitiveIndex := 222.
  	primitiveTable := CArrayAccessor on: (Array new: MaxCompiledPrimitiveIndex + 1).
  	self table: primitiveTable from: 
  	#(	"Integer Primitives (0-19)"
  		(1 genPrimitiveAdd				1)
  		(2 genPrimitiveSubtract			1)
  		(3 genPrimitiveLessThan		1)
  		(4 genPrimitiveGreaterThan		1)
  		(5 genPrimitiveLessOrEqual		1)
  		(6 genPrimitiveGreaterOrEqual	1)
  		(7 genPrimitiveEqual			1)
  		(8 genPrimitiveNotEqual		1)
  		(9 genPrimitiveMultiply			1	processorHasMultiply:)
  		(10 genPrimitiveDivide			1	processorHasDivQuoRem:)
  		(11 genPrimitiveMod			1	processorHasDivQuoRem:)
  		(12 genPrimitiveDiv				1	processorHasDivQuoRem:)
  		(13 genPrimitiveQuo			1	processorHasDivQuoRem:)
  		(14 genPrimitiveBitAnd			1)
  		(15 genPrimitiveBitOr			1)
  		(16 genPrimitiveBitXor			1)
  		(17 genPrimitiveBitShift			1)
  		"(18 primitiveMakePoint)"
  		"(19 primitiveFail)"					"Guard primitive for simulation -- *must* fail"
  
  		"LargeInteger Primitives (20-39)"
  		"(20 primitiveFail)"
  		"(21 primitiveAddLargeIntegers)"
  		"(22 primitiveSubtractLargeIntegers)"
  		"(23 primitiveLessThanLargeIntegers)"
  		"(24 primitiveGreaterThanLargeIntegers)"
  		"(25 primitiveLessOrEqualLargeIntegers)"
  		"(26 primitiveGreaterOrEqualLargeIntegers)"
  		"(27 primitiveEqualLargeIntegers)"
  		"(28 primitiveNotEqualLargeIntegers)"
  		"(29 primitiveMultiplyLargeIntegers)"
  		"(30 primitiveDivideLargeIntegers)"
  		"(31 primitiveModLargeIntegers)"
  		"(32 primitiveDivLargeIntegers)"
  		"(33 primitiveQuoLargeIntegers)"
  		"(34 primitiveBitAndLargeIntegers)"
  		"(35 primitiveBitOrLargeIntegers)"
  		"(36 primitiveBitXorLargeIntegers)"
  		"(37 primitiveBitShiftLargeIntegers)"
  
  		"Float Primitives (38-59)"
  		"(38 primitiveFloatAt)"
  		"(39 primitiveFloatAtPut)"
  		(40 genPrimitiveAsFloat					0	processorHasDoublePrecisionFloatingPointSupport:)
  		(41 genPrimitiveFloatAdd				1	processorHasDoublePrecisionFloatingPointSupport:)
  		(42 genPrimitiveFloatSubtract			1	processorHasDoublePrecisionFloatingPointSupport:)
  		(43 genPrimitiveFloatLessThan			1	processorHasDoublePrecisionFloatingPointSupport:)
  		(44 genPrimitiveFloatGreaterThan		1	processorHasDoublePrecisionFloatingPointSupport:)
  		(45 genPrimitiveFloatLessOrEqual		1	processorHasDoublePrecisionFloatingPointSupport:)
  		(46 genPrimitiveFloatGreaterOrEqual	1	processorHasDoublePrecisionFloatingPointSupport:)
  		(47 genPrimitiveFloatEqual				1	processorHasDoublePrecisionFloatingPointSupport:)
  		(48 genPrimitiveFloatNotEqual			1	processorHasDoublePrecisionFloatingPointSupport:)
  		(49 genPrimitiveFloatMultiply			1	processorHasDoublePrecisionFloatingPointSupport:)
  		(50 genPrimitiveFloatDivide				1	processorHasDoublePrecisionFloatingPointSupport:)
  		"(51 primitiveTruncated)"
  		"(52 primitiveFractionalPart)"
  		"(53 primitiveExponent)"
  		"(54 primitiveTimesTwoPower)"
  		(55 genPrimitiveFloatSquareRoot		0	processorHasDoublePrecisionFloatingPointSupport:)
  		"(56 primitiveSine)"
  		"(57 primitiveArctan)"
  		"(58 primitiveLogN)"
  		"(59 primitiveExp)"
  
  		"Subscript and Stream Primitives (60-67)"
  		(60 genPrimitiveAt				1)
  		(61 genPrimitiveAtPut			2)
  		(62 genPrimitiveSize			0)
  		(63 genPrimitiveStringAt		1)
  		(64 genPrimitiveStringAtPut		2)
  		"The stream primitives no longer pay their way; normal Smalltalk code is faster."
  		"(65 primitiveFail)""was primitiveNext"
  		"(66 primitiveFail)" "was primitiveNextPut"
  		"(67 primitiveFail)" "was primitiveAtEnd"
  
  		"StorageManagement Primitives (68-79)"
  		"(68 primitiveObjectAt)"
  		"(69 primitiveObjectAtPut)"
  		(70 genPrimitiveNew			0)
  		(71 genPrimitiveNewWithArg	1)
  		"(72 primitiveArrayBecomeOneWay)"		"Blue Book: primitiveBecome"
  		"(73 primitiveInstVarAt)"
  		"(74 primitiveInstVarAtPut)"
  		(75 genPrimitiveIdentityHash	0)
  		"(76 primitiveStoreStackp)"					"Blue Book: primitiveAsObject"
  		"(77 primitiveSomeInstance)"
  		"(78 primitiveNextInstance)"
  		(79 genPrimitiveNewMethod	2)
  
  		"Control Primitives (80-89)"
  		"(80 primitiveFail)"							"Blue Book: primitiveBlockCopy"
  		"(81 primitiveFail)"							"Blue Book: primitiveValue"
  		"(82 primitiveFail)"							"Blue Book: primitiveValueWithArgs"
  		"(83 primitivePerform)"
  		"(84 primitivePerformWithArgs)"
  		"(85 primitiveSignal)"
  		"(86 primitiveWait)"
  		"(87 primitiveResume)"
  		"(88 primitiveSuspend)"
  		"(89 primitiveFlushCache)"
  
  		"Input/Output Primitives (90-109); We won't compile any of these"
  
  		"System Primitives (110-119)"
  		(110 genPrimitiveIdentical 1)
  		(111 genPrimitiveClass)
  		"(112 primitiveBytesLeft)"
  		"(113 primitiveQuit)"
  		"(114 primitiveExitToDebugger)"
  		"(115 primitiveChangeClass)"					"Blue Book: primitiveOopsLeft"
  		"(116 primitiveFlushCacheByMethod)"
  		"(117 primitiveExternalCall)"
  		"(118 primitiveDoPrimitiveWithArgs)"
  		"(119 primitiveFlushCacheSelective)"
  			"Squeak 2.2 and earlier use 119.  Squeak 2.3 and later use 116.
  			Both are supported for backward compatibility."
  
  		"Miscellaneous Primitives (120-127); We won't compile any of these"
  
  		"Squeak Primitives Start Here"
  
  		"Squeak Miscellaneous Primitives (128-149); We won't compile any of these"
  
  		"File Primitives (150-169) - NO LONGER INDEXED; We won't compile any of these"
  		(169 genPrimitiveNotIdentical 1)
  
+ 		(170 genPrimitiveAsCharacter)			"SmallInteger>>asCharacter, Character class>>value:"
+ 		(171 genPrimitiveCharacterValue 0)	"Character>>value"
  		"Sound Primitives (170-199) - NO LONGER INDEXED; We won't compile any of these"
+ 		(175 genPrimitiveIdentityHash	0)		"Behavior>>identityHash"
+ 		"Sound Primitives (170-199) - NO LONGER INDEXED; We won't compile any of these"
  
  		"Old closure primitives"
  		"(186 primitiveFail)" "was primitiveClosureValue"
  		"(187 primitiveFail)" "was primitiveClosureValueWithArgs"
  
  		"Perform method directly"
  		"(188 primitiveExecuteMethodArgsArray)"
  		"(189 primitiveExecuteMethod)"
  
  		"Sound Primitives (continued) - NO LONGER INDEXED; We won't compile any of these"
  		"(190 194 primitiveFail)"
  
  		"Unwind primitives"
  		"(195 primitiveFindNextUnwindContext)"
  		"(196 primitiveTerminateTo)"
  		"(197 primitiveFindHandlerContext)"
  		(198 genFastPrimFail "primitiveMarkUnwindMethod")
  		(199 genFastPrimFail "primitiveMarkHandlerMethod")
  
  		"new closure primitives (were Networking primitives)"
  		"(200 primitiveClosureCopyWithCopiedValues)"
  		(201 genPrimitiveClosureValue	0) "value"
  		(202 genPrimitiveClosureValue	1) "value:"
  		(203 genPrimitiveClosureValue	2) "value:value:"
  		(204 genPrimitiveClosureValue	3) "value:value:value:"
  		(205 genPrimitiveClosureValue	4) "value:value:value:value:"
  		"(206 genPrimitiveClosureValueWithArgs)" "valueWithArguments:"
  
  		"(207 209 primitiveFail)"	"reserved for Cog primitives"
  
  		"(210 primitiveContextAt)"
  		"(211 primitiveContextAtPut)"
  		"(212 primitiveContextSize)"
  		"(213 217 primitiveFail)"	"reserved for Cog primitives"
  		"(218 primitiveDoNamedPrimitiveWithArgs)"
  		"(219 primitiveFail)"	"reserved for Cog primitives"
  
  		"(220 primitiveFail)"		"reserved for Cog primitives"
  
  		(221 genPrimitiveClosureValue	0) "valueNoContextSwitch"
  		(222 genPrimitiveClosureValue	1) "valueNoContextSwitch:"
  
  		"(223 229 primitiveFail)"	"reserved for Cog primitives"
  	)!

Item was added:
+ ----- Method: SimpleStackBasedCogit>>genPrimitiveAsCharacter (in category 'primitive generators') -----
+ genPrimitiveAsCharacter
+ 	| na r |
+ 	na := coInterpreter argumentCountOf: methodObj.
+ 	na <= 1 ifTrue:
+ 		[na = 1 ifTrue:
+ 			[self MoveMw: BytesPerWord r: SPReg R: Arg0Reg].
+ 		 (r := objectRepresentation
+ 				genInnerPrimitiveAsCharacter: 0
+ 				inReg: (na = 0 ifTrue: [ReceiverResultReg] ifFalse: [Arg0Reg])) < 0 ifTrue:
+ 			[^r]].
+ 	^self compileFallbackToInterpreterPrimitive!

Item was added:
+ ----- Method: SimpleStackBasedCogit>>genPrimitiveCharacterValue (in category 'primitive generators') -----
+ genPrimitiveCharacterValue
+ 	| r |
+ 	(r := objectRepresentation genInnerPrimitiveCharacterValue: BytesPerWord) < 0 ifTrue:
+ 		[^r].
+ 	^self compileFallbackToInterpreterPrimitive!

Item was changed:
  ----- Method: SimpleStackBasedCogit>>genPrimitiveIdentical (in category 'primitive generators') -----
  genPrimitiveIdentical
  	"Stack looks like
  		receiver (also in ResultReceiverReg)
  		arg
  		return address"
- 	| jumpFalse |
- 	<var: #jumpFalse type: #'AbstractInstruction *'>
  	self MoveMw: BytesPerWord r: SPReg R: TempReg.
+ 	^objectRepresentation
+ 		genInnerPrimitiveIdentical: BytesPerWord * 2
+ 		orNotIf: false!
- 	self CmpR: TempReg R: ReceiverResultReg.
- 	jumpFalse := self JumpNonZero: 0.
- 	self annotate: (self MoveCw: objectMemory trueObject R: ReceiverResultReg)
- 		objRef: objectMemory trueObject.
- 	self flag: 'currently caller pushes result'.
- 	self RetN: BytesPerWord * 2.
- 	jumpFalse jmpTarget: (self annotate: (self MoveCw: objectMemory falseObject R: ReceiverResultReg)
- 								objRef: objectMemory falseObject).
- 	self RetN: BytesPerWord * 2.
- 	^0!

Item was changed:
  ----- Method: SimpleStackBasedCogit>>genPrimitiveIdentityHash (in category 'primitive generators') -----
  genPrimitiveIdentityHash
+ 	| r |
+ 	(r := objectRepresentation genInnerPrimitiveIdentityHash: BytesPerWord) < 0 ifTrue:
+ 		[^r].
+ 	^self compileFallbackToInterpreterPrimitive!
- 	| jumpSI jumpNotSet |
- 	<var: #jumpSI type: #'AbstractInstruction *'>
- 	<var: #jumpNotSet type: #'AbstractInstruction *'>
- 	self MoveR: ReceiverResultReg R: ClassReg.
- 	jumpSI := objectRepresentation genJumpSmallIntegerInScratchReg: ClassReg.
- 	objectRepresentation genGetHashFieldNonImmOf: ReceiverResultReg asSmallIntegerInto: TempReg.
- 	objectRepresentation isHashSetOnInstanceCreation ifFalse:
- 		[self CmpCq: ConstZero R: TempReg.
- 		 jumpNotSet := self JumpZero: 0].
- 	self MoveR: TempReg R: ReceiverResultReg.
- 	self flag: 'currently caller pushes result'.
- 	self RetN: BytesPerWord.
- 	objectRepresentation isHashSetOnInstanceCreation ifFalse:
- 		[jumpNotSet jmpTarget: self Label.
- 		 self compileFallbackToInterpreterPrimitive].
- 	jumpSI jmpTarget: self Label.
- 	^0!

Item was changed:
  ----- Method: SimpleStackBasedCogit>>genPrimitiveNotIdentical (in category 'primitive generators') -----
  genPrimitiveNotIdentical
  	"Stack looks like
  		receiver (also in ResultReceiverReg)
  		arg
  		return address"
- 	| jumpFalse |
- 	<var: #jumpFalse type: #'AbstractInstruction *'>
  	self MoveMw: BytesPerWord r: SPReg R: TempReg.
+ 	^objectRepresentation
+ 		genInnerPrimitiveIdentical: BytesPerWord * 2
+ 		orNotIf: true!
- 	self CmpR: TempReg R: ReceiverResultReg.
- 	jumpFalse := self JumpZero: 0.
- 	self annotate: (self MoveCw: objectMemory trueObject R: ReceiverResultReg)
- 		objRef: objectMemory trueObject.
- 	self flag: 'currently caller pushes result'.
- 	self RetN: BytesPerWord * 2.
- 	jumpFalse jmpTarget: (self annotate: (self MoveCw: objectMemory falseObject R: ReceiverResultReg)
- 								objRef: objectMemory falseObject).
- 	self RetN: BytesPerWord * 2.
- 	^0!

Item was changed:
  ----- Method: SpurMemoryManager>>isInRangeCharacterCode: (in category 'immediates') -----
  isInRangeCharacterCode: characterCode
+ 	^characterCode between: 0 and: (1 << 30) - 1!
- 	^characterCode >= 0 and: [characterCode < (2 raisedTo: 30)]!

Item was changed:
  ----- Method: SpurMemoryManager>>memory (in category 'accessing') -----
  memory
+ 	<cmacro: '() GIV(memory)'>
- 	<cmacro: '() memory'>
  	^memory!

Item was changed:
  ----- Method: SpurMemoryManager>>startOfMemory (in category 'accessing') -----
  startOfMemory
  	"Return the start of object memory. Use a macro so as not to punish the debug VM."
+ 	<cmacro: '() GIV(memory)'>
- 	<cmacro: '() memory'>
  	<returnTypeC: #usqInt>
  	^0!

Item was changed:
  ----- Method: StackInterpreter>>dumpImage: (in category 'image save/restore') -----
  dumpImage: fileName
  	"Dump the entire image out to the given file. Intended for debugging only."
  	| f dataSize result |
  	<export: true>
  	<var: #f type: 'sqImageFile'>
  
  	f := self cCode: 'sqImageFileOpen(pointerForOop(fileName), "wb")'.
  	f = nil ifTrue: [^-1].
  	dataSize := objectMemory endOfMemory - objectMemory startOfMemory.
+ 	result := self cCode: 'sqImageFileWrite(pointerForOop(memory()), sizeof(unsigned char), dataSize, f)'.
- 	result := self cCode: 'sqImageFileWrite(pointerForOop(memory), sizeof(unsigned char), dataSize, f)'.
  	self cCode: 'sqImageFileClose(f)'.
  	^result
  !

Item was added:
+ ----- Method: StackToRegisterMappingCogit>>genPrimitiveAsCharacter (in category 'primitive generators') -----
+ genPrimitiveAsCharacter
+ 	| na r |
+ 	na := coInterpreter argumentCountOf: methodObj.
+ 	na <= 1 ifTrue:
+ 		[(r := objectRepresentation
+ 				genInnerPrimitiveAsCharacter: 0
+ 				inReg: (na = 0 ifTrue: [ReceiverResultReg] ifFalse: [Arg0Reg])) < 0 ifTrue:
+ 			[^r]].
+ 	^self compileFallbackToInterpreterPrimitive!

Item was added:
+ ----- Method: StackToRegisterMappingCogit>>genPrimitiveCharacterValue (in category 'primitive generators') -----
+ genPrimitiveCharacterValue
+ 	| r |
+ 	(r := objectRepresentation genInnerPrimitiveCharacterValue: 0) < 0 ifTrue:
+ 		[^r].
+ 	^self compileFallbackToInterpreterPrimitive!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genPrimitiveIdentical (in category 'primitive generators') -----
  genPrimitiveIdentical
  	"Receiver and arg in registers.
  	 Stack looks like
  		return address"
+ 	^objectRepresentation
+ 		genInnerPrimitiveIdentical: 0
+ 		orNotIf: false!
- 	| jumpFalse |
- 	<var: #jumpFalse type: #'AbstractInstruction *'>
- 	self CmpR: Arg0Reg R: ReceiverResultReg.
- 	jumpFalse := self JumpNonZero: 0.
- 	self annotate: (self MoveCw: objectMemory trueObject R: ReceiverResultReg)
- 		objRef: objectMemory trueObject.
- 	self RetN: 0.
- 	jumpFalse jmpTarget: (self annotate: (self MoveCw: objectMemory falseObject R: ReceiverResultReg)
- 								objRef: objectMemory falseObject).
- 	self RetN: 0.
- 	^0!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genPrimitiveIdentityHash (in category 'primitive generators') -----
  genPrimitiveIdentityHash
+ 	| r |
+ 	(r := objectRepresentation genInnerPrimitiveIdentityHash: 0) < 0 ifTrue:
+ 		[^r].
+ 	^self compileFallbackToInterpreterPrimitive!
- 	| jumpSI jumpNotSet |
- 	<var: #jumpSI type: #'AbstractInstruction *'>
- 	<var: #jumpNotSet type: #'AbstractInstruction *'>
- 	self MoveR: ReceiverResultReg R: ClassReg.
- 	jumpSI := objectRepresentation genJumpSmallIntegerInScratchReg: ClassReg.
- 	objectRepresentation genGetHashFieldNonImmOf: ReceiverResultReg asSmallIntegerInto: TempReg.
- 	objectRepresentation isHashSetOnInstanceCreation ifFalse:
- 		[self CmpCq: ConstZero R: TempReg.
- 		 jumpNotSet := self JumpZero: 0].
- 	self MoveR: TempReg R: ReceiverResultReg.
- 	self RetN: 0.
- 	objectRepresentation isHashSetOnInstanceCreation ifFalse:
- 		[jumpNotSet jmpTarget: self Label.
- 		 self compileFallbackToInterpreterPrimitive].
- 	jumpSI jmpTarget: self Label.
- 	^0!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genPrimitiveNotIdentical (in category 'primitive generators') -----
  genPrimitiveNotIdentical
  	"Receiver and arg in registers.
  	 Stack looks like
  		return address"
+ 	^objectRepresentation
+ 		genInnerPrimitiveIdentical: 0
+ 		orNotIf: true!
- 	| jumpFalse |
- 	<var: #jumpFalse type: #'AbstractInstruction *'>
- 	self CmpR: Arg0Reg R: ReceiverResultReg.
- 	jumpFalse := self JumpZero: 0.
- 	self annotate: (self MoveCw: objectMemory trueObject R: ReceiverResultReg)
- 		objRef: objectMemory trueObject.
- 	self RetN: 0.
- 	jumpFalse jmpTarget: (self annotate: (self MoveCw: objectMemory falseObject R: ReceiverResultReg)
- 								objRef: objectMemory falseObject).
- 	self RetN: 0.
- 	^0!

Item was added:
+ InterpreterPlugin subclass: #UnicodePlugin
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'VMMaker-Plugins'!
+ 
+ !UnicodePlugin commentStamp: '<historical>' prior: 0!
+ This plugin measures and renders Unicode (UTF8) strings.
+ !

Item was added:
+ ----- Method: UnicodePlugin class>>hasHeaderFile (in category 'translation') -----
+ hasHeaderFile
+ 
+ 	^true!

Item was added:
+ ----- Method: UnicodePlugin>>asCString: (in category 'utility') -----
+ asCString: stringOop
+ 	"Return a C char * pointer into the given Squeak string object."
+ 	"Warning: A Squeak string is not necessarily null-terminated."
+ 	"Warning: the resulting pointer may become invalid after the next garbage collection and should only be using during the current primitive call."
+ 
+ 	self inline: false.
+ 	self returnTypeC: 'char *'.
+ 
+ 	((interpreterProxy isIntegerObject: stringOop) or:
+ 	 [(interpreterProxy isBytes: stringOop) not]) ifTrue: [
+ 		interpreterProxy success: false.
+ 		^ 0].
+ 
+ 	^ self cCoerce: (interpreterProxy firstIndexableField: stringOop) to: 'char *'
+ !

Item was added:
+ ----- Method: UnicodePlugin>>cWordsPtr:minSize: (in category 'utility') -----
+ cWordsPtr: oop minSize: minSize
+ 	"Return a C pointer to the first indexable field of oop, which must be a words object of at least the given size."
+ 	"Warning: the resulting pointer may become invalid after the next garbage collection and should only be using during the current primitive call."
+ 
+ 	self inline: false.
+ 	self returnTypeC: 'void *'.
+ 
+ 	interpreterProxy success:
+ 		((interpreterProxy isIntegerObject: oop) not and:
+ 		 [(interpreterProxy isWords: oop) and:
+ 		 [(interpreterProxy stSizeOf: oop) >= minSize]]).
+ 	interpreterProxy failed ifTrue: [^ 0].
+ 	^ self cCoerce: (interpreterProxy firstIndexableField: oop) to: 'void *'
+ !

Item was added:
+ ----- Method: UnicodePlugin>>copyString:into:max: (in category 'utility') -----
+ copyString: stringOop into: stringPtr max: maxChars
+ 	"Copy the Squeak string into a temporary buffer and add a terminating null byte. Fail if there is not sufficent space in the buffer."
+ 
+ 	| srcPtr count |
+ 	self inline: false.
+ 	self var: 'stringPtr' declareC: 'char *stringPtr'.
+ 	self var: 'srcPtr' declareC: 'char *srcPtr'.
+ 
+ 	((interpreterProxy isIntegerObject: stringOop) or:
+ 	 [(interpreterProxy isBytes: stringOop) not]) ifTrue: [
+ 		interpreterProxy success: false.
+ 		^ 0].
+ 
+ 	count := interpreterProxy stSizeOf: stringOop.
+ 	count < maxChars ifFalse: [
+ 		interpreterProxy success: false.
+ 		^ 0].
+ 
+ 	srcPtr := self cCoerce: (interpreterProxy firstIndexableField: stringOop) to: 'char *'.
+ 	1 to: count do: [:i | self cCode: '*stringPtr++ = *srcPtr++'].
+ 	self cCode: '*stringPtr = 0'.
+ 	^ 0
+ !

Item was added:
+ ----- Method: UnicodePlugin>>primitiveClipboardGet (in category 'primitives') -----
+ primitiveClipboardGet
+ 	"Read the clipboard into the given UTF16 string.."
+ 
+ 	| utf16Oop utf16 utf16Length count |
+ 	self export: true.
+ 	self var: 'utf16' declareC: 'unsigned short *utf16'.
+ 
+ 	utf16Oop := interpreterProxy stackValue: 0.
+ 
+ 	((interpreterProxy isIntegerObject: utf16Oop) or:
+ 	 [(interpreterProxy isWords: utf16Oop) not]) ifTrue: [
+ 		interpreterProxy success: false].
+ 
+ 	interpreterProxy failed ifTrue: [^ 0].
+ 
+ 	utf16 := self cCoerce: (interpreterProxy firstIndexableField: utf16Oop) to: 'unsigned short *'.
+ 	utf16Length := 2 * (interpreterProxy stSizeOf: utf16Oop).
+ 
+ 	count := self cCode: 'unicodeClipboardGet(utf16, utf16Length)'.
+ 
+ 	interpreterProxy pop: 2
+ 		thenPush: (interpreterProxy integerObjectOf: count).
+ 
+ 	^ 0
+ !

Item was added:
+ ----- Method: UnicodePlugin>>primitiveClipboardPut (in category 'primitives') -----
+ primitiveClipboardPut
+ 	"Set the clipboard to a UTF16 string.."
+ 
+ 	| strOop count utf16 utf16Length |
+ 	self export: true.
+ 	self var: 'utf16' declareC: 'unsigned short *utf16'.
+ 
+ 	strOop := interpreterProxy stackValue: 1.
+ 	count := interpreterProxy stackIntegerValue: 0.
+ 
+ 	((interpreterProxy isIntegerObject: strOop) or:
+ 	 [(interpreterProxy isWords: strOop) not]) ifTrue: [
+ 		interpreterProxy success: false].
+ 
+ 	interpreterProxy failed ifTrue: [^ 0].
+ 
+ 	utf16 := self cCoerce: (interpreterProxy firstIndexableField: strOop) to: 'unsigned short *'.
+ 	utf16Length := 2 * (interpreterProxy stSizeOf: strOop).
+ 	((count >= 0) & (count < utf16Length)) ifTrue: [utf16Length := count].
+ 
+ 	self cCode: 'unicodeClipboardPut(utf16, utf16Length)'.
+ 
+ 	interpreterProxy pop: 2.  "pop args, leave rcvr on stack"
+ 	^ 0
+ !

Item was added:
+ ----- Method: UnicodePlugin>>primitiveClipboardSize (in category 'primitives') -----
+ primitiveClipboardSize
+ 
+ 	| count |
+ 	self export: true.
+ 
+ 	count := self cCode: 'unicodeClipboardSize()'.
+ 
+ 	interpreterProxy pop: 1
+ 		thenPush: (interpreterProxy integerObjectOf: count).
+ 	^ 0
+ !

Item was added:
+ ----- Method: UnicodePlugin>>primitiveDrawString (in category 'primitives') -----
+ primitiveDrawString
+ 
+ 	| utf8Oop utf8 w h bitmapOop bitmapPtr utf8Length result |
+ 	self export: true.
+ 	self var: 'utf8' declareC: 'char *utf8'.
+ 	self var: 'bitmapPtr' declareC: 'void *bitmapPtr'.
+ 
+ 	utf8Oop := interpreterProxy stackValue: 3.
+ 	utf8 := self asCString: utf8Oop.
+ 	w := interpreterProxy stackIntegerValue: 2.
+ 	h := interpreterProxy stackIntegerValue: 1.
+ 	bitmapOop := interpreterProxy stackValue: 0.
+ 	bitmapPtr := self cWordsPtr: bitmapOop minSize: w * h.
+ 	interpreterProxy failed ifTrue: [^ nil].
+ 
+ 	utf8Length := interpreterProxy stSizeOf: utf8Oop.
+ 	self cCode: 'unicodeDrawString(utf8, utf8Length, &w, &h, bitmapPtr)'.
+ 
+ 	result := interpreterProxy makePointwithxValue: w yValue: h.
+ 	interpreterProxy pop: 5 thenPush: result.
+ 	^ 0
+ !

Item was added:
+ ----- Method: UnicodePlugin>>primitiveGetFontList (in category 'primitives') -----
+ primitiveGetFontList
+ 
+ 
+ 	| strOop str strLength count |
+ 	self export: true.
+ 	self var: 'str' declareC: 'char *str'.
+ 
+ 	strOop := interpreterProxy stackValue: 0.
+ 	str := self asCString: strOop.
+ 	interpreterProxy failed ifTrue: [^ nil].
+ 
+ 	strLength := interpreterProxy stSizeOf: strOop.
+ 	count := self cCode: 'unicodeGetFontList(str, strLength)'.
+ 
+ 	interpreterProxy pop: 2
+ 		thenPush: (interpreterProxy integerObjectOf: count).
+ 	^ 0
+ !

Item was added:
+ ----- Method: UnicodePlugin>>primitiveGetXRanges (in category 'primitives') -----
+ primitiveGetXRanges
+ 
+ 	| utf8Oop utf8 resultOop resultPtr utf8Length count resultLength |
+ 	self export: true.
+ 	self var: 'utf8' declareC: 'char *utf8'.
+ 	self var: 'resultPtr' declareC: 'int *resultPtr'.
+ 
+ 	utf8Oop := interpreterProxy stackValue: 1.
+ 	utf8 := self asCString: utf8Oop.
+ 
+ 	resultOop := interpreterProxy stackValue: 0.
+ 	resultPtr := self cWordsPtr: resultOop minSize: 0.
+ 	interpreterProxy failed ifTrue: [^ nil].
+ 
+ 	utf8Length := interpreterProxy stSizeOf: utf8Oop.
+ 	resultLength := interpreterProxy stSizeOf: resultOop.
+ 	count := self cCode: 'unicodeGetXRanges(utf8, utf8Length, resultPtr, resultLength)'.
+ 
+ 	interpreterProxy pop: 3 thenPush: (interpreterProxy integerObjectOf: count).
+ 	^ 0
+ !

Item was added:
+ ----- Method: UnicodePlugin>>primitiveMeasureString (in category 'primitives') -----
+ primitiveMeasureString
+ 
+ 	| utf8Oop utf8 utf8Length w h result |
+ 	self export: true.
+ 	self var: 'utf8' declareC: 'char *utf8'.
+ 
+ 	utf8Oop := interpreterProxy stackValue: 0.
+ 	utf8 := self asCString: utf8Oop.
+ 	interpreterProxy failed ifTrue: [^ nil].
+ 
+ 	w := h := 0.
+ 	utf8Length := interpreterProxy stSizeOf: utf8Oop.
+ 	self cCode: 'unicodeMeasureString(utf8, utf8Length, &w, &h)'.
+ 
+ 	result := interpreterProxy makePointwithxValue: w yValue: h.
+ 	interpreterProxy pop: 2 thenPush: result.
+ 	^ 0
+ !

Item was added:
+ ----- Method: UnicodePlugin>>primitiveSetColors (in category 'primitives') -----
+ primitiveSetColors
+ 
+ 	| fgRed fgGreen fgBlue bgRed bgGreen bgBlue mapBGToTransparent |
+ 	self export: true.
+ 
+ 	fgRed := interpreterProxy stackIntegerValue: 6.
+ 	fgGreen := interpreterProxy stackIntegerValue: 5.
+ 	fgBlue := interpreterProxy stackIntegerValue: 4.
+ 	bgRed := interpreterProxy stackIntegerValue: 3.
+ 	bgGreen := interpreterProxy stackIntegerValue: 2.
+ 	bgBlue := interpreterProxy stackIntegerValue: 1.
+ 	mapBGToTransparent := interpreterProxy booleanValueOf: (interpreterProxy stackValue: 0).
+ 	interpreterProxy failed ifTrue: [^ nil].
+ 
+ 	self cCode: 'unicodeSetColors(fgRed, fgGreen, fgBlue, bgRed, bgGreen, bgBlue, mapBGToTransparent)'.
+ 
+ 	interpreterProxy pop: 7.
+ 	^ 0
+ !

Item was added:
+ ----- Method: UnicodePlugin>>primitiveSetFont (in category 'primitives') -----
+ primitiveSetFont
+ 
+ 	| fontName fontSize boldFlag italicFlag antiAliasFlag |
+ 	self export: true.
+ 	self var: 'fontName' declareC: 'char fontName[200]'.
+ 
+ 	self copyString: (interpreterProxy stackValue: 4) into: fontName max: 200.
+ 	fontSize := interpreterProxy stackIntegerValue: 3.
+ 	boldFlag := interpreterProxy booleanValueOf: (interpreterProxy stackValue: 2).
+ 	italicFlag := interpreterProxy booleanValueOf: (interpreterProxy stackValue: 1).
+ 	antiAliasFlag := interpreterProxy booleanValueOf: (interpreterProxy stackValue: 0).
+ 	interpreterProxy failed ifTrue: [^ nil].
+ 
+ 	self cCode: 'unicodeSetFont(fontName, fontSize, boldFlag, italicFlag, antiAliasFlag)'.
+ 
+ 	interpreterProxy pop: 5.
+ 	^ 0
+ !

Item was added:
+ InterpreterPlugin subclass: #WeDoPlugin
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'VMMaker-Plugins'!
+ 
+ !WeDoPlugin commentStamp: 'jm 12/2/2008 14:22' prior: 0!
+ Low level interface to the Lego WeDo.
+ !

Item was added:
+ ----- Method: WeDoPlugin class>>hasHeaderFile (in category 'translation') -----
+ hasHeaderFile
+ 
+ 	^true!

Item was added:
+ ----- Method: WeDoPlugin>>primClosePort (in category 'translated prims') -----
+ primClosePort
+ 	"Close the WeDo port."
+ 
+ 	self export: true.
+ 	interpreterProxy success: (self cCode: 'WeDoClosePort()').
+ 	^ 0
+ !

Item was added:
+ ----- Method: WeDoPlugin>>primOpenPort (in category 'translated prims') -----
+ primOpenPort
+ 	"Open the WeDo port."
+ 
+ 	self export: true.
+ 	interpreterProxy success: (self cCode: 'WeDoOpenPort()').
+ 	^ 0
+ !

Item was added:
+ ----- Method: WeDoPlugin>>primRead (in category 'translated prims') -----
+ primRead
+ 	"Read data from the WeDo port into the given buffer (a ByteArray or String). Answer the number of bytes read."
+ 
+ 	| bufOop bufPtr bufSize byteCount |
+ 	self export: true.
+ 	self var: 'bufPtr' declareC: 'char *bufPtr'.
+ 
+ 	bufOop := interpreterProxy stackValue: 0.
+ 	((interpreterProxy isIntegerObject: bufOop) or:
+ 	 [(interpreterProxy isBytes: bufOop) not]) ifTrue: [
+ 		interpreterProxy success: false.
+ 		^ 0].
+ 	bufPtr := self cCoerce: (interpreterProxy firstIndexableField: bufOop) to: 'char *'.
+ 	bufSize := interpreterProxy stSizeOf: bufOop.
+ 	interpreterProxy failed ifTrue: [^ 0].
+ 
+ 	byteCount := self cCode: 'WeDoRead(bufPtr, bufSize)'.
+ 	byteCount < 0 ifTrue: [
+ 		interpreterProxy success: false.
+ 		^ 0].
+ 
+ 	interpreterProxy pop: 2.  					"pop args and rcvr"
+ 	interpreterProxy pushInteger: byteCount.	"push result"
+ 	^ 0
+ !

Item was added:
+ ----- Method: WeDoPlugin>>primWrite (in category 'translated prims') -----
+ primWrite
+ 	"Write data to the WeDo port from the given buffer (a ByteArray or String). Answer the number of bytes written."
+ 
+ 	| bufOop bufPtr bufSize byteCount |
+ 	self export: true.
+ 	self var: 'bufPtr' declareC: 'char *bufPtr'.
+ 
+ 	bufOop := interpreterProxy stackValue: 0.
+ 	((interpreterProxy isIntegerObject: bufOop) or:
+ 	 [(interpreterProxy isBytes: bufOop) not]) ifTrue: [
+ 		interpreterProxy success: false.
+ 		^ 0].
+ 	bufPtr := self cCoerce: (interpreterProxy firstIndexableField: bufOop) to: 'char *'.
+ 	bufSize := interpreterProxy stSizeOf: bufOop.
+ 	interpreterProxy failed ifTrue: [^ 0].
+ 
+ 	byteCount := self cCode: 'WeDoWrite(bufPtr, bufSize)'.
+ 	byteCount < 0 ifTrue: [
+ 		interpreterProxy success: false.
+ 		^ 0].
+ 
+ 	interpreterProxy pop: 2.  					"pop args and rcvr"
+ 	interpreterProxy pushInteger: byteCount.	"push result"
+ 	^ 0
+ !



More information about the Vm-dev mailing list