os2/OS2/REXX/DLL/DLL.xs

   1 #include "EXTERN.h"
   2 #include "perl.h"
   3 #include "XSUB.h"
   4
   5 #define INCL_BASE
   6 #define INCL_REXXSAA
   7 #include <os2emx.h>
   8
   9 static RXSTRING * strs;
  10 static int        nstrs;
  11 static char *     trace;
  12
  13 static void
  14 needstrs(int n)
  15 {
  16     if (n > nstrs) {
  17         if (strs)
  18             free(strs);
  19         nstrs = 2 * n;
  20         strs = malloc(nstrs * sizeof(RXSTRING));
  21     }
  22 }
  23
  24 MODULE = OS2::DLL               PACKAGE = OS2::DLL
  25
  26 BOOT:
  27     needstrs(8);
  28     trace = getenv("PERL_REXX_DEBUG");
  29
  30 SV *
  31 _call(name, address, queue="SESSION", ...)
  32         char *          name
  33         void *          address
  34         char *          queue
  35  CODE:
  36    {
  37        ULONG    rc;
  38        int      argc, i;
  39        RXSTRING result;
  40        UCHAR    resbuf[256];
  41        RexxFunctionHandler *fcn = address;
  42        argc = items-3;
  43        needstrs(argc);
  44        if (trace)
  45            fprintf(stderr, "REXXCALL::_call name: '%s' args:", name);
  46        for (i = 0; i < argc; ++i) {
  47            STRLEN len;
  48            char *ptr = SvPV(ST(3+i), len);
  49            MAKERXSTRING(strs[i], ptr, len);
  50            if (trace)
  51                fprintf(stderr, " '%.*s'", len, ptr);
  52        }
  53        if (!*queue)
  54            queue = "SESSION";
  55        if (trace)
  56            fprintf(stderr, "\n");
  57        MAKERXSTRING(result, resbuf, sizeof resbuf);
  58        rc = fcn(name, argc, strs, queue, &result);
  59        if (trace)
  60            fprintf(stderr, "  rc=%X, result='%.*s'\n", rc,
  61                    result.strlength, result.strptr);
  62        ST(0) = sv_newmortal();
  63        if (rc == 0) {
  64            if (result.strptr)
  65                sv_setpvn(ST(0), result.strptr, result.strlength);
  66            else
  67                sv_setpvn(ST(0), "", 0);
  68        }
  69        if (result.strptr && result.strptr != resbuf)
  70            DosFreeMem(result.strptr);
  71    }
  72