1 #define INCL_DOSPROCESS
2 #define INCL_DOSSEMAPHORES
3 #define INCL_DOSMODULEMGR
5 #define INCL_DOSEXCEPTIONS
11 * "The Road goes ever on and on, down from the door where it began."
16 /* sbrk is limited to first heap segement so make it big */
17 #pragma runopts(HEAP(8M,500K,ANYWHERE,KEEP,8K,4K) STACK(,,ANY,) ALL31(ON))
19 #pragma runopts(HEAP(2M,500K,ANYWHERE,KEEP,8K,4K) STACK(,,ANY,) ALL31(ON))
27 static void xs_init (pTHX);
28 static PerlInterpreter *my_perl;
30 #if defined (__MINT__) || defined (atarist)
31 /* The Atari operating system doesn't have a dynamic stack. The
32 stack size is determined from this value. */
33 long _stksize = 64 * 1024;
36 /* Register any extra external extensions */
38 /* Do not delete this line--writemain depends on it */
39 EXTERN_C void boot_DynaLoader (pTHX_ CV* cv);
44 char *file = __FILE__;
46 newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
49 int perlos2_is_inited;
54 /* static char *env[1] = {NULL}; */
56 Perl_OS2_init3(0, 0, 0);
60 init_perl(int doparse)
63 char *argv[3] = {"perl_in_REXX", "-e", ""};
65 if (!perlos2_is_inited) {
66 perlos2_is_inited = 1;
72 my_perl = perl_alloc();
75 perl_construct(my_perl);
76 PL_perl_destruct_level = 1;
80 exitstatus = perl_parse(my_perl, xs_init, 3, argv, (char **)NULL);
84 /* The REXX-callable entrypoints ... */
86 ULONG PERL (PCSZ name, LONG rargc, const RXSTRING *rargv,
87 PCSZ queuename, PRXSTRING retstr)
91 char *argv[3] = {"perl_from_REXX", "-e", buf};
95 sprintf(retstr->strptr, "one argument expected, got %ld", rargc);
96 retstr->strlength = strlen (retstr->strptr);
99 if (rargv[0].strlength >= sizeof(buf)) {
100 sprintf(retstr->strptr,
101 "length of the argument %ld exceeds the maximum %ld",
102 rargv[0].strlength, (long)sizeof(buf) - 1);
103 retstr->strlength = strlen (retstr->strptr);
110 memcpy(buf, rargv[0].strptr, rargv[0].strlength);
111 buf[rargv[0].strlength] = 0;
113 exitstatus = perl_parse(my_perl, xs_init, 3, argv, (char **)NULL);
115 exitstatus = perl_run(my_perl);
118 perl_destruct(my_perl);
126 sprintf(retstr->strptr, "%s", "ok");
127 retstr->strlength = strlen (retstr->strptr);
133 ULONG PERLEXIT (PCSZ name, LONG rargc, const RXSTRING *rargv,
134 PCSZ queuename, PRXSTRING retstr)
137 sprintf(retstr->strptr, "no arguments expected, got %ld", rargc);
138 retstr->strlength = strlen (retstr->strptr);
145 ULONG PERLTERM (PCSZ name, LONG rargc, const RXSTRING *rargv,
146 PCSZ queuename, PRXSTRING retstr)
149 sprintf(retstr->strptr, "no arguments expected, got %ld", rargc);
150 retstr->strlength = strlen (retstr->strptr);
154 sprintf(retstr->strptr, "no perl interpreter present");
155 retstr->strlength = strlen (retstr->strptr);
158 perl_destruct(my_perl);
162 sprintf(retstr->strptr, "%s", "ok");
163 retstr->strlength = strlen (retstr->strptr);
168 ULONG PERLINIT (PCSZ name, LONG rargc, const RXSTRING *rargv,
169 PCSZ queuename, PRXSTRING retstr)
172 sprintf(retstr->strptr, "no argument expected, got %ld", rargc);
173 retstr->strlength = strlen (retstr->strptr);
179 sprintf(retstr->strptr, "%s", "ok");
180 retstr->strlength = strlen (retstr->strptr);
184 ULONG PERLEVAL (PCSZ name, LONG rargc, const RXSTRING *rargv,
185 PCSZ queuename, PRXSTRING retstr)
192 sprintf(retstr->strptr, "one argument expected, got %ld", rargc);
193 retstr->strlength = strlen (retstr->strptr);
208 in = sv_2mortal(newSVpvn(rargv[0].strptr, rargv[0].strlength));
209 eval_sv(in, G_SCALAR);
215 if (SvTRUE(ERRSV) || !SvOK(res))
217 str = SvPV(res, len);
218 if (len <= 256 /* Default buffer is 256-char long */
219 || !DosAllocMem((PPVOID)&retstr->strptr, len,
220 PAG_READ|PAG_WRITE|PAG_COMMIT)) {
221 memcpy(retstr->strptr, str, len);
222 retstr->strlength = len;
232 #define INCL_DOSPROCESS
233 #define INCL_DOSSEMAPHORES
234 #define INCL_DOSMODULEMGR
236 #define INCL_DOSEXCEPTIONS
237 #define INCL_DOSERRORS
242 * "The Road goes ever on and on, down from the door where it began."
247 /* sbrk is limited to first heap segement so make it big */
248 #pragma runopts(HEAP(8M,500K,ANYWHERE,KEEP,8K,4K) STACK(,,ANY,) ALL31(ON))
250 #pragma runopts(HEAP(2M,500K,ANYWHERE,KEEP,8K,4K) STACK(,,ANY,) ALL31(ON))
258 static void xs_init (pTHX);
259 static PerlInterpreter *my_perl;
261 #if defined (__MINT__) || defined (atarist)
262 /* The Atari operating system doesn't have a dynamic stack. The
263 stack size is determined from this value. */
264 long _stksize = 64 * 1024;
267 /* Register any extra external extensions */
269 /* Do not delete this line--writemain depends on it */
270 EXTERN_C void boot_DynaLoader (pTHX_ CV* cv);
275 char *file = __FILE__;
277 newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
280 int perlos2_is_inited;
285 /* static char *env[1] = {NULL}; */
287 Perl_OS2_init3(0, 0, 0);
291 init_perl(int doparse)
294 char *argv[3] = {"perl_in_REXX", "-e", ""};
296 if (!perlos2_is_inited) {
297 perlos2_is_inited = 1;
303 my_perl = perl_alloc();
306 perl_construct(my_perl);
307 PL_perl_destruct_level = 1;
311 exitstatus = perl_parse(my_perl, xs_init, 3, argv, (char **)NULL);
315 /* The REXX-callable entrypoints ... */
317 ULONG PERL (PCSZ name, LONG rargc, const RXSTRING *rargv,
318 PCSZ queuename, PRXSTRING retstr)
322 char *argv[3] = {"perl_from_REXX", "-e", buf};
326 sprintf(retstr->strptr, "one argument expected, got %ld", rargc);
327 retstr->strlength = strlen (retstr->strptr);
330 if (rargv[0].strlength >= sizeof(buf)) {
331 sprintf(retstr->strptr,
332 "length of the argument %ld exceeds the maximum %ld",
333 rargv[0].strlength, (long)sizeof(buf) - 1);
334 retstr->strlength = strlen (retstr->strptr);
341 memcpy(buf, rargv[0].strptr, rargv[0].strlength);
342 buf[rargv[0].strlength] = 0;
344 exitstatus = perl_parse(my_perl, xs_init, 3, argv, (char **)NULL);
346 exitstatus = perl_run(my_perl);
349 perl_destruct(my_perl);
357 sprintf(retstr->strptr, "%s", "ok");
358 retstr->strlength = strlen (retstr->strptr);
364 ULONG PERLEXIT (PCSZ name, LONG rargc, const RXSTRING *rargv,
365 PCSZ queuename, PRXSTRING retstr)
368 sprintf(retstr->strptr, "no arguments expected, got %ld", rargc);
369 retstr->strlength = strlen (retstr->strptr);
376 ULONG PERLTERM (PCSZ name, LONG rargc, const RXSTRING *rargv,
377 PCSZ queuename, PRXSTRING retstr)
380 sprintf(retstr->strptr, "no arguments expected, got %ld", rargc);
381 retstr->strlength = strlen (retstr->strptr);
385 sprintf(retstr->strptr, "no perl interpreter present");
386 retstr->strlength = strlen (retstr->strptr);
389 perl_destruct(my_perl);
393 sprintf(retstr->strptr, "%s", "ok");
394 retstr->strlength = strlen (retstr->strptr);
399 ULONG PERLINIT (PCSZ name, LONG rargc, const RXSTRING *rargv,
400 PCSZ queuename, PRXSTRING retstr)
403 sprintf(retstr->strptr, "no argument expected, got %ld", rargc);
404 retstr->strlength = strlen (retstr->strptr);
410 sprintf(retstr->strptr, "%s", "ok");
411 retstr->strlength = strlen (retstr->strptr);
415 ULONG PERLEVAL (PCSZ name, LONG rargc, const RXSTRING *rargv,
416 PCSZ queuename, PRXSTRING retstr)
423 sprintf(retstr->strptr, "one argument expected, got %ld", rargc);
424 retstr->strlength = strlen (retstr->strptr);
439 in = sv_2mortal(newSVpvn(rargv[0].strptr, rargv[0].strlength));
440 eval_sv(in, G_SCALAR);
446 if (SvTRUE(ERRSV) || !SvOK(res))
448 str = SvPV(res, len);
449 if (len <= 256 /* Default buffer is 256-char long */
450 || !DosAllocMem((PPVOID)&retstr->strptr, len,
451 PAG_READ|PAG_WRITE|PAG_COMMIT)) {
452 memcpy(retstr->strptr, str, len);
453 retstr->strlength = len;