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
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; } Copyright © 2001 O'Reilly & Associates. All rights reserved. |
|