[Chapter 20] 20.6 Easy Embedding API
Author: Sriram Srinivasan
Date: 1999-07-02T01:42:50Z

#

| Chapter 20 Perl Internals |

## 20.6 Easy Embedding API

We have learned enough (and more) to implement the convenience API introduced in Chapter 19. They are `perl_call_va`, `perl_eval_va`, and the set of functions for accessing or modifying scalar values: `get_int`, `set_int`, and so on. We'll implement only `perl_call_va` in this section. `perl_eval_va` is a shorter form of this procedure since it doesn't expect any input parameters (the string to be `eval`'d contains all the information). The API functions to modify scalars are simple wrappers over `sv_set*`, `av_store`, and `hv_store`, and are left as an exercise to the reader.[12]

> [12] I've always wanted to say that! (See the Preface for the FTP site where you can download this code and other examples in this book.)

Recall that `perl_call_va` takes a NULL-terminated list of typed arguments. This list contains both input and output parameters. The following implementation processes the entire list by `XPUSH`'ing the input parameters and storing the output parameters in an array of `Out_Param` structures. Knowing the number of output parameters expected by the caller allows us to specify `G_SCALAR`, `G_ARRAY`, or `G_DISCARD`. The full code is shown in Example 20.3.

#### Example 20.3: perl_call_va Implementation

    #define MAX_PARAMS 20
    typedef struct {
        char type;
        void *pdata;
    } Out_Param;                  /* To remember the "Out" section */

    int perl_call_va (char *subname, ...)
    {
        char      *p   = NULL;
        char      *str = NULL; int i = 0; double d = 0;
        int       nret = 0;               /* number of return params expected*/
        int       ii   = 0;
        va_list   vl;
        int       out = 0;
        int       result = 0;
        Out_Param op[MAX_PARAMS];

        dSP;                               /* Standard ...    */
        ENTER;                             /*    ... Prologue */
        SAVETMPS;
        PUSHMARK(sp);
        va_start (vl, subname);
        while (p = va_arg(vl, char *)) {   /* Fetch next argument */
            switch (*p) {
            case 's' :                     /* String */
                if (out) {
                    /* Comes here if we are processing the "Out" section */
                    op[nret].pdata = (void*) va_arg(vl, char *);
                    op[nret++].type = 's';
                } else {
                    str = va_arg(vl, char *);
                    ii = strlen(str);
                    XPUSHs(sv_2mortal(newSVpv(str,ii)));
                }
                break;
            case 'i' :                    /* Integer */
                if (out) {
                    op[nret].pdata = (void*) va_arg(vl, int *);
                    op[nret++].type = 'i';
                } else {
                    ii = va_arg(vl, int);
                    XPUSHs(sv_2mortal(newSViv(ii)));
                }
                break;
            case 'd' :                    /* Double */
                if (out) {
                    op[nret].pdata = (void*) va_arg(vl, double *);
                    op[nret++].type = 'd';
                } else {
                   d = va_arg(vl, double);
                   XPUSHs(sv_2mortal(newSVnv(d)));
                }
                break;
            case 'O':
                out = 1;                      /* Out parameters starting */
                break;
            default:
                 fprintf (stderr, "perl_eval_va: Unknown option \'%c\'.\n"
                                   "Did you forget a trailing NULL ?\n", *p);
                return 0;
            }
            if (nret > MAX_PARAMS) {
                printf (stderr, "Can't accept more than %d return params\n",
                        MAX_PARAMS);
                return -1;
            }
        }
        va_end(vl);
        PUTBACK;
        /* All input parameters have been pushed on stack, and "nret" contains
         * the number of values expected back from the Perl function */
        result = perl_call_pv(subname, (nret == 0) ? G_DISCARD :
                                       (nret == 1) ? G_SCALAR  :
                                                     G_ARRAY  );
        /* Process output arguments */
        SPAGAIN;
        if (nret > result)
            nret = result;

        for (i = --nret; i >= 0; i--) {
            switch (op[i].type) {
            case 's':
                str = POPp;
                strcpy((char *)op[i].pdata, str);
                break;
            case 'i':
                *((int *)(op[i].pdata)) = POPi;
                break;
            case 'd':
                *((double *) (op[i].pdata)) = POPd;
                break;
            }
        }

        FREETMPS ;
        LEAVE ;
        return result;
    }

20.5 Meaty Extensions |  | 20.7 A Peek into the Future