Hi,

  The current code for the shape fill is 'exquisite'
combination of BitBlt (I was really impressed when I
understood what the code does) and reasonably fast for most
situation.  However, I felt it a bit slow sometimes,
especially if the destination form is not small.

  So, I wrote a version of shape fill that can be translated
into C.  The algorithm is quite straight forward, but it
turned out pretty effective.  When the form is small, it is
as 4-5 times fast as the original, but when the form is
large, it outperforms 20-30 times faster on Solaris and
ICRUISE, at least.

  I think the code is not clean enough, but I think it is
still worth to post here.  For those who curious, try it in
the following way.

  File in the attachment, generate interp.c as usual (it
uses primitive number 581), evaluate "ShapeFillPlugin
cCodeForPrimitives" to generate sqShapeFill.c, and then
remove the definition of "storeWordofObjectwithValue()" in
the C file.  On the new VM, the shape fill operations will
be fast!

  You can also trace its execution by evaluate the following
(on normal VM), 

f primShapeFill: aColor interiorPoint: aPoint.

  or

f _ aForm "a 1-bit depth form to be filled".
p _ aPoint "a left-adjecent point in the form"
g _ Form extent: aForm extent.
self halt.
ShapeFillPlugin doPrimitive: 'primShapeFillX:y:source:result:stack:stackSize:'
	withArguments: {p x. p y. f. g. WordArray new: 4096. 4096}

		  *          *          *

  (I was about to ask a question, but I almost found the
answer while I was writing:-) So the following is just a
monologue of a VM wannabe.)

  It may be natural that this primitive is implemented as
new combination rule of BitBlt, but I want the modification
to the existing classes as small as possible, so I wrote
this as a separated class.

  Although the interpreter plugin frameworks seems to assume
the dynamic loading that ZaurusOS (the OS of ICRUISE)
doesn't have, still I defined ShapeFillPlugin as a subclass
of InterpreterPlugin because it has good modularity and the
test using InterpreterProxy is handy.  The C code for the
module is created separately and linked statically.

  What needed (presumably this is not the first time) in
this situation is "smart" inlining and pruning.  The called
methods of Interpreter and ObjectMemory from the module
should be automatically included into the CCodeGenerator in
order to maximize the inlining effect, and after the
inlining, those method should be removed from the generated
C code in order to avoid the multiply defined error at the
link time.

  Another thing I want is the named primitive works on the
platform that doesn't have dynamic loading.  This maybe done
by similar way to the external call primitive.  Generating a
table for static named primitives and assign the address of
the primitive at the first call.

  They say that the register indirect call to a function is
expensive on modern machines (sometimes 20 times or more).
I wonder if it is removed from #copyLoop, how it affects the
BitBlt speed.

                                             OHSHIMA Yoshiki
                Dept. of Mathematical and Computing Sciences
                               Tokyo Institute of Technology 

'From Squeak 2.5 of August 6, 1999 on 9 October 1999 at 9:22:23 am'!
Interpreter subclass: #InterpreterSimulator
	instanceVariableNames: 'byteCount sendCount traceOn myBitBlt displayForm filesOpen imageName messageQueue myShapeFill '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Squeak-Interpreter'!
InterpreterPlugin subclass: #ShapeFillPlugin
	instanceVariableNames: 'fillSourceBits fillDestBits fillFormWidth fillFormHeight fillSourceRaster fillStack fillStackp fillStackSize '
	classVariableNames: 'AllOnes BaseHeaderSize FormBitsIndex FormDepthIndex FormHeightIndex FormWidthIndex MaxStackp '
	poolDictionaries: ''
	category: 'Form-Fill'!

!CCodeGenerator methodsFor: 'public' stamp: 'yo 10/9/1999 05:35'!
codeStringForPrimitives: classAndSelectorList variables: variableList

	| sel aClass source s verbose meth |
	self initialize.
	variableList do: [:e |
		variables add: e asSymbol.
		self var: e asSymbol declareC: 'int ', e.
	].
	classAndSelectorList do: [:classAndSelector |
		aClass _ Smalltalk at: (classAndSelector at: 1).
		self addClassVarsFor: aClass.
		sel _ classAndSelector at: 2.
		(aClass includesSelector: sel)
			ifTrue: [source _ aClass sourceCodeAt: sel]
			ifFalse: [source _ aClass class sourceCodeAt: sel].
		meth _ ((Compiler new parse: source in: aClass notifying: nil)
				asTMethodFromClass: aClass).
		meth primitive > 0 ifTrue: [meth preparePrimitiveInClass: aClass].
		"for old-style array accessing:
			meth covertToZeroBasedArrayReferences."
		meth replaceSizeMessages.
		self addMethod: meth].

	"method preparation"
	verbose _ false.
	self prepareMethods.
	verbose ifTrue: [
		self printUnboundCallWarnings.
		self printUnboundVariableReferenceWarnings.
		Transcript cr].

	"code generation"
	self doInlining: true.
	s _ ReadWriteStream on: (String new: 1000).
	methods _ methods asSortedCollection: [:m1 :m2 | m1 selector < m2 selector].
	self emitCHeaderForPrimitivesOn: s.
	self emitCVariablesOn: s.
	self emitCFunctionPrototypesOn: s.
	methods do: [:m | m emitCCodeOn: s generator: self].
	^ s contents
! !


!FatBitsPaint methodsFor: 'menu' stamp: 'yo 10/9/1999 07:02'!
fill

	| fillPt |
	Cursor blank show.
	Cursor crossHair showWhile:
		[fillPt _ Sensor waitButton - self world viewBox origin - self position].
	originalForm primShapeFill: brushColor interiorPoint: fillPt.
	self changed.
! !


!Form methodsFor: 'filling' stamp: 'yo 10/9/1999 07:03'!
anyShapeFill
	"Fill the interior of the outermost outlined region in the receiver, a 1-bit deep form.  Typically the resulting form is used with fillShape:fillColor: to paint a solid color.  See also convexShapeFill:"

	| shape |
	"Draw a seed line around the edge and fill inward from the outside."
	shape _ Form extent: self extent.
	self primShapeFillX: 1 y: 1 source: self result: shape stack:
		(WordArray new: 4096) stackSize: 4096.
	"shape _ self findShapeAroundSeedBlock: [:f | f borderWidth: 1]."
	"Reverse so that this becomes solid in the middle"
	shape _ shape reverse.
	"Finally erase any bits from the original so the fill is only elsewhere"
	shape copy: shape boundingBox from: self to: 0 at 0 rule: Form erase.
	^ shape! !

!Form methodsFor: 'bordering' stamp: 'yo 10/9/1999 06:54'!
shapeBorder: aColor width: borderWidth interiorPoint: interiorPoint
	sharpCorners: sharpen internal: internal
	"Identify the shape (region of identical color) at interiorPoint,
	and then add an outline of width=borderWidth and color=aColor.
	If sharpen is true, then cause right angles to be outlined by
	right angles.  If internal is true, then produce a border that lies
	within the identified shape.  Thus one can put an internal border
	around the whole background, thus effecting a normal border
	around every other foreground image."
	| shapeForm borderForm interiorColor bwForm |
	"First identify the shape in question as a B/W form"
	interiorColor _ self colorAt: interiorPoint.
	shapeForm _ Form extent: self extent.
	bwForm _ (self makeBWForm: interiorColor) reverse.
	bwForm primShapeFillX: interiorPoint x y: interiorPoint y source: bwForm result: shapeForm
			stack: (WordArray new: 4096) stackSize: 4096.
	"shapeForm _ (self makeBWForm: interiorColor) reverse
				findShapeAroundSeedBlock:
					[:form | form pixelValueAt: interiorPoint put: 1]."
	"Reverse the image to grow the outline inward"
	internal ifTrue: [shapeForm reverse].
	"Now find the border fo that shape"
	borderForm _ shapeForm borderFormOfWidth: borderWidth sharpCorners: sharpen.
	"Finally use that shape as a mask to paint the border with color"
	self fillShape: borderForm fillColor: aColor! !

!Form methodsFor: 'scaling, rotation' stamp: 'yo 10/8/1999 16:16'!
magnify: aRectangle by: scale grid: nilOrAColor
	| result p |
	"Answer a Form created as a scaling of the receiver.
	Scale may be a Float, and may be greater or less than 1.0."

	result _ self magnify: aRectangle by: scale smoothing: (scale < 1 ifTrue: [2] ifFalse: [1]).
	(nilOrAColor = nil or: [scale <= 1.0]) ifTrue: [
		^ result.
	].

	p _ Pen newOnForm: result.
	p fillColor: nilOrAColor.
	0 to: self extent x - 1 do: [:x |
		p place: x * scale at 0.
		p goto: x * scale at result extent y.
	].

	0 to: self extent y - 1 do: [:y |
		p place: 0@(y * scale).
		p goto: result extent x@(y* scale).
	].
	^result.! !

!Form methodsFor: 'scaling, rotation' stamp: 'yo 10/8/1999 16:21'!
magnifyBy: scale grid: nilOrAColor
	"Answer a Form created as a scaling of the receiver.
	Scale may be a Float, and may be greater or less than 1.0."
	^self magnify: self boundingBox by: scale grid: nilOrAColor
! !

!Form methodsFor: 'primitive fill' stamp: 'yo 10/9/1999 06:08'!
primShapeFill: aColor interiorPoint: interiorPoint
	| x y bwForm interiorPixVal map ppd color ind resultForm |
	interiorPixVal _ self pixelValueAt: interiorPoint.
	x _ interiorPoint x.
	y _ interiorPoint y.
	[0 <= x and: [(self pixelValueAt: x at y) = interiorPixVal]] whileTrue: [
		x _ x - 1.
	].
	x _ x + 1.

	resultForm _ Form extent: self extent.
	depth = 1 ifTrue:
		[^self primShapeFillX: x y: y source: self result: resultForm
			stack: (WordArray new: 4096) stackSize: 4096].


	"First map this form into a B/W form with 0's in the interior region."
	bwForm _ Form extent: self extent.
	map _ Bitmap new: (1 bitShift: (depth min: 12)).  "Not calling newColorMap.  All 
			non-foreground go to 0.  Length is 2 to 4096."
	ppd _ depth.	"256 long color map in depth 8 is not one of the following cases"
	3 to: 5 do: [:bitsPerColor | 
		(2 raisedTo: bitsPerColor*3) = map size 
			ifTrue: [ppd _ bitsPerColor*3]].	"ready for longer maps than 512"

	ppd <= 8
		ifTrue: [map at: interiorPixVal+1 put: 1]
		ifFalse: [interiorPixVal = 0 
			ifFalse: [color _ Color colorFromPixelValue: interiorPixVal depth: depth.
				ind _ color pixelValueForDepth: ppd.
				map at: ind+1 put: 1]
			ifTrue: [map at: 1 put: 1]].
	bwForm copyBits: self boundingBox from: self at: 0 at 0 colorMap: map.
		"bwForm _ self makeBWForm: interiorColor."	"not work for two whites"
	bwForm reverse.  "Make interior region be 0's"

	"Now fill the interior region and return that shape"
	self primShapeFillX: x y: y source: bwForm result: resultForm stack: (WordArray new: 4096) stackSize: 4096.

	self fillShape: resultForm fillColor: aColor.
	^ resultForm
! !

!Form methodsFor: 'primitive fill' stamp: 'yo 10/9/1999 08:58'!
primShapeFillX: x y: y source: source result: result stack: stack stackSize: stackSize
	<primitive: 581>
	^ShapeFillPlugin doPrimitive: 'primShapeFillX:y:source:result:stack:stackSize:'
		withArguments: {x. y. source. result. stack. stackSize}.! !


!Form class methodsFor: 'examples' stamp: 'yo 10/9/1999 07:00'!
exampleSpaceFill    "Form exampleSpaceFill"
	"This example demonstrates the area filling algorithm. Starts by having
	the user sketch on the screen (ended by option-click) and then select a rectangular
	area of the screen which includes all of the area to be filled. Finally,
	(with crosshair cursor), the user points at the interior of some region to be
	filled, and the filling begins with that place as its seed."
	| f r interiorPoint |
	Form exampleSketch.		"sketch a little area with an enclosed region"
	r _ Rectangle fromUser.
	f _ Form fromDisplay: r.
	Cursor crossHair showWhile:
		[interiorPoint _ Sensor waitButton - r origin].
	Cursor execute showWhile:
		[f primShapeFill: Color gray interiorPoint: interiorPoint].
	f displayOn: Display at: r origin	! !


!FormEditor methodsFor: 'editing tools' stamp: 'yo 10/9/1999 07:06'!
newSourceForm
	"Allow the user to define a new source form for the FormEditor. Copying 
	the source form onto the display is the primary graphical operation. 
	Resets the tool to be repeatCopy."
	| dForm interiorPoint interiorColor bwForm |

	dForm _ Form fromUser: grid.
	"sourceForm must be only 1 bit deep"
	interiorPoint _ dForm extent // 2.
	interiorColor _ dForm colorAt: interiorPoint.
	bwForm _ (dForm makeBWForm: interiorColor) reverse.
	form _ Form extent: self extent.
	bwForm primShapeFillX: interiorPoint x y: interiorPoint y source: bwForm result: form
		stack: (WordArray new: 4096) stackSize: 4096.
	"form _ (dForm makeBWForm: interiorColor) reverse
				findShapeAroundSeedBlock:
					[:f | f pixelValueAt: interiorPoint put: 1]."
	form _ form trimBordersOfColor: Color white.
	tool _ previousTool! !


!Interpreter methodsFor: 'other primitives' stamp: 'yo 10/9/1999 02:06'!
primitiveShapeFillXysourceresultstackstackSize
	| stackSize stack result source y x |
	stackSize _ self stackIntegerValue: 0.
	stack _ self stackValue: 1.
	result _ self stackValue: 2.
	source _ self stackValue: 3.
	y _ self stackIntegerValue: 4.
	x _ self stackIntegerValue: 5.

	self primShapeFillX: x y: y source: source result: result stack: stack stackSize: stackSize.
	successFlag ifFalse: [
		^self primitiveFail.
	].
	self pop: 6 "leave the receiver"

! !


!Interpreter class methodsFor: 'initialization' stamp: 'yo 10/8/1999 23:05'!
initializePrimitiveTable 
	"This table generates a C switch statement for primitive dispatching."

	"NOTE: The real limit here is 2047, but our C compiler currently barfs over 700"
	MaxPrimitiveIndex _ 700.
	PrimitiveTable _ Array new: MaxPrimitiveIndex + 1.
	self table: PrimitiveTable from: 
	#(	"Integer Primitives (0-19)"
		(0 primitiveFail)
		(1 primitiveAdd)
		(2 primitiveSubtract)
		(3 primitiveLessThan)
		(4 primitiveGreaterThan)
		(5 primitiveLessOrEqual)
		(6 primitiveGreaterOrEqual)
		(7 primitiveEqual)
		(8 primitiveNotEqual)
		(9 primitiveMultiply)
		(10 primitiveDivide)
		(11 primitiveMod)
		(12 primitiveDiv)
		(13 primitiveQuo)
		(14 primitiveBitAnd)
		(15 primitiveBitOr)
		(16 primitiveBitXor)
		(17 primitiveBitShift)
		(18 primitiveMakePoint)
		(19 primitiveFail)					"Guard primitive for simulation -- *must* fail"

		"LargeInteger Primitives (20-39)"
		"32-bit logic is aliased to Integer prims above"
		(20 39 primitiveFail)

		"Float Primitives (40-59)"
		(40 primitiveAsFloat)
		(41 primitiveFloatAdd)
		(42 primitiveFloatSubtract)
		(43 primitiveFloatLessThan)
		(44 primitiveFloatGreaterThan)
		(45 primitiveFloatLessOrEqual)
		(46 primitiveFloatGreaterOrEqual)
		(47 primitiveFloatEqual)
		(48 primitiveFloatNotEqual)
		(49 primitiveFloatMultiply)
		(50 primitiveFloatDivide)
		(51 primitiveTruncated)
		(52 primitiveFractionalPart)
		(53 primitiveExponent)
		(54 primitiveTimesTwoPower)
		(55 primitiveSquareRoot)
		(56 primitiveSine)
		(57 primitiveArctan)
		(58 primitiveLogN)
		(59 primitiveExp)

		"Subscript and Stream Primitives (60-67)"
		(60 primitiveAt)
		(61 primitiveAtPut)
		(62 primitiveSize)
		(63 primitiveStringAt)
		(64 primitiveStringAtPut)
		(65 primitiveNext)
		(66 primitiveNextPut)
		(67 primitiveAtEnd)

		"StorageManagement Primitives (68-79)"
		(68 primitiveObjectAt)
		(69 primitiveObjectAtPut)
		(70 primitiveNew)
		(71 primitiveNewWithArg)
		(72 primitiveArrayBecomeOneWay)	"Blue Book: primitiveBecome"
		(73 primitiveInstVarAt)
		(74 primitiveInstVarAtPut)
		(75 primitiveAsOop)
		(76 primitiveStoreStackp)					"Blue Book: primitiveAsObject"
		(77 primitiveSomeInstance)
		(78 primitiveNextInstance)
		(79 primitiveNewMethod)

		"Control Primitives (80-89)"
		(80 primitiveBlockCopy)
		(81 primitiveValue)
		(82 primitiveValueWithArgs)
		(83 primitivePerform)
		(84 primitivePerformWithArgs)
		(85 primitiveSignal)
		(86 primitiveWait)
		(87 primitiveResume)
		(88 primitiveSuspend)
		(89 primitiveFlushCache)

		"Input/Output Primitives (90-109)"
		(90 primitiveMousePoint)
		(91 primitiveTestDisplayDepth)			"Blue Book: primitiveCursorLocPut"
		(92 primitiveSetDisplayMode)				"Blue Book: primitiveCursorLink"
		(93 primitiveInputSemaphore)
		(94 primitiveFail)						"Blue Book: primitiveSampleInterval"
		(95 primitiveInputWord)
		(96 primitiveCopyBits)
		(97 primitiveSnapshot)
		(98 primitiveStoreImageSegment)
		(99 primitiveLoadImageSegment)
		(100 primitivePerformInSuperclass)		"Blue Book: primitiveSignalAtTick"
		(101 primitiveBeCursor)
		(102 primitiveBeDisplay)
		(103 primitiveScanCharacters)
		(104 primitiveDrawLoop)
		(105 primitiveStringReplace)
		(106 primitiveScreenSize)
		(107 primitiveMouseButtons)
		(108 primitiveKbdNext)
		(109 primitiveKbdPeek)

		"System Primitives (110-119)"
		(110 primitiveEquivalent)
		(111 primitiveClass)
		(112 primitiveBytesLeft)
		(113 primitiveQuit)
		(114 primitiveExitToDebugger)
		(115 primitiveFail)					"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)"
		(120 primitiveFail)
		(121 primitiveImageName)
		(122 primitiveNoop)					"Blue Book: primitiveImageVolume"
		(123 primitiveFail)
		(124 primitiveLowSpaceSemaphore)
		(125 primitiveSignalAtBytesLeft)

		"Squeak Primitives Start Here"

		"Squeak Miscellaneous Primitives (128-149)"
		(126 primitiveDeferDisplayUpdates)
		(127 primitiveShowDisplayRect)
		(128 primitiveArrayBecome)
		(129 primitiveSpecialObjectsOop)
		(130 primitiveFullGC)
		(131 primitiveIncrementalGC)
		(132 primitiveObjectPointsTo)
		(133 primitiveSetInterruptKey)
		(134 primitiveInterruptSemaphore)
		(135 primitiveMillisecondClock)
		(136 primitiveSignalAtMilliseconds)
		(137 primitiveSecondsClock)
		(138 primitiveSomeObject)
		(139 primitiveNextObject)
		(140 primitiveBeep)
		(141 primitiveClipboardText)
		(142 primitiveVMPath)
		(143 primitiveShortAt)
		(144 primitiveShortAtPut)
		(145 primitiveConstantFill)
		(146 primitiveReadJoystick)
		(147 primitiveWarpBits)
		(148 primitiveClone)
		(149 primitiveGetAttribute)

		"File Primitives (150-169)"
		(150 primitiveFileAtEnd)
		(151 primitiveFileClose)
		(152 primitiveFileGetPosition)
		(153 primitiveFileOpen)
		(154 primitiveFileRead)
		(155 primitiveFileSetPosition)
		(156 primitiveFileDelete)
		(157 primitiveFileSize)
		(158 primitiveFileWrite)
		(159 primitiveFileRename)
		(160 primitiveDirectoryCreate)
		(161 primitiveDirectoryDelimitor)
		(162 primitiveDirectoryLookup)
		(163 primitiveDirectoryDelete)
		(164 168 primitiveFail)
		(169 primitiveDirectorySetMacTypeAndCreator)

		"Sound Primitives (170-199)"
		(170 primitiveSoundStart)
		(171 primitiveSoundStartWithSemaphore)
		(172 primitiveSoundStop)
		(173 primitiveSoundAvailableSpace)
		(174 primitiveSoundPlaySamples)
		(175 primitiveSoundPlaySilence)		"obsolete; will be removed in the future"
		(176 primWaveTableSoundmixSampleCountintostartingAtpan)
		(177 primFMSoundmixSampleCountintostartingAtpan)
		(178 primPluckedSoundmixSampleCountintostartingAtpan)
		(179 primSampledSoundmixSampleCountintostartingAtpan)
		(180 primFMSoundmixSampleCountintostartingAtleftVolrightVol)
		(181 primPluckedSoundmixSampleCountintostartingAtleftVolrightVol)
		(182 oldprimSampledSoundmixSampleCountintostartingAtleftVolrightVol)
		(183 primReverbSoundapplyReverbTostartingAtcount)
		(184 primLoopedSampledSoundmixSampleCountintostartingAtleftVolrightVol)
		(185 primSampledSoundmixSampleCountintostartingAtleftVolrightVol)
		(186 188 primitiveFail)
		(189 primitiveSoundInsertSamples)
		(190 primitiveSoundStartRecording)
		(191 primitiveSoundStopRecording)
		(192 primitiveSoundGetRecordingSampleRate)
		(193 primitiveSoundRecordSamples)
		(194 primitiveSoundSetRecordLevel)
		(195 199 primitiveFail)

		"Networking Primitives (200-229)"
		(200 primitiveInitializeNetwork)
		(201 primitiveResolverStartNameLookup)
		(202 primitiveResolverNameLookupResult)
		(203 primitiveResolverStartAddressLookup)
		(204 primitiveResolverAddressLookupResult)
		(205 primitiveResolverAbortLookup)
		(206 primitiveResolverLocalAddress)
		(207 primitiveResolverStatus)
		(208 primitiveResolverError)
		(209 primitiveSocketCreate)
		(210 primitiveSocketDestroy)
		(211 primitiveSocketConnectionStatus)
		(212 primitiveSocketError)
		(213 primitiveSocketLocalAddress)
		(214 primitiveSocketLocalPort)
		(215 primitiveSocketRemoteAddress)
		(216 primitiveSocketRemotePort)
		(217 primitiveSocketConnectToPort)
		(218 primitiveSocketListenOnPort)
		(219 primitiveSocketCloseConnection)
		(220 primitiveSocketAbortConnection)
		(221 primitiveSocketReceiveDataBufCount)
		(222 primitiveSocketReceiveDataAvailable)
		(223 primitiveSocketSendDataBufCount)
		(224 primitiveSocketSendDone)
		(225 primitiveSocketAccept)
		(226 229 primitiveFail)

		"Other Primitives (230-249)"
		(230 primitiveRelinquishProcessor)
		(231 primitiveForceDisplayUpdate)
		(232 primitiveFormPrint)
		(233 primitiveSetFullScreen)
		(234 primBitmapdecompressfromByteArrayat)
		(235 primStringcomparewithcollated)
		(236 primSampledSoundconvert8bitSignedFromto16Bit)
		(237 primBitmapcompresstoByteArray)
		(238 primitiveSerialPortOpen)
		(239 primitiveSerialPortClose)
		(240 primitiveSerialPortWrite)
		(241 primitiveSerialPortRead)
		(242 primitiveFail)
		(243 primStringtranslatefromtotable)
		(244 primStringfindFirstInStringinSetstartingAt)
		(245 primStringindexOfAsciiinStringstartingAt)
		(246 primStringfindSubstringinstartingAtmatchTable)
		(247 249 primitiveFail)

		"VM Implementor Primitives (250-255)"
		(250 clearProfile)
		(251 dumpProfile)
		(252 startProfiling)
		(253 stopProfiling)
		(254 primitiveVMParameter)
		(255 primitiveInstVarsPutFromStack) "Never used except in Disney tests.  Remove after 2.3 release."

		"Quick Push Const Methods"
		(256 primitivePushSelf)
		(257 primitivePushTrue)
		(258 primitivePushFalse)
		(259 primitivePushNil)
		(260 primitivePushMinusOne)
		(261 primitivePushZero)
		(262 primitivePushOne)
		(263 primitivePushTwo)

		"Quick Push Const Methods"
		(264 519 primitiveLoadInstVar)

		"MIDI Primitives (520-539)"
		(520 primitiveFail)
		(521 primitiveMIDIClosePort)
		(522 primitiveMIDIGetClock)
		(523 primitiveMIDIGetPortCount)
		(524 primitiveMIDIGetPortDirectionality)
		(525 primitiveMIDIGetPortName)
		(526 primitiveMIDIOpenPort)
		(527 primitiveMIDIParameterGetOrSet)
		(528 primitiveMIDIRead)
		(529 primitiveMIDIWrite)
		(530 539 primitiveFail)  "reserved for extended MIDI primitives"

		"Experimental Asynchrous File Primitives"
		(540 primitiveAsyncFileClose)
		(541 primitiveAsyncFileOpen)
		(542 primitiveAsyncFileReadResult)
		(543 primitiveAsyncFileReadStart)
		(544 primitiveAsyncFileWriteResult)
		(545 primitiveAsyncFileWriteStart)
		(546 547 primitiveFail)

		"Pen Tablet Primitives"
		(548 primitiveGetTabletParameters)
		(549 primitiveReadTablet)

		"Sound Codec Primitives"
		(550 primADPCMCodecprivateDecodeMono)	
		(551 primADPCMCodecprivateDecodeStereo)	
		(552 primADPCMCodecprivateEncodeMono)	
		(553 primADPCMCodecprivateEncodeStereo)	
		(554 569 primitiveFail)  "reserved for additional codec primitives"
		(570 580 primitiveFail)

		(581 primitiveShapeFillXysourceresultstackstackSize)		
		"Unassigned Primitives"
		(582 700 primitiveFail)).
! !


!InterpreterPlugin class methodsFor: 'instance creation' stamp: 'yo 10/9/1999 08:58'!
doPrimitive: primitiveName withArguments: anArray
	| proxy plugin |
	proxy _ InterpreterProxy new.
	proxy loadStackFrom: thisContext sender.
	plugin _ self simulatorClass new.
	plugin setInterpreter: proxy.
	plugin perform: primitiveName asSymbol withArguments: anArray.
	^proxy stackValue: 0! !


!InterpreterProxy methodsFor: 'object access' stamp: 'yo 10/9/1999 04:49'!
storeWord: index ofObject: oop withValue: a32BitValue
	^oop instVarAt: index+1 put: a32BitValue! !


!InterpreterSimulator methodsFor: 'initialization' stamp: 'yo 10/6/1999 06:26'!
initialize
	"Initialize the InterpreterSimulator when running the interpreter inside
	Smalltalk. The primary responsibility of this method is to allocate
	Smalltalk Arrays for variables that will be declared as statically-allocated
	global arrays in the translated code."

	"initialize class variables"
	ObjectMemory initialize.
	Interpreter initialize.

	methodCache _ Array new: MethodCacheSize.
	atCache _ Array new: AtCacheTotalSize.
	rootTable _ Array new: RootTableSize.
	remapBuffer _ Array new: RemapBufferSize.
	semaphoresToSignal _ Array new: SemaphoresToSignalSize.

	"initialize InterpreterSimulator variables used for debugging"
	byteCount _ 0.
	sendCount _ 0.
	traceOn _ true.
	myBitBlt _ BitBltSimulator new setInterpreter: self.
	myShapeFill _ ShapeFillPlugin new setInterpreter: self.
	displayForm _ nil.  "displayForm is created in response to primitiveBeDisplay"
	filesOpen _ OrderedCollection new.
! !

!InterpreterSimulator methodsFor: 'other primitives' stamp: 'yo 10/8/1999 23:05'!
primitiveShapeFillXysourceresultstackstackSize
	| stackSize stack result source y x |
	stackSize _ self stackIntegerValue: 0.
	stack _ self stackValue: 1.
	result _ self stackValue: 2.
	source _ self stackValue: 3.
	y _ self stackIntegerValue: 4.
	x _ self stackIntegerValue: 5.

	myShapeFill primShapeFillX: x y: y source: source result: result stack: stack stackSize: stackSize.
	self success ifFalse: [
		^self primitiveFail.
	].
	self pop: 6 "leave the receiver"


! !


!MultiuserTinyPaint methodsFor: 'menu' stamp: 'yo 10/9/1999 07:01'!
fill: evt

	| state fillPt |
	(drawState includesKey: evt hand) ifFalse: [self createDrawStateFor: evt hand].
	state _ drawState at: evt hand.

	Cursor blank show.
	Cursor crossHair showWhile:
		[fillPt _ Sensor waitButton - self world viewBox origin - self position].
	originalForm primShapeFill: (state at: PenColorIndex) interiorPoint: fillPt.
	self changed.
! !


!Pen methodsFor: 'operations' stamp: 'yo 10/9/1999 07:15'!
fill: drawBlock color: color
	| region tileForm tilePen shape saveColor recorder |
	drawBlock value: (recorder _ self as: PenPointRecorder).
	region _ Rectangle encompassing: recorder points.
	tileForm _ Form extent: region extent+6.
	tilePen _ Pen newOnForm: tileForm.
	tilePen location: location-(region origin-3)
		direction: direction
		penDown: penDown.
	drawBlock value: tilePen.  "Draw the shape in B/W"
	saveColor _ halftoneForm.
	drawBlock value: self.
	halftoneForm _ saveColor.
	shape _ Form extent: tileForm extent.
	tileForm primShapeFillX: 1 y: 1 source: tileForm result: shape stack: (WordArray new: 4096) stackSize: 4096.
	shape _ shape reverse.
	"shape _ (tileForm findShapeAroundSeedBlock: [:f | f borderWidth: 1]) reverse."
	shape copy: shape boundingBox from: tileForm to: 0 at 0 rule: Form erase.
	destForm fillShape: shape fillColor: color at: region origin-3! !

Smalltalk renameClassNamed: #FormFiller as: #ShapeFillPlugin!

!ShapeFillPlugin methodsFor: 'as yet unclassified' stamp: 'yo 10/9/1999 05:02'!
fillLeft: leftBound toRight: rightBound atY: y
	| start end word word1 value |
	self inline: false.
	start _ y * fillSourceRaster + (leftBound // 32).
	end _ y * fillSourceRaster + (rightBound // 32).

	start = end ifTrue: [
		word _ interpreterProxy fetchWord: start ofObject: fillSourceBits.
		word1 _ interpreterProxy fetchWord: start ofObject: fillDestBits.
		value _ (AllOnes >> (leftBound \\ 32)) bitAnd:
			((AllOnes << (31 - (rightBound \\ 32))) bitAnd: AllOnes).
		"value _ (fillMask at: leftBound \\ 32 + 1) bitXor: ((fillMask at: rightBound \\ 32 + 1) >> 1)."
		
		interpreterProxy storeWord: start ofObject: fillSourceBits
			withValue: (word bitOr: value).
		^interpreterProxy storeWord: start ofObject: fillDestBits
			withValue: (word1 bitOr: value).
	].
		
	(leftBound \\ 32) = 0 ifFalse: [
		word _ interpreterProxy fetchWord: start ofObject: fillSourceBits.
		word1 _ interpreterProxy fetchWord: start ofObject: fillDestBits.
		value _ AllOnes >> (leftBound \\ 32).
		"value _ (fillMask at: leftBound \\ 32 + 1)."
		interpreterProxy storeWord: start ofObject: fillSourceBits
			withValue: (word bitOr: value).
		interpreterProxy storeWord: start ofObject: fillDestBits
			withValue: (word1 bitOr: value).
		start _ start + 1.
	].

	(rightBound \\ 32) = 31 ifFalse: [
		word _ interpreterProxy fetchWord: end ofObject: fillSourceBits.
		word1 _ interpreterProxy fetchWord: end ofObject: fillDestBits.
		value _ (AllOnes << (31 - (rightBound \\ 32))) bitAnd: AllOnes.
		"value _ 16rFFFFFFFF bitXor: ((fillMask at: rightBound \\ 32 + 1) >> 1)."
		interpreterProxy storeWord: end ofObject: fillSourceBits
			withValue: (word bitOr: value).
		interpreterProxy storeWord: end ofObject: fillDestBits
			withValue: (word1 bitOr: value).
		end _ end - 1.
	].

	start to: end do: [:index |
		interpreterProxy storeWord: index ofObject: fillSourceBits withValue: 16rFFFFFFFF.
		interpreterProxy storeWord: index ofObject: fillDestBits withValue: 16rFFFFFFFF.
	].
! !

!ShapeFillPlugin methodsFor: 'as yet unclassified' stamp: 'yo 10/9/1999 06:17'!
findLeftAtX: x y: y
	| leftBound |
	self inline: true.

	(self pixelValueAtX: x y: y) = 1 ifTrue: [^32367].

	leftBound _ x.
	[0 <= leftBound and: [(self pixelValueAtX: leftBound y: y) = 0]] whileTrue: [
		leftBound _ leftBound - 1.
	].
	leftBound _ leftBound + 1.

	^leftBound! !

!ShapeFillPlugin methodsFor: 'as yet unclassified' stamp: 'yo 10/9/1999 06:17'!
findRightAtX: x y: y
	| rightBound |
	self inline: true.
	(self pixelValueAtX: x y: y) = 1 ifTrue: [^0].

	rightBound _ x.
	[rightBound < fillFormWidth and: [(self pixelValueAtX: rightBound y: y) = 0]] whileTrue: [
		rightBound _ rightBound + 1.
	].
	rightBound _ rightBound - 1.
	^rightBound! !

!ShapeFillPlugin methodsFor: 'as yet unclassified' stamp: 'yo 10/9/1999 06:17'!
pixelValueAtX: x y: y
	| sourceWord index |
	self inline: true.
"	(x < 0 or: [x >= fillFormWidth]) ifTrue: [^ 0].
	(y < 0 or: [y >= fillFormHeight]) ifTrue: [^ 0].
"
	index _ y * fillSourceRaster + (x // 32).
	sourceWord _ interpreterProxy fetchWord: index ofObject: fillSourceBits.
	^ (sourceWord >> (31 - (x \\ 32))) bitAnd: 1.! !

!ShapeFillPlugin methodsFor: 'as yet unclassified' stamp: 'yo 10/9/1999 06:16'!
popPointXY
	| value |
	self inline: true.
	value _ interpreterProxy fetchWord: fillStackp ofObject: fillStack.
	fillStackp _ fillStackp - 1.
	^value.! !

!ShapeFillPlugin methodsFor: 'as yet unclassified' stamp: 'yo 10/9/1999 09:11'!
primShapeFillX: x y: y source: sourceForm result: resultForm stack: stack stackSize: stackSize
	| right nowX nowY |

	fillStack _ stack.
	fillSourceBits _ interpreterProxy fetchPointer: FormBitsIndex ofObject: sourceForm.
	fillDestBits _ interpreterProxy fetchPointer: FormBitsIndex ofObject: resultForm.
	fillFormWidth _ interpreterProxy fetchInteger: FormWidthIndex ofObject: resultForm.
	fillFormHeight _ interpreterProxy fetchInteger: FormHeightIndex ofObject: resultForm.
	fillSourceRaster _ fillFormWidth+31//32.

	fillStackp _ 0.
	fillStackSize _ stackSize.

	self cCode: '' inSmalltalk: [MaxStackp _ 0].

	self pushPointX: x y: y.

	[fillStackp > 0] whileTrue: [
		nowX _ self popPointXY.
		nowY _ nowX bitAnd: 16rFFFF.
		nowX _ nowX bitShift: -16.

		right _ self findRightAtX: nowX y: nowY.
		nowX > right ifFalse: [
			self fillLeft: nowX toRight: right atY: nowY.
			nowY + 1 < fillFormHeight ifTrue: [
				fillStackp _ self pushPoints: nowY previousLeft: nowX previousRight: right
				direction: 1.
				interpreterProxy failed ifTrue: [	^nil].
			].
			nowY - 1 >= 0 ifTrue: [
				fillStackp _ self pushPoints: nowY previousLeft: nowX previousRight: right
					direction: -1.
				interpreterProxy failed ifTrue: [	^nil].
			].
		].
	].
! !

!ShapeFillPlugin methodsFor: 'as yet unclassified' stamp: 'yo 10/9/1999 04:53'!
pushPointX: x y: y
	self inline: true.
	fillStackp < fillStackSize ifFalse: [
		^interpreterProxy success: false.
	].
	fillStackp _ fillStackp + 1.
	self cCode: '' inSmalltalk: [MaxStackp _ MaxStackp max: fillStackp].
	interpreterProxy storeWord: fillStackp ofObject: fillStack withValue: ((x << 16) bitOr: y).
! !

!ShapeFillPlugin methodsFor: 'as yet unclassified' stamp: 'yo 10/9/1999 06:17'!
pushPoints: y previousLeft: pLeft previousRight: pRight direction: dir
	| in jobX nowY |
	self inline: true.
	jobX _ nil.

	nowY _ y + dir.
	in _ false.
	pLeft to: pRight do: [:nowX |
		in ifTrue: [
			(self pixelValueAtX: nowX y: nowY) = 1 ifTrue: [
				in _ false.
				self pushPointX: (self findLeftAtX: jobX y: nowY) y: nowY.
				interpreterProxy failed ifTrue: [^nil].
			].
		] ifFalse: [
			(self pixelValueAtX: nowX y: nowY) = 0 ifTrue: [
				in _ true.
				jobX _ nowX.
			].
		].
	].
	in ifTrue: [
		self pushPointX: (self findLeftAtX: jobX y: nowY) y: nowY.
		interpreterProxy failed ifTrue: [^nil].

	].
	^fillStackp

! !


!ShapeFillPlugin class methodsFor: 'as yet unclassified' stamp: 'yo 10/9/1999 07:35'!
cCodeForPrimitives
	"ShapeFillPlugin cCodeForPrimitives"
	" | f |
	f _ FileStream newFileNamed: 'sqShapeFill.c'. 
	f nextPutAll: ShapeFillPlugin cCodeForPrimitives.
	f close"

	^ CCodeGenerator new codeStringForPrimitives: ((self selectors collect: [:s | Array with: (ShapeFillPlugin name asSymbol) with: s] ) asArray), #((ObjectMemory fetchWord:ofObject:)
		(ObjectMemory storeWord:ofObject:withValue:)) variables: self instVarNames
! !

!ShapeFillPlugin class methodsFor: 'as yet unclassified' stamp: 'yo 10/9/1999 05:38'!
declareCVarsIn: cg
! !

!ShapeFillPlugin class methodsFor: 'as yet unclassified' stamp: 'yo 10/9/1999 04:53'!
generateCCode
	| cg c |
	cg _ CCodeGenerator new initialize.
	self declareCVarsIn: cg.
	cg addClass: self.
	#((ObjectMemory fetchWord:ofObject:)
		(ObjectMemory storeWord:ofObject:withValue:)) do: [:a |
		c _ (Smalltalk at: (a at: 1)).
		cg addMethod: ((Compiler new parse: (c sourceCodeAt: (a at: 2))
			in: c notifying: nil) asTMethodFromClass: c)
	].
	cg storeCodeOnFile: 'sqShapeFill.c' doInlining: true.
! !

!ShapeFillPlugin class methodsFor: 'as yet unclassified' stamp: 'yo 10/9/1999 09:11'!
initialize
	"ShapeFillPlugin initialize"

	AllOnes _ 16rFFFFFFFF.

	"Form fields"
	FormBitsIndex _ 0.
	FormWidthIndex _ 1.
	FormHeightIndex _ 2.
	FormDepthIndex _ 3.

	BaseHeaderSize _ 4.
 
! !


!SketchEditorMorph methodsFor: 'actions & preps' stamp: 'yo 10/9/1999 07:01'!
areaFill: evt
	"Find the area that is the same color as where you clicked.  Fill it with the current paint color."

evt isMouseUp ifTrue: ["Only fill upon mouseUp"
	Cursor execute showWhile:
		[paintingForm primShapeFill: self currentColor interiorPoint: evt cursorPoint - bounds origin.
		self render: bounds.	"would like to only invalidate the area 
				changed, but can't find out what it is."
		]].
! !

!SketchEditorMorph methodsFor: 'actions & preps' stamp: 'yo 10/9/1999 07:01'!
fill: evt
	"Find the area that is the same color as where you clicked.  Fill it with the current paint color."

evt isMouseUp ifTrue: ["Only fill upon mouseUp"
	Cursor execute showWhile:
		[paintingForm primShapeFill: self currentColor interiorPoint: evt cursorPoint - bounds origin.
		self render: bounds.	"would like to only invalidate the area 
				changed, but can't find out what it is."
		]].
! !


!TinyPaint methodsFor: 'menu' stamp: 'yo 10/9/1999 07:01'!
fill

	| fillPt |
	Cursor blank show.
	Cursor crossHair showWhile:
		[fillPt _ Sensor waitButton - self world viewBox origin - self position].
	originalForm primShapeFill: brushColor interiorPoint: fillPt.
	self changed.
! !


CCodeGenerator removeSelector: #codeStringForPrimitives:inClass:!
CCodeGenerator removeSelector: #addVariablesOfClass:!
Form removeSelector: #findLeftAtX:y:!
Form removeSelector: #fillScanY:from:to:in:and:!
Form removeSelector: #findLeftRightAtX:y:!
Form removeSelector: #pushJobs:previousLeft:previousRight:stack:stackp:direction:!
Form removeSelector: #primShapeFillInteriorPoint:result:stack:!
Form removeSelector: #fillUpperPartOf:previousLeft:previousRight:result:!
Form removeSelector: #primShapeFillInteriorPoint:result:!
Form removeSelector: #pushJobs:previousLeft:previousRight:stack:stackp:!
Form removeSelector: #primShapeFillX:y:source:result:stack:!
Form removeSelector: #needRecursion:previous:line:direction:!
Form removeSelector: #findRightAtX:y:!
Form removeSelector: #fillLeft:toRight:atY:resultForm:!
Form removeSelector: #primShapeFillInteriorPoint:oldLeft:oldRight:dotForm:toBWForm:direction:!
Form removeSelector: #findLeftRightAtY:previousLeft:previousRight:!
Form removeSelector: #primShapeFillInteriorPoint:!
Form removeSelector: #primShapeFill:interiorPoint:oldPixelValue:direction:oldLeft:oldRight:dotForm:!
Form removeSelector: #tryFillConvexPart:interiorPoint:direction:!
Form removeSelector: #fillLowerPartOf:previousLeft:previousRight:result:!
Interpreter removeSelector: #primShapeFillXysourceresultstack!
Interpreter removeSelector: #primitiveShapeFillXysourceresultstack!
InterpreterPlugin class removeSelector: #doPrimitive:arguments:!
InterpreterSimulator removeSelector: #primShapeFillPluginxysourceresultstack!
InterpreterSimulator removeSelector: #primShapeFill!
InterpreterSimulator removeSelector: #primShapeFillXysourceresultstack!
InterpreterSimulator removeSelector: #primitiveShapeFillXysourceresultstack!
ShapeFillPlugin removeSelector: #primShapeFill:in:interiorPoint:!
ShapeFillPlugin removeSelector: #pushJobs:previousLeft:previousRight:direction:!
ShapeFillPlugin removeSelector: #findRightAndPaintAtX:y:!
ShapeFillPlugin removeSelector: #fillPixelValueX:y:!
ShapeFillPlugin removeSelector: #primShapeFillX:y:source:result:stack:!
ShapeFillPlugin removeSelector: #findRightX:y:!
ShapeFillPlugin removeSelector: #pupJob!
ShapeFillPlugin removeSelector: #x:y:source:result:stack:!
ShapeFillPlugin removeSelector: #pushJob:!
ShapeFillPlugin removeSelector: #popJob!
ShapeFillPlugin removeSelector: #fillPixelValueAtX:y:!
ShapeFillPlugin removeSelector: #pushPoints:previousLeft:previousRight:!
ShapeFillPlugin removeSelector: #primShapeFill!
ShapeFillPlugin removeSelector: #fillPixelValueAtX:y:put:!
ShapeFillPlugin initialize!