Squeak
  links to this page:    
View this PageEdit this PageUploads to this PageHistory of this PageTop of the SwikiRecent ChangesSearch the SwikiHelp Guide
NamedPrimitiveTutorial
Last updated at 2:24 pm UTC on 16 January 2006
(note: Steps 5 and 6 are obsolete. Instead, see VMMaker)

Squeak Central has provided a new primitive interface for extending the VM without having to modify it. A pluggable primitive is called by name, not by number, and its code can reside in an external library (DSO on Unix, DLL on Windows, Shared Libraries on MacOS) or in the VM library itself. An example is FFT>>pluginTest which is a factor 60-100 times faster than the regular (interpreted) FFT.

The following may be a useful guide to building Pluggable Primitives until Squeak Central gets a chance to set me straight. Note that Squeak-Plugins has some fairly detailed comments which I found useful in figuring out how to do the following. Although the following has a Macintosh gloss, the beauty of the Squeak code generation architecture is such that these notes should be useful for most any platform.

THE PLAN



As an existence proof that PP's work before committing gobs of time to a new project, I set out to create four simple test primitives that do the following trivial functions:



I figured if I could get that going, I was well on my way to making a true mess of things. I made no effort to bulletproof these prims, just getting them 'working' was my sole goal.

STEP ONE: BUILD THE SMALLTALK CLASSES:



I created a class that will contain the Squeak plugin module code, and aptly named it "FooPlugin," making the class a subclass of InterpreterPlugin class:
	InterpreterPlugin subclass: #FooPlugin
		instanceVariableNames: ''
		classVariableNames: ''
		poolDictionaries: ''
		category: 'Werdna-Foostuff'

I then created a class to call and demonstrate the plugin primitives, aptly named it "Foo", with a single instance variable named myInteger:
	Object subclass: #Foo
		instanceVariableNames: 'myInteger '
		classVariableNames: ''
		poolDictionaries: ''
		category: 'Werdna-Foostuff'

STEP TWO: BUILD THE SMALLTALK INTERFACE IN FOO:



Then I added an accessor for myInteger:
	myInteger: anInteger
		"setter: set myInteger to anInteger"

		^myInteger _ anInteger

And wrote the four primitive calling procedures:
	integerSeventeen
		"answer the constant value 17"

		< primitive: 'primFooIntegerSeventeen' module: 'Foo'>
		^FooPlugin doPrimitive: 'primFooIntegerSeventeen'


	integerIdentity: anInteger
		"answer anInteger"

		< primitive: 'primFooIntegerIdentity' module: 'Foo'>
		^FooPlugin doPrimitive: 'primFooIntegerIdentity'


	integerSum: firstInteger and: secondInteger
		"answer the sum of firstInteger and secondInteger"

		< primitive: 'primFooIntegerSumAnd' module: 'Foo'>
		^FooPlugin doPrimitive: 'primFooIntegerSumAnd'


	integerSumWith: anInteger
		"answer the sum of anInteger and self myInteger"

		< primitive: 'primFooIntegerSumWith' module: 'Foo'>
		^FooPlugin doPrimitive: 'primFooIntegerSumWith'

A few remarks. The syntax:
	< primitive: 'primitiveName' module: 'moduleName'>

directs Squeak to try to find exported function primitiveName in dynamic library moduleName. Since neither the library nor the primitives exist as of yet, these primitive calls will ALWAYS fail. A failing primitive then "falls through" to execute the subsequent Smalltalk code. Now, the next lines of each routine call an inherited method of FooPlugin, doPrimitive, which will run an interpreter on the Smalltalk code as we develop it.

In other words, if the module and method are found and the machine code executes cleanly, it returns without more. Otherwise, the next line is executed, which directly interprets the Smalltalk bytecodes in FooPlugin, even if the module has not yet been completed.

It's that EASY! And that's the point – we can now build our primitives in Squeak, test them in Squeak, and later, when we are happy with the code, we can then go to the big bad compiler and try to install the module itself.

STEP THREE: BUILD THE PRIMITIVES IN FOOPLUGIN



The following methods live in FooPlugin. The code for integerSeventeen:
primFooIntegerSeventeen
	"primitive answering constant (int) 17"

	self export: true. "this tells the translator that
		this is a public primitive function"
	self inline: false. "this tells the translator not
		to bother inlining messages"
	interpreterProxy pop: 1. "pop the top of stack (the receiver)"
	interpreterProxy pushInteger: 17. "push the return value"

We use interpreterProxy, which is an instance of InterpreterProxy, to manipulate the Squeak VM, which we need in order to get parameters and instance variables; push answers on the stack for returning and the like.

The first two pseudo-calls teach the compiler how to generate the code, in particular, making sure the primitive will be externally callable and telling it not to bother inlining subroutines (which we don't use in these examples). When a primitive without parameters gets control, the receiver is on the top of the stack. For this routine, we simply pop it, push the constant, and we are finished with our work. The other routines follow:
primFooIntegerIdentity ": anInteger"
	"primitive answering first (int) parameter"

	|anInteger|
	self export: true.
	self inline: false.
	anInteger _ interpreterProxy stackIntegerValue: 0.
	interpreterProxy pop: 2.
	interpreterProxy pushInteger: anInteger.

Here, the stack holds both the parameter and the receiver pointer. We use the zero-indexed method stackIntegerValue to pull down the parameter, clear the stack, and push the result.
primFooIntegerSumAnd ":firstInteger and: secondInteger"
	"answer sum of (int) firstInteger and (int) secondInteger"

	|firstInteger secondInteger|
	self export: true.
	self inline: false.
	secondInteger _ interpreterProxy stackIntegerValue: 0.
	firstInteger _ interpreterProxy stackIntegerValue: 1.
	interpreterProxy pop: 3.
	interpreterProxy pushInteger: (firstInteger+secondInteger).

Same deal, except we get two parameters instead of one. (remember to pop the receiver as well), and then push the sum.
primFooIntegerSumWith ": anInteger"
	"answer the sum of my (int) parameter and (int) first instance var"
	"No type checking done, I simply assume the field is an integer"

	|anInteger rcvr myInteger |
	self export: true.
	self inline: false.
	anInteger _ interpreterProxy stackIntegerValue: 0.
	rcvr _ interpreterProxy stackObjectValue: 1.
	myInteger _ interpreterProxy fetchInteger: 0 ofObject: rcvr.
	interpreterProxy pop: 2.
	interpreterProxy pushInteger: (anInteger+myInteger).

Only slightly more sophisticated. Here, I also pull the receiver and use the interpreterProxy to fetchInteger to get the (0-indexed) first instance variable, pop the stack and then push the sum.

STEP FOUR: TEST THE PRIMITIVES TO SATISFY YOURSELF THEY WORK.


	Foo new integerSeventeen.       
                                                answers 17

	Foo new integerIdentity: 23.     
                                                answers  23

	Foo new integerSum: 3 and: 4. 
                                                answers   7

	Foo new myInteger: 3; integerSumWith: 4.  
                                                answers  7

STEP FIVE: TAKE A BREATH AND COMPILE THE CODE



This is so easy, its automagical! You only need to do two things. First, add a single class method to FooPlugin, so that the plugin knows the name of the module:
	moduleName
		"return the name of this plug-in library"

		^'Foo'

The rest is even easier, just execute the following:
	FooPlugin translateDoInlining: true

      or in 3.6 I had to use:
      FooPlugin translateInDirectory: (FileDirectory default) doInlining: true


and the code magically is produced in file 'FooPlugin.c'

STEP SIX: GO TO YOUR OPERATING SYSTEM AND BUILD AND INSTALL THE MODULE.



To compile "Foo.c," you will also need some of the interpreter support ".h" files, which you can obtain simply by executing the following inside of Squeak:
	InterpreterSupportCode writeMacSourceFiles

For me, I went to MPW and executed the following commands. Your mileage may vary:
MrC "Macintosh HD:Desktop Folder:Squeaks:Squeak2.3 folder:Foo.c" -o Foo.c.x
PPCLink -o Foo "Foo.c.x" -t 'shlb' -c '????' -xm s ?
"Macintosh HD:Desktop Folder:MPW:Libraries:SharedLibraries:InterfaceLib" ?
"Macintosh HD:Desktop Folder:MPW:Libraries:SharedLibraries:StdCLib" ?
"Macintosh HD:Desktop Folder:MPW:Libraries:SharedLibraries:MathLib" ?
"Macintosh HD:Desktop Folder:MPW:Libraries:PPCLibraries:StdCRuntime.o" ?
"Macintosh HD:Desktop Folder:MPW:Libraries:PPCLibraries:PPCCRuntime.o" ?
"Macintosh HD:Desktop Folder:MPW:Libraries:PPCLibraries:PPCToolLibs.o"

(You can use MPW's "Create Build Commands" feature to build a makefile for you.)


For instructions for compiling the plugin on a Macintosh using Metrowerks CodeWarrior, look Building a Mac plugin with Metrowerks Codewarrior.

The result of the compile is the generation of a Macintosh shared library plugin file named "Foo." To install it, simply copy the file into the same folder as your Squeak executable and restart Squeak. The next time I ran the primitives (same commands as before), they ran right as rain, but instead of running the interpreter, they ran from the module.

[If you want to show that you have no faith, simply change the calls to "FooPlugin doPrimitive:" with ^'Whew!'. To really believe, start passing non-integer strings to the code and see what happens.

After getting this working, I suggest readers study the more sophisticated code in the Squeak-Plugins category. I would appreciate any comments about the preceding, and I will update after incorporating all of the corrections.

Of course, all of the above is a profound example of the blind leading the blind, but bootstrapping our way out of darkness a bit at a time is the very heart of the Squeak philosophy, right?

Hope this helps.


Andy Greenberg
werdna@gate.net