Commit | Line | Data |
6e7c9e4d |
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 | |