Next: , Previous: Smalltalk types, Up: C and Smalltalk


5.5 Calls from C to Smalltalk

gnu Smalltalk provides seven different function calls that allow you to call Smalltalk methods in a different execution context than the current one. The priority in which the method will execute will be the same as the one of Smalltalk process which is currently active.

Four of these functions are more low level and are more suited when the Smalltalk program itself gave a receiver, a selector and maybe some parameters; the others, instead, are more versatile. One of them (msgSendf) automatically handles most conversions between C data types and Smalltalk objects, while the others takes care of compiling full snippets of Smalltalk code.

All these functions handle properly the case of specifying, say, 5 arguments for a 3-argument selector—see the description of the single functions for more information).

In all cases except msgSendf, passing NULL as the selector will expect the receiver to be a block and evaluate it.

— Function: OOP msgSend (OOP receiver, OOP selector, ...)

This function sends the given selector (should be a Symbol, otherwise nilOOP is returned) to the given receiver. The message arguments should also be OOPs (otherwise, an access violation exception is pretty likely) and are passed in a NULL-terminated list after the selector. The value returned from the method is passed back as an OOP to the C program as the result of msgSend, or nilOOP if the number of arguments is wrong. Example (same as 1 + 2):

              OOP shouldBeThreeOOP = vmProxy->msgSend(
                  intToOOP(1),
                  symbolToOOP("+"),
                  intToOOP(2),
                  NULL);
     
— Function: OOP strMsgSend (OOP receiver, char *selector, ...)

This function is the same as above, but the selector is passed as a C string and is automatically converted to a Smalltalk symbol.

Theoretically, this function is a bit slower than msgSend if your program has some way to cache the selector and avoiding a call to symbolToOOP on every call-in. However, this is not so apparent in “real” code because the time spent in the Smalltalk interpreter will usually be much higher than the time spent converting the selector to a Symbol object. Example:

              OOP shouldBeThreeOOP = vmProxy->strMsgSend(
                  intToOOP(1),
                  "+",
                  intToOOP(2),
                  NULL);
     
— Function: OOP vmsgSend (OOP receiver, OOP selector, OOP *args)

This function is the same as msgSend, but accepts a pointer to the NULL-terminated list of arguments, instead of being a variable-arguments functions. Example:

              OOP arguments[2], shouldBeThreeOOP;
              arguments[0] = intToOOP(2);
              arguments[1] = NULL;
              /* ... some more code here ... */
          
              shouldBeThreeOOP = vmProxy->vmsgSend(
                  intToOOP(1),
                  symbolToOOP("+"),
                  arguments);
     
— Function: OOP nvmsgSend (OOP receiver, OOP selector, OOP *args, int nargs)

This function is the same as msgSend, but accepts an additional parameter containing the number of arguments to be passed to the Smalltalk method, instead of relying on the NULL-termination of args. Example:

              OOP argument, shouldBeThreeOOP;
              argument = intToOOP(2);
              /* ... some more code here ... */
          
              shouldBeThreeOOP = vmProxy->nvmsgSend(
                  intToOOP(1),
                  symbolToOOP("+"),
                  &argument,
                  1);
     
— Function: OOP perform (OOP, OOP)

Shortcut function to invoke a unary selector. The first parameter is the receiver, and the second is the selector.

— Function: OOP performWith (OOP, OOP, OOP)

Shortcut function to invoke a one-argument selector. The first parameter is the receiver, the second is the selector, the third is the sole argument.

— Function: OOP invokeHook (int)

Calls into Smalltalk to process a ObjectMemory hook given by the parameter. In practice, changed: is sent to ObjectMemory with a symbol derived from the parameter. The parameter can be one of:

All cases where the last three should be used should be covered in gnu Smalltalk's source code. The first three, however, can actually be useful in user code.

The two functions that directly accept Smalltalk code are named evalCode and evalExpr, and they're basically the same. They both accept a single parameter, a pointer to the code to be submitted to the parser. The main difference is that evalCode discards the result, while evalExpr returns it to the caller as an OOP.

msgSendf, instead, has a radically different syntax. Let's first look at some examples.

         /* 1 + 2 */
         int shouldBeThree;
         vmProxy->msgSendf(&shouldBeThree, "%i %i + %i", 1, 2)
     
         /* aCollection includes: 'abc' */
         OOP aCollection;
         int aBoolean;
         vmProxy->msgSendf(&aBoolean, "%b %o includes: %s", aCollection, "abc")
     
         /* 'This is a test' printNl -- in two different ways */
         vmProxy->msgSendf(NULL, "%v %s printNl", "This is a test");
         vmProxy->msgSendf(NULL, "%s %s printNl", "This is a test");
     
         /* 'This is a test', ' ok?' */
         char *str;
         vmProxy->msgSendf(&str, "%s %s , %s", "This is a test", " ok?");

As you can see, the parameters to msgSendf are, in order:

Note that the receiver and parameters are NOT registered in the object registry (see Smalltalk types). receiver_type and paramX_type can be any of these characters, with these meanings:

           Specifier        C data type        equivalent Smalltalk class
               i                long           Integer (see intToOOP)
               f               double          Float (see floatToOOP)
               F            long double        Float (see longDoubleToOOP)
               b                int            True or False (see boolToOOP)
               B                OOP            BlockClosure
               c                char           Character (see charToOOP)
               C               PTR             CObject (see cObjToOOP)
               s               char *          String (see stringToOOP)
               S               char *          Symbol (see symbolToOOP)
               o                OOP            any
               t            char *, PTR        CObject (see below)
               T              OOP, PTR         CObject (see below)
               w              wchar_t          Character (see wcharToOOP)
               W             wchar_t *         UnicodeString (see wstringToOOP)

`%t' and `%T' are particular in the sense that you need to pass two additional arguments to msgSendf, not one. The first will be a description of the type of the CObject to be created, the second instead will be the CObject's address. If you specify `%t', the first of the two arguments will be converted to a Smalltalk CType via typeNameToOOP (see Smalltalk types); instead, if you specify `%T', you will have to directly pass an OOP for the new CObject's type.

For `%B' you should not pass a selector, and the block will be evaluated.

The type specifiers you can pass for result_type are a bit different:

                 Result
     Specifier   if nil    C data type      expected result
        i         0L          long          nil or an Integer
        f         0.0        double         nil or a Float
        F         0.0     long double       nil or a Float
        b          0          int           nil or a Boolean
        c        '\0'         char          nil or a Character
        C        NULL        PTR            nil or a CObject
        s        NULL        char *         nil, a String, or a Symbol
        ?         0      char *, PTR        See oopToC
        o       nilOOP        OOP           any (result is not converted)
        w        '\0'       wchar_t         nil or a Character
        W        NULL      wchar_t *        nil or a UnicodeString
        v                      /            any (result is discarded)

Note that, if resultPtr is NULL, the result_type is always treated as `%v'. If an error occurs, the value in the `result if nil' column is returned.