| Commit | Line | Data |
|---|
| ed344e4f |
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 | |
projects / p5sagit/p5-mst-13.2.git / blame