1 files changed, 72 insertions, 0 deletions
diff --git a/os2/OS2/REXX/DLL/DLL.xs b/os2/OS2/REXX/DLL/DLL.xs
new file mode 100644
index 0000000000..c8e7c58007
--- /dev/null
+++ b/os2/OS2/REXX/DLL/DLL.xs
@@ -0,0 +1,72 @@
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+#define INCL_BASE
+#define INCL_REXXSAA
+#include <os2emx.h>
+
+static RXSTRING * strs;
+static int	  nstrs;
+static char *	  trace;
+
+static void
+needstrs(int n)
+{
+    if (n > nstrs) {
+	if (strs)
+	    free(strs);
+	nstrs = 2 * n;
+	strs = malloc(nstrs * sizeof(RXSTRING));
+    }
+}
+
+MODULE = OS2::DLL		PACKAGE = OS2::DLL
+
+BOOT:
+    needstrs(8);
+    trace = getenv("PERL_REXX_DEBUG");
+
+SV *
+_call(name, address, queue="SESSION", ...)
+	char *		name
+	void *		address
+	char *		queue
+ CODE:
+   {
+       ULONG	rc;
+       int	argc, i;
+       RXSTRING	result;
+       UCHAR	resbuf[256];
+       RexxFunctionHandler *fcn = address;
+       argc = items-3;
+       needstrs(argc);
+       if (trace)
+	   fprintf(stderr, "REXXCALL::_call name: '%s' args:", name);
+       for (i = 0; i < argc; ++i) {
+	   STRLEN len;
+	   char *ptr = SvPV(ST(3+i), len);
+	   MAKERXSTRING(strs[i], ptr, len);
+	   if (trace)
+	       fprintf(stderr, " '%.*s'", len, ptr);
+       }
+       if (!*queue)
+	   queue = "SESSION";
+       if (trace)
+	   fprintf(stderr, "\n");
+       MAKERXSTRING(result, resbuf, sizeof resbuf);
+       rc = fcn(name, argc, strs, queue, &result);
+       if (trace)
+	   fprintf(stderr, "  rc=%X, result='%.*s'\n", rc,
+		   result.strlength, result.strptr);
+       ST(0) = sv_newmortal();
+       if (rc == 0) {
+	   if (result.strptr)
+	       sv_setpvn(ST(0), result.strptr, result.strlength);
+	   else
+	       sv_setpvn(ST(0), "", 0);
+       }
+       if (result.strptr && result.strptr != resbuf)
+	   DosFreeMem(result.strptr);
+   }
+