Use function return to actually call another function via the stored IP:

#include <stdio.h>

register void ** base_pointer  __asm("%rbp");
register void ** stack_pointer __asm("%rsp");

int mycode(void * old_ip) {
    printf("Mycode\n");
    *(base_pointer + 1) = old_ip;
    return 10;
}

int fun() {
    void * old_ip = *(base_pointer + 1);
    *(base_pointer + 1) = mycode;
    stack_pointer = base_pointer;
    __asm("movq %0, %%rdi"::"r"(old_ip));
    return 4;
}

int main() {
    printf("%i\n", fun());
    return 0;
}

Dynamically generate code and execute it:

#include <sys/mman.h>
#include <stdio.h>

int seven() {
    char * space = mmap(NULL,
                        7,
                        PROT_WRITE | PROT_READ,
                        MAP_PRIVATE | MAP_ANONYMOUS, 0, 0);
    // mov 7, %rax; leave; ret
    space[0] = 0xB8;
    space[1] = 0x07;
    space[2] = 0x00;
    space[3] = 0x00;
    space[4] = 0x00;
    space[5] = 0xC9;
    space[6] = 0xC3;
    mprotect(space, 7, PROT_EXEC | PROT_READ);
    goto *space;
}

int main() {
    printf("%i\n", seven());
    return 0;
}

And the buffer overflow version:

#include <stdio.h>

register void ** base_pointer  __asm("%rbp");
register void ** stack_pointer __asm("%rsp");

int mycode(void * old_ip) {
    printf("Mycode\n");
    *(base_pointer + 1) = old_ip;
    return 10;
}

int fun() {
    void * old_ip = *(base_pointer + 1);
    void * buffer[0];
    buffer[1] = mycode;
    stack_pointer       = base_pointer;
    __asm("movq %0, %%rdi"::"r"(old_ip));
    return 4;
}

int main() {
    printf("%i\n", fun());
    return 0;
}

The idea with Parallel Debugging is that you might have a small piece of code that fails (most often a test), but you have no idea why: another piece of code, which looks exactly the same to you is succeeding! How can this ever happen?

This situation actually occurred when my super-student Cami was not really awake yet and he wrote a test for the IdentitySetBucket class. This is, as the name specifies, an implementation of the Bucket class that’s going to be used for IdentitySets. IdentitySets are like in standard Smalltalk, Sets that compare elements with #== (pointer equality).

Now Cami wrote the following test:

testIncludesMixed
	(b includes: #key) should = false.
	b add: #key.
	(b includes: #key) should = true.
	(b includes: 'key') should = false.
	(b includes: #key2) should = false.
	b add: 'key2'.
	(b includes: #key) should = true.
	(b includes: 'key') should = false.
	(b includes: #key2) should = false.
	b add: #key2.
	(b includes: #key2) should be: true.
	(b includes: 'key2') should be: true.

(try to not mind the not so clean usage of Pexample, our own fork of Phexample for Pinocchio)

In this piece of code, according to Cami, but last 2 lines should do exactly the same; one should find a string, and the other find a symbol. However, he noticed that even while the symbol got retrieved; the string didn’t!

ParallelDebugger to the rescue!

Rather than just running the tests separately and being confused why they behave differently; lets use a debugger that actually runs them next to each other. It runs different pieces of code it gets in in parallel (as coroutines), switching between routines at each send and each return from send; constantly comparing if the input/output is the same for all routines.

	PParallelDebugger interpret:
		(Array
			with: [ (b includes: 'key2') should be: true ]
			with: [ (b includes: #key2) should be: true ])

This is what happens when you execute the piece of code (sorry; at the moment we only have stderr output; would be nicer to inspect with a GUI)

1: BlockClosure@BlockClosure>>#value (0)
2: BlockClosure@BlockClosure>>#value (0)
      1: IdentitySetBucket@IdentitySetBucket>>#includes: (1)
      2: IdentitySetBucket@IdentitySetBucket>>#includes: (1)
          1: Continue class@Continue class>>#on: (1)
          2: Continue class@Continue class>>#on: (1)
          1: BlockClosure@BlockClosure>>#value: (1)
          2: BlockClosure@BlockClosure>>#value: (1)
              1: IdentitySetBucket@IdentitySetBucket>>#do: (1)
              2: IdentitySetBucket@IdentitySetBucket>>#do: (1)
                  1: SmallInt@SmallInt>>#to:do: (2)
                  2: SmallInt@SmallInt>>#to:do: (2)
                      1: BlockClosure@BlockClosure>>#whileTrue: (1)
                      2: BlockClosure@BlockClosure>>#whileTrue: (1)
                            1: BlockClosure@BlockClosure>>#value (0)
                            2: BlockClosure@BlockClosure>>#value (0)
                                1: SmallInt@SmallInt>>#<= (1)
                                2: SmallInt@SmallInt>>#<= (1)
                                      1: SmallInt@SmallInt>>#> (1)
                                      2: SmallInt@SmallInt>>#> (1)
                                      1  --> False
                                      2  --> False
                                    1: False@False>>#not (0)
                                    2: False@False>>#not (0)
                                    1  --> True
                                    2  --> True
                                1  --> True
                                2  --> True
                            1  --> True
                            2  --> True
                          1: True@True>>#ifTrue: (1)
                          2: True@True>>#ifTrue: (1)
                              1: BlockClosure@BlockClosure>>#value (0)
                              2: BlockClosure@BlockClosure>>#value (0)
                                  1: BlockClosure@BlockClosure>>#value (0)
                                  2: BlockClosure@BlockClosure>>#value (0)
                                      1: BlockClosure@BlockClosure>>#value: (1)
                                      2: BlockClosure@BlockClosure>>#value: (1)
                                            1: IdentitySetBucket@IdentitySetBucket>>#at: (1)
                                            2: IdentitySetBucket@IdentitySetBucket>>#at: (1)
                                            1  --> #'key'
                                            2  --> #'key'
                                          1: BlockClosure@BlockClosure>>#value: (1)
                                          2: BlockClosure@BlockClosure>>#value: (1)
                                                1: Symbol@Symbol>>#== (1)
                                                2: Symbol@Symbol>>#== (1)
                                                1  --> False
                                                2  --> False
                                              1: False@False>>#ifTrue: (1)
                                              2: False@False>>#ifTrue: (1)
                                              1  --> Nil
                                              2  --> Nil
                                          1  --> Nil
                                          2  --> Nil
                                      1  --> Nil
                                      2  --> Nil
                                      1: SmallInt@SmallInt>>#+ (1)
                                      2: SmallInt@SmallInt>>#+ (1)
                                      1  --> SmallInt
                                      2  --> SmallInt
                                  1  --> SmallInt
                                  2  --> SmallInt
                                  1: BlockClosure@BlockClosure>>#whileTrue: (1)
                                  2: BlockClosure@BlockClosure>>#whileTrue: (1)
                                        1: BlockClosure@BlockClosure>>#value (0)
                                        2: BlockClosure@BlockClosure>>#value (0)
                                            1: SmallInt@SmallInt>>#<= (1)
                                            2: SmallInt@SmallInt>>#<= (1)
                                                  1: SmallInt@SmallInt>>#> (1)
                                                  2: SmallInt@SmallInt>>#> (1)
                                                  1  --> False
                                                  2  --> False
                                                1: False@False>>#not (0)
                                                2: False@False>>#not (0)
                                                1  --> True
                                                2  --> True
                                            1  --> True
                                            2  --> True
                                        1  --> True
                                        2  --> True
                                      1: True@True>>#ifTrue: (1)
                                      2: True@True>>#ifTrue: (1)
                                          1: BlockClosure@BlockClosure>>#value (0)
                                          2: BlockClosure@BlockClosure>>#value (0)
                                              1: BlockClosure@BlockClosure>>#value (0)
                                              2: BlockClosure@BlockClosure>>#value (0)
                                                  1: BlockClosure@BlockClosure>>#value: (1)
                                                  2: BlockClosure@BlockClosure>>#value: (1)
                                                        1: IdentitySetBucket@IdentitySetBucket>>#at: (1)
                                                        2: IdentitySetBucket@IdentitySetBucket>>#at: (1)
                                                        1  --> 'key2'
                                                        2  --> 'key2'
                                                      1: BlockClosure@BlockClosure>>#value: (1)
                                                      2: BlockClosure@BlockClosure>>#value: (1)
                                                            1: String@String>>#== (1)
                                                            2: String@String>>#== (1)
                                                            1  --> False
                                                            2  --> False
                                                          1: False@False>>#ifTrue: (1)
                                                          2: False@False>>#ifTrue: (1)
                                                          1  --> Nil
                                                          2  --> Nil
                                                      1  --> Nil
                                                      2  --> Nil
                                                  1  --> Nil
                                                  2  --> Nil
                                                  1: SmallInt@SmallInt>>#+ (1)
                                                  2: SmallInt@SmallInt>>#+ (1)
                                                  1  --> SmallInt
                                                  2  --> SmallInt
                                              1  --> SmallInt
                                              2  --> SmallInt
                                              1: BlockClosure@BlockClosure>>#whileTrue: (1)
                                              2: BlockClosure@BlockClosure>>#whileTrue: (1)
                                                    1: BlockClosure@BlockClosure>>#value (0)
                                                    2: BlockClosure@BlockClosure>>#value (0)
                                                        1: SmallInt@SmallInt>>#<= (1)
                                                        2: SmallInt@SmallInt>>#<= (1)
                                                              1: SmallInt@SmallInt>>#> (1)
                                                              2: SmallInt@SmallInt>>#> (1)
                                                              1  --> False
                                                              2  --> False
                                                            1: False@False>>#not (0)
                                                            2: False@False>>#not (0)
                                                            1  --> True
                                                            2  --> True
                                                        1  --> True
                                                        2  --> True
                                                    1  --> True
                                                    2  --> True
                                                  1: True@True>>#ifTrue: (1)
                                                  2: True@True>>#ifTrue: (1)
                                                      1: BlockClosure@BlockClosure>>#value (0)
                                                      2: BlockClosure@BlockClosure>>#value (0)
                                                          1: BlockClosure@BlockClosure>>#value (0)
                                                          2: BlockClosure@BlockClosure>>#value (0)
                                                              1: BlockClosure@BlockClosure>>#value: (1)
                                                              2: BlockClosure@BlockClosure>>#value: (1)
                                                                    1: IdentitySetBucket@IdentitySetBucket>>#at: (1)
                                                                    2: IdentitySetBucket@IdentitySetBucket>>#at: (1)
                                                                    1  --> #'key2'
                                                                    2  --> #'key2'
                                                                  1: BlockClosure@BlockClosure>>#value: (1)
                                                                  2: BlockClosure@BlockClosure>>#value: (1)
                                                                        1: Symbol@Symbol>>#== (1)
                                                                        2: Symbol@Symbol>>#== (1)
                                                                        1  --> False
                                                                        2  --> True
Expected: false but got: true

In this snippet, two parts of the trace are of importance for the bug at hand:

                                                        1: IdentitySetBucket@IdentitySetBucket>>#at: (1)
                                                        2: IdentitySetBucket@IdentitySetBucket>>#at: (1)
                                                        1  --> 'key2'
                                                        2  --> 'key2'
                                                      1: BlockClosure@BlockClosure>>#value: (1)
                                                      2: BlockClosure@BlockClosure>>#value: (1)
                                                            1: String@String>>#== (1)
                                                            2: String@String>>#== (1)
                                                            1  --> False
                                                            2  --> False

and

                                                                    1: IdentitySetBucket@IdentitySetBucket>>#at: (1)
                                                                    2: IdentitySetBucket@IdentitySetBucket>>#at: (1)
                                                                    1  --> #'key2'
                                                                    2  --> #'key2'
                                                                  1: BlockClosure@BlockClosure>>#value: (1)
                                                                  2: BlockClosure@BlockClosure>>#value: (1)
                                                                        1: Symbol@Symbol>>#== (1)
                                                                        2: Symbol@Symbol>>#== (1)
                                                                        1  --> False
                                                                        2  --> True

The first one basically says that it tried to compare the input string and symbol with the string

. This should actually already have resulted in a difference in the trace; but it didn’t. Then later on in the second snippet, it actually diverges and

is matched with the symbol but not the string. So this failure is to be expected. Now you can see that the method

on String doesn’t behave as expected while it does on Symbol. This is obvious as String that are

are not necessarily

. This is the whole point of the Identity vs normal Set, Dictionary, …

This is pretty cool and explains us nicely why the code failed.

Now the interesting part is how this whole debugger is implemented in the first place. It is basically a subclass of a SteppingInterpreter, a subclass of Interpreter that evaluates a

before each evaluation of a message send. By subclassing the SteppingInterpreter, implementing the ParallelDebugger comes down to two methods (methods for indentation are left out for readability; the whole source code is available at SqueakSource)

interpret: closures
	stepBlock := [ :receiver :class :message :action |
		results put: (receiver@class@message).
		self show: continuations position asString, ': ', receiver class name, '@', class name, '>>', message.
		self interpretNext.
		results put: action value.
		self show: continuations position asString, '  --> ', results current inspectName.
		self interpretNext.
		results current
	].
	results := StatefulArray new: closures size.
	continuations := StatefulArray new: closures size.
	closures do: [ :aClosure |
		Continuation on: [ :startNext |
			continuations nextPut: (startNext@nil).
			^ super interpret: aClosure.
		]
	]

This method is the main

of the debugger. It overwrites the default

method, that takes an object (generally a BlockClosure) as input and evaluates the sending of

to it:

interpret: aClosure
	^ self send: (Message new selector: #value) to: aClosure

It sets the

to a block that stores the information of the send in

and prints it, before switching to the next routine. Then when the control is given back to this routine, it actually executes the send (the action that’s passed in is a block created by the SteppingInterpreter to make it easy for subclasses to actually do the send; so sending

to the action will actually perform the send). The result of the send is then stored in the results before switching to the next routine. When the interpreter finally decides to come back to this routine, it returns the result to the place that send the message in the first place.

The whole loop is started by looping over the input closures. The next iteration of the booting loop is stored as the continuation of the next coroutine. Then we start the current interpretation by letting the SteppingInterpreter interpret the current closure.

Now when the Interpreter hits the first send in the code, it will jump out to the step block that will continue the next routine. The next routine in the beginning will be the continuation in the

loop at the bottom, so it will also jumpstart the second closure; and so on, until all closures have been started. (

on StatefulArray has been implemented so that it ignores the value when at the end of the array. This avoids storing a continuation for starting a fictional closure beyond the end of the closures array)

Once the first coroutine completely finishes, all coroutines should be finished, so rather than continuing the

after the

, we return to the code that started the debugger in the first place.

Now lets look at the piece of code that handles the switching of interpreters and checking of the intermediate results:

interpretNext
	| cont |
	Continuation on: [ :aContinuation |
		continuations put: (aContinuation@context).
		continuations ifAtEnd: [
			|test|
			test := results first.
			results doRest: [ :result | result should be: test ].
			cont := continuations first.
			context := cont y.
			cont x continue.
		].
		results next.
		cont := continuations next.
		context := cont y.
		cont x continue.
	]

This piece of code captures a continuation every time it gets invoked. It stores this continuation and the context of the interpreter (the environment) in the continuations list. When not at the end of the list, it makes the results list point to the next element; it takes the next continuation and restores it. It is restored by restoring the context, and then continuing the continuation.

When we are at the end of the list of coroutines however, we take the first result and compare it to all the results produces by all the coroutines. This result will contain information about a message send when switching before doing the actual send; and later the return value of the send when switching after the send has returned.

When all values have been considered equal, we restart at the first coroutine.

And that’s all folks!

Just to be fair: since the current implementation of the parallel debugger compares all values with

, and since some of the passed values (and receivers) are BlockClosures, we had to implement

, that currently just compares if their code is sufficiently equal. To be very useful in the long run this should probably be changed to allow different kinds of parallel-run-checking. However, the point here was not the parallel debugger itself; rather how easily it is implemented!

If you look closely at it, bytecodes are actually just a way of introducing a second set of primitives into the runtime. In contrast with other primitives, these primitives are manually inlined by the compiler; and in many cases they even behave like inline cached methods. This is very visible in the case of the bytecodes for integers: + will always be compiled to the bytecode + that evaluates the same as the primitive + for SmallInt. In the case that the runtime receiver isn’t a SmallInt (thus it checks the class like InlineCaches would), it will actually send the message + to the receiver with the runtime argument.

So if we do away with bytecodes, we just need a way of evaluating a small set of expressions where sometimes a message send ends up in a primitive natively performing the actual action, and the interpreter definition becomes a lot more understandable and smaller.

Now when you write a meta-circular interpreter for Smalltalk in AST-form, this is pretty straightforward since all the AST objects are Smalltalk objects to which you can send messages, and receive responses from. Some of the visiting methods are as easy as:

The fact that it’s easier and more understandable is one of the main reasons why Pinocchio doesn’t use bytecodes.

Since we don’t use bytecodes, supporting native methods in the meta-circular interpreter is as easy as just pushing them through to the meta-interpreter, i.e. the interpreter that is running our meta-circular interpreter:

This is pretty easy to do and makes all natives of the meta-interpreter automatically available to our meta-circular interpreter, by just adding one native that knows how to handle native methods.

Now there is a problem with this approach. Natives in Smalltalk come in two varieties. The most common use from the point of view of the user of the language is that primitives are there only to augment the experience with behavior unavailable in the language itself; thus giving access to features that are nice to have, such as integer addition, file handling or 3D acceleration. These are easy  to support since it doesn’t matter which interpreter the request comes from, the result is always the same, as long as the receiver and arguments are passed correctly. They can be supported by language symbiosis; a method where the host-language provides a type of scripting access to it’s libraries.

However, a second set of primitives is way more important: they add support for Behavioral Reflection to the application-level. Primitives are always a way of communicating something from the application-level to the interpreter-level: they flag that the application wants to do something that only the interpreter knows to do.

By just forwarding requests directly to the meta-interpreter, we actually miss all the invocations that are only there for reflective purposes. Those primitives are supposed to end up in the interpreter-level, not in the meta-interpreter. The most important example available is the set of #value methods implemented on BlockClosure. BlockClosures in Smalltalk aren’t handled specially by the interpreter, you call them by sending them a message that ends up in the primitive that supports the family of messages such as #value. This is a very clean way of implementing it, but also forces us to support Behavioral Reflection from the ground up, if we want to be able to implement meta-circular interpreters that get support from the main interpreter.

Since (semi-)meta-circular interpreters (at least in Pinocchio) are supposed to be able to overwrite and/or extend all pieces of their own behavior, this means that natives performing reflection will need to communicate with the actual interpreter that’s interpreting it. We need to be able to catch the #value message so that we can actually create a BlockContext frame and interpret the closure. And preferably without having a big switch that checks to see if one of the invoked primitives is a reflective one. Should we now add a second type of method, the Reflective Method? Hardcode it in the reflective methods themselves?

I don’t have a solution yet, but it seemed interesting to write down some of my recent insights; and to start documenting our work on Pinocchio a bit.

The main idea is very simple but powerful: an object is a procedure which takes a symbol and some extra values as input. The result is the result of evaluating a produre identified by the symbol.

We can start here with a very simple but stupid example of an “object”:

> (define i 0)
> (define counter (lambda (msg . arguments)
     (set! i (+ i (car arguments)))
     i)
> (counter 'inc 10)
10

Now we have global state and a function which increments the state every time you call it. Or in other words, each message you send to the object will result in an increment of a global variable i.

Obviously you don’t want objects to mutate global state, but rather it’s own state. The accessible state of an object here is bound by the lexical scope of a function. Knowing this, we can make the state of objects object-local by making sure that it’s only in the scope of the “function” which we use as object later on. We can do this as follows:

> (define counter
     (let ((i 0))
          (lambda (msg . arguments)
               (set! i (car arguments))
               i)))
> (counter 'inc 10)
10

Now our counter doesn’t mutate global scope anymore, but only the i of the let in which the lambda is scoped. Since only the lambda sees the i, we have effectively created an object with only one slot, i. Now obviously we can start using the fact that we have more information inside the lambda. We could use the msg to invoke different kinds of behavior, and use the given arguments accordingly:

> (define counter
       (let ((i 0))
           (lambda (msg . arguments)
                     (case msg
                          ((inc) (set! i (+ i (car arguments))))
                          ((print) (display i))
                          (else (error "Msg not understood: " msg arguments))))))
> (counter 'inc 10)
> (counter 'print)
10

Counter in this case is a single object encapsulating it’s own behaviour. While useful, it’s often more useful to have a way of making new objects of the same kind. This can easily be done by just wrapping a function around the definition of the counter:

> (define make-counter
       (lambda ()
           (let ((i 0))
               (lambda (msg . arguments)
                    (case msg
                          ((inc) (set! i (+ i (car arguments))))
                          ((print) (display i))
                          (else (error "Msg not understood: " msg arguments)))))))
> (define counter (make-counter))
> (counter 'inc 10)
> (counter 'print)
10

If we execute “make-counter”, we generate a new scope and get a lambda back from that specific new scope. Each call to make-counter this generates a new object, as objects are defined by the scope in which the behaviour is enclosed.

To make it a bit more complete, we probably also want to initialize the “instance variables” to a specific value when we make a new object. This even simplified the resulting code:

> (define make-counter
       (lambda (i)
             (lambda (msg . arguments)
                    (case msg
                          ((inc) (set! i (+ i (car arguments))))
                          ((print) (display i))
                          (else (error "Msg not understood: " msg arguments))))))
> (define counter (make-counter 2))
> (counter 'print)
2
> (counter 'inc 4)
> (counter 'print)
6

Since i is now an argument to the “class” make-counter, each time you create an “instance” i is initialized with the value passed to the “constructor”. And that’s that!

SchemeTalk builds further on this idea and builds an OO language (internal DSL?) in scheme with it, until the programmar can use the system as if he was programming in Smalltalk, rather than just using LOLs to emulate objects.

Actors are objects which ensure that there is always just one thread running in them. This eliminates race conditions on the object (and its object graph). In order to ensure this constraint; actors are supposed to only link to objects which are owned by the actor. Sharing objects would make the system able to violate the rule of having always just one thread running through the actor. So basically, an actor is a process running on its own data space.

Communication between actors works by sending asynchronous messages. Messages are put in the inbox (a message queue) of an actor. The actor itself will just take messages out of the inbox and evaluate them one by one. The way of making the actor threadsafe is by just making the inbox synchronized using monitors. The actor itself respects the locks on the inbox, but since it is the only thread running on the data space of the actor, this is the only way of synchronization required in actors. The data passed around as arguments of messages is supposed to be copied before use inside the actor. Otherwise this would again violate the principle of containment. This of course is not true when a reference to an actor is passed. In that case, a message send to the actor would just be another asynchronous message send, not violating the containment principle of the sending actor.

Asynchronous message sends do not directly return their result as normal message sends would. Often such message sends return a null-type object, indicating that they don’t have a direct result. Asynchronous messages often “return” a result by sending an asynchronous message to the sender of the original message. Another possibility is that asynchronous messages return special objects called futures. Such futures are objects representing the promise of having the result whenever it is available. They are objects which will contain the result when the calculating actor fills it in. Until then, we can test if the result is already there; or block until the result is there.

For simplicity, our model does not enforce asynchronous message sends to actors, it will just allow to do asynchronous calls. This is not safe but it makes the implementation more straightforwards. Secondly we also do not manually copy non-actor data structures passed to the actor. This again is just because of laziness, not because it is a nice design choice.

So basically, our models needs:

• An actor class which lets all its instances have an inbox. When a message is put in the inbox, the thread running through the actor will take it out at some point and invoke the actual method belonging to it. The actor always just has one thread running through it.
• An asynchronous method class which, rather than directly being invoked, schedules itself in the inbox of the actor on which it is called. At the same time as a synchronous result it gives the calling object…
• …a future. The future class is a class of objects which can only be filled in by the result of the actual invocation of the native method contained in the asynchronous method. The result can be polled and read by everybody who has access to the future. The future is a read-only object which will hold the result of the asynchronous computation.
• The message box class ensures that all accesses are synchronized accesses. This ensures that the inbox, the only shared piece of data between the actor and the outside world, is always free from race conditions.

We start by our implementation with the message box.

(define message-box
    (new-class message-box object-class (queue sema) ()
        ((enqueue (el) (self 'on-sema (lambda () ((self 'get-queue) 'enqueue el))))
         (dequeue () (self 'on-sema (lambda () ((self 'get-queue) 'dequeue))))
         (empty? () (self 'on-sema (lambda () ((self 'get-queue) 'empty?))))
         (on-sema (action)
             (let ((sema (self 'get-sema)))
                 (dynamic-wind (lambda () (semaphore-wait sema))
                               action
                               (lambda () (semaphore-post sema)))))
         (initialize ()
             (self 'set-queue! (queue 'new))
             (self 'set-sema! (make-semaphore 1))))
        ()))

Our class has an internal queue of elements, and a semaphore making sure all access is done one by one. We simply wait on the semaphore before doing an action, perform the action and then free the semaphore.

The implementation of the actor class is the most complex in our system. It ensures that its instances have an inbox. Next to that, in has two extra semaphores. These semaphores ensure that adding a message to the inbox as well as for the actor to check if there are still messages in the inbox; are also synchronized operations. This allows us let a thread run in the actors just as long as there are messages in the inbox. When a new message appears in the inbox and no thread is running yet through the actor, a thread is spawned. When a thread is already running, adding a new message will now spawn a new thread. A thread running through an actor will invoke message by message as long as there are messages. Once their are no more messages the thread stops. The complex system of semaphores just makes sure that while adding a new message, the actors does not think that there is already a thread running; while that thread just decided to stop itself because there is no more message; resulting in the message to wait forever for computation in the inbox.

(define actor
  (new-class Actor object-class (inbox sema sema2) ()
             ((enqueue (msg)
                       (semaphore-wait (self 'get-sema2))
                       ((self 'get-inbox) 'enqueue msg)
                       (self 'act))
              (act ()
                   (let ((sema (self 'get-sema))
                         (sema2 (self 'get-sema2)))
                     ; Max 1 thread for acting
                     (when (semaphore-try-wait? sema)
                       (semaphore-post sema2)
                       (thread
                        (lambda ()
                          (let ((inbox (self 'get-inbox)))
                            (let until-empty ((msg (inbox 'dequeue)))
                              ; We never die on failing messages.
                              (call-with-current-continuation
                               (lambda (cont) (dynamic-wind void msg cont)))
                              (semaphore-wait sema2)
                              (if (inbox 'empty?)
                                  (semaphore-post sema)
                                  (begin
                                    (semaphore-post sema2)
                                    (until-empty (inbox 'dequeue)))))))))
                     (semaphore-post sema2)))
              (initialize ()
                          (self 'set-sema! (make-semaphore 1))
                          (self 'set-sema2! (make-semaphore 1))
                          (self 'set-inbox! (message-box 'new))))
             ()))

So in order to implement this, every invocation of enqueue will end with an invocation of act. The act method will spawn a thread if no thread is running yet. The new thread will stop once there is no more message in the inbox. To make sure that there is always a thread running, there is one lock making sure that the following two actions are atomic:

• Adding a message to the inbox and checking if a thread is running,
• and checking the inbox and deciding to stop or continue evaluating.

These two actions are made exclusive by use of sema2. We test if a thread is running by use of the other semaphore, sema. If the semaphore is in use, this means that a thread is running. This is polled with semaphore-try-wait?.

Futures are easily implemented using the single-assign-slot which we don’t discuss in this article, but which behaviour is very straightforward. It just makes slots (instance variables) immutable after they are assigned to once.

Asynchronous methods are metamethods which as metabehaviour will just queue the actual behaviour in the inbox of the actor on which they are called. The return a new future when they are invoked. The actual behaviour queued in the inbox is a lambda which ensures that the actual asynchronous method has access to a return construct as well as to the future object.

(define async-metamethod
  (metamethod 'with-meta-behaviour
              (method args
                      (let ((future (future-class 'new)))
                        ((self 'get-self)
                         'enqueue
                         (lambda ()
                           (let ((result
                                  (call-with-current-continuation
                                   (lambda (return)
                                     (let* ((method ((self 'get-behaviour) future return))
                                            (boundmethod (method 'bind (self 'get-super) (self 'get-self))))
                                       (apply boundmethod (cons 'execute args)))))))
                             (when (not (eq? result future))
                               (future 'set! result)))))
                        future))))

Asynchronous methods themselves can depend on the result of the execution of other asynchronous methods. Consider for example an implementation of fibonacci in an asynchronous setting. Here every calculation of fib(n) depends on fib(n-1) and fib(n-2). A fib actor probably wants to use itself for the recursive computation. However, if this is done asynchronously, while sending the message to itself and waiting for the future to be filled in; it would block the recursive computation infinitely by waiting itself on the result. For that reason we split up asynchronous methods in two parts. First the actor can compute stuff and send messages and receive futures. Then in a special construct let-future it is allowed to handle the results of calls. While we do not enforce this in our implementation; here the actor is not allowed to access its own data. It is only allowed to combine the results of the futures somehow.

Using the let-future construct just defined, we can use our actor-model to implement the fibonacci actor:

(define fib
  (new-class FibTest actor () ()
             ((fib (async-method (i)
                                 (if (< i 2)
                                     1
                                     (let-future ((first (self 'fib (- i 1)))
                                                  (second (self 'fib (- i 2))))
                                                 (+ first second 1))))))
             ()))

The fibonacci class is a subclass of actor. In implements one async-method fib. In here, it will recursively call fib. When the results of the computation are ready, the body of the let-future will be activated. This result will be filled in into the future which the given asynchronous invocation returned.

—-

Now as a fun extra, we can use actors to implement remote (asynchronous) procedure calls. To do so, we need to implement two types of actor, the remote actor and the server actor. The server actor will handle the network communication between a local actor and the remote actor. The remote actor acts as proxy of the local actor on the side of the server actor. Every message sent to the remote actor is forwarded to the server actor, which will again put the message in the inbox of the actual local actor. Messages are sent by serializing the requests. A simple implementation only allows us to serialize primitive scheme objects. Once implemented, we can use this as follows:

(define fib
  (new-class Fib actor () ()
             ((fib (async-method (i) (self 'calc-fib i)))
              (void (async-method () (let ((a 1)) (set! a 2))))
              (calc-fib (method (i)
                                (if (< i 2)
                                    1
                                    (+ (self 'calc-fib (- i 1))
                                       (self 'calc-fib (- i 2)))))))
             ()))

(server-actor 'new (fib 'new) 4500)

(define remote-fib (remote-actor 'new "localhost" 4500))
(define remote-fib2 (remote-actor 'new "localhost" 4500))
(define res (remote-fib 'fib 24))
(define res2 (remote-fib2 'fib 25))
(display "setup\n")
(res2 'get-result)
(display "got 2\n")
(res 'get-result)
(display "got 1\n")

> (define hello
    (new-class Hello object-class () () ()
        ((hi () (display "Hello") (newline)))))
> (define hi (hello 'bind 'hi))

Now we have a bound-method hi which encapsulates the behaviour of the hi class-method; which is in this case bound to the hello class, with the superclass of the metaclass of the hello class as starting class for next lookup.

Bound methods can then be executed:

> (hi 'execute)
Hello

Since bound methods are normal objects, we can also rebind self and super.

Now we can put objects polymorph to methods in the method dictionary as a way to change the behaviour of methods. As an example I will discuss an implementation of metamethods; a type of methods equivalent to decorators in Python.

The idea of metamethods is that we want to be able to easily build new types of methods. This we do by having a method which represents the meta-behaviour of other methods. This metabehaviour can be shared by multiple actual methods, and the metabehaviour will govern the way that the actual method will be executed.

As an example, we build a metamethod which wraps around other methods, and always adds “20″ to the result of the actual method:

> (define my-metamethod
    (metamethod 'with-meta-behaviour
                (method args
                    (+ 20 (self 'execute-behaviour-with-args args)))))

Our metamethod defines a meta-behaviour which executes the actual behaviour with the arguments passed to the metamethod, adds 20 to the result and returns that value. As you can see, our meta-behaviour will wrap around whatever the actual method will do, and can decide whether or not to execute the real method; and when.

Now this meta-method can be used as follows:

> (define a-test-class
    (new-class TestClass object-class (abcde) ()
        ((the-method
            (my-metamethod 'with-behaviour
                (method (a) (* a
                               (self 'get-abcde))))))
        ()))

So we define a class with one method. This one method is not a normal method, but a method wrapped inside our my-metamethod. Now as a proof that it works:

> (define a-test (a-test-class 'new))
> (a-test 'set-abcde! 10)
> (a-test 'the-method 2)
40

So we get 2*10 in the main method, plus 20 of the meta-method which wraps around the metamethod.

Now more importantly, we go over to the actual implementation of metamethod, since this is not something which is directly supported by SchemeTalk, but rather an implementation built on top of SchemeTalk by just using the extensive meta-object protocol for methods.

First, a metamethod is a class which is instantiated by informing it which its meta-behaviour is. That returns something which can be told which its actual behaviour is. That again is polymorph to a method, and thus should be able to be bound to a self and a super. This bound-method-with-meta result should be executable.

So first:

> (define metamethod
    (new-class MetaMethod object-class (meta-behaviour) ()
        ((with-behaviour (behaviour)
            (let ((method (method-with-meta 'new)))
                (method 'set-behaviour! behaviour)
                (method 'set-metamethod! self)
                method)))
        ((with-meta-behaviour (meta-behaviour)
            (let ((result (self 'new)))
                (result 'set-meta-behaviour! meta-behaviour)
                result)))))

The result of adding meta-behaviour is an instance of a meta-method. The result of adding behaviour to a meta-method is a method-with-meta instances which has a behaviour; and a link back to the meta-behaviour. Now we implement method-with-meta:

> (define method-with-meta
    (new-class MethodWithMeta method-class (behaviour metamethod) ()
             ((get-meta-behaviour ()
                    ((self 'get-metamethod) 'get-meta-behaviour))
              (bind (asuper aself)
                    (let ((bound-method (bound-method-with-meta 'on self)))
                      (bound-method 'set-super! asuper)
                      (bound-method 'set-self! aself)
                      bound-method)))
             ()))

This method can be bound. That will return a bound method, where super and self are stored in the object. The method is shared between all bound methods.

> (define bound-method-with-meta
    (new-class BoundMethodWithMeta boundmethod-class
        (method bound-meta self super) ()
        ((get-behaviour () ((self 'get-method) 'get-behaviour))
         (execute-behaviour-with-args (args)
            (apply ((self 'get-behaviour) 'bind
                (self 'get-super) (self 'get-self))
                (cons 'execute args)))
         (get-meta-behaviour () ((self 'get-method) 'get-meta-behaviour))
         (execute args
            (apply (self 'get-bound-meta)
                (cons 'execute args)))
         (initialize ()
            (self 'set-bound-meta! ((self 'get-meta-behaviour) 'bind super self))))
        ((on (method-with-meta)
            (let ((result (self 'basic-new)))
                (result 'set-method! method-with-meta)
                (result 'initialize)
                result)))))

When bound methods are executed, it will actually execute the bound-method-with-meta. Self of the method will not be the actual instance on which you are calling it, but the bound-method-with-meta. That method can however give you access to the actual self, as it is stored as an instance variable in the bound-method-with-meta object. For convenience it provides you with a method execute-behaviour-with-args, which executes the actual behaviour which is bound to our meta-method.

> (define slot-class
    (new-class Slot object-class (value) ()
        ((get () (self 'get-value))
         (set! (value) (self 'set-value! value))
         (initialize (owner)
            (self 'set-value! )))
        ()))

Every slot is an instance of such a class. They are created when the instance which will hold them is created. This instance is passed to the slot object for convenience; but not used by the standard slots. By default, as stated before, the value of a slot is set to a marker marking that the slot is not yet initialized.

The automatically generated getter methods will call get on the slot; the setters set!.

While not visible in the new-class syntax used up to now, for every slot definition, a slot class used for that slot is passed. By default the built-in slot-class is passed, which looks basically like the aforementioned definition. If we want to customize a slot, we can pass around another definition at class definition time.

> (define single-assignable-slot
    (new-class SingleAssignableSlot object-class (value) ()
        ((get () (self 'get-value))
         (set! (new)
            (when (initialized? (self 'get))
                (error "Already has a value!"))
            (self 'set-value! new))
         (initialize (owner) self))
        ()))

The previous class defines a slot-class which makes slots immutable after they have been initialized. Now we can create a person class with an immutable name-slot:

> (define person
    (new-class Person object-class
        ((name single-assignable-slot)) ()
        ((initialize (name) (self 'set-name! name)))
        ()))

The syntax for an instance variable using a default slot is just placing the identifier for the slot. Specifying a specific slotclass is done by using the syntax ([slot-identifier] [slot-class]).

When we create an instance of such a class, we can pass an initial name.

> (define me (person 'new "my name"))

Now we have an object who’s name is immutable. If we try to overwrite the name, we get an error:

> (me 'set-name! "my new name")

SchemeTalk stacktrace:

Instance of SingleAssignableSlot (SingleAssignableSlot): set! (my new name)

. . Already has a value!

As you can see in the output, SchemeTalk provides us with a nice, typically object-oriented stacktrace as debugging mechanism. This helps us hide info about intermediate procedure calls done by scheme for the evaluation of message sends.

1) Download DrScheme from plt-scheme.org and install.
2) Select the Pretty Big language in DrScheme.
3) Download SchemeTalk from subversion or a prebuilt plt file, in which case you go to step 5.
4) Open make.ss in DrScheme and run. This will produce a schemetalk .plt file.
5) In DrScheme, click on File>Install .plt File

now SchemeTalk is setup and you are ready to go.

2. Getting Started

In order to load SchemeTalk into your Scheme environment, require schemetalk.

> (require schemetalk)

Now your environment is setup with the basics to start building classes and instances.

> (define my-class (new-class MyClass object-class () () () ()))

The previous snippet builds a class called “MyClass”, which is accessible in the current environment by use of the identifier my-class. The class has object-class as superclass, has no instance- nor class-variables nor -methods. Here we see that all top-level classes have object-class as default superclass.
Note that this is not obligatory. The only requirements are that
object is the superclass of the root-class as a marker and that the
doesnotunderstand method does something useful in case of an un-found selector. Using object-class as superclass is just an easy way to ensure that these requirements are met.

Now we can build instances of our class by using:

> (define instance (my-class 'new))

As you might have noticed, as in Smalltalk, my-class is bound to an object which responds to messages as any other object. Classes respond to the message new to build new instances. These instances will be linked back to its class as you would inspect. Objects and classes behave like functions would in regular scheme. Messages are sent by passing it as the [first argument] of the [call] of the object. Arguments of messages are passed as subsequent arguments.

Lets now have a look at our newly created instance:

> (instance 'inspect)
((class "MyClass class"))

When we send inspect to an instance, by default you get a shallow printout of all its instance variables. Since our class doesn’t have any declared instance variables, we just have the automatically inserted class instance variable.
Note that this instance variable can not be removed, it can only be reassigned to another class

Since classes are also objects, we can also send inspect to our class:

> (my-class 'inspect)
((class "MyClass-metaclass")
 (methoddictionary "Instance of MethodDictionary")
 (instance-variables ())
 (superclass "Object class")
 (name MyClass))

Note that next to the textual inspector, there is also a graphical inspector pre-built around which allows you to browse through the object-graph:

> (require schemetalk/inspector)

Now lets create a new class “Person” with an instance variable “name”.

> (define person
    (new-class Person object-class
        (name) ()
        ((initialize (name) (self 'set-name! name)))
        ()))

The first of four lists in the new-class construct lists the instance variables of a class. The second its class variables. Then the instance methods and finally the class methods. Our class has one instance variable name and one instance method initialize which takes one argument as input.

> (define me (person 'new "My Name"))

Here we see the first part of the extensive built-in meta-object protocol. Just like in Smalltalk, the default new method first calls basic-new on itself, and then calls initialize on the result of basic-new; the newly created instance. Unlike in Smalltalk, this method is allowed to take arguments. It is implemented as:

(define new-method
  (method args
          (let ((result (self 'basic-new)))
            (apply result (cons 'initialize args))
            result)))

The second thing that can be noticed is that instance variables are not referenced by variable-names which are magically around in the correct scope, as in smalltalk, but by doing a self-send with the protocol set-[instance-variable-name]!. Getters are automatically installed as get-[instance-variable-name].

The only variables which are magically created in the scope of a method are self and super. Self is bound to the object to which the message was sent. Super is bound to an object encapsulating “self” and a pointer to the superclass of the class where the current method was found; as in other well-known object-oriented programming languages.

> (me 'inspect)
((class "Person class") (name "My Name"))

Using class variables and methods works in the same way as instance variables and methods. Class variables are stored per class. So if we have a subclass of a class with an instance variable, it will inherit the instance variable from its superclass, but it will not contain the same value as its superclass.

> (define person (new-class Person object-class () (sex) () ()))
> (define male
    (new-class Male person () () ()
        ((initialize () (self 'set-sex! "male")))))
> (male 'initialize)
> (male 'get-sex)
"male"
> (person 'get-sex)
un-initialized-slot2422

Here we see another part of the default behaviour of slots (variable holders of instances) in Schemetalk: if no value was set (and is thus not yet initialized), a special symbol is returned on accessing the slot, making that it is not yet initialized.

This can be tested by use of the function initialized?:

> (initialized? (person 'get-sex))
#f
> (initialized? (male 'get-sex))
#t