home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / perl560.zip / os2 / OS2 / REXX / DLL / DLL.xs < prev    next >
Encoding:
Text File  |  1999-10-23  |  1.5 KB  |  73 lines
  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.  
  73.