static long incompartment;
static SV*
-exec_in_REXX(char *cmd, char * handlerName, RexxFunctionHandler *handler)
+exec_in_REXX(pTHX_ char *cmd, char * handlerName, RexxFunctionHandler *handler)
{
dTHR;
HMODULE hRexx, hRexxAPI;
LONG rc;
SV *res;
- if (incompartment) die ("Attempt to reenter into REXX compartment");
+ if (incompartment)
+ Perl_die(aTHX_ "Attempt to reenter into REXX compartment");
incompartment = 1;
if (DosLoadModule(buf, sizeof buf, "REXX", &hRexx)
(PFN *)&pRexxRegisterFunctionExe)
|| DosQueryProcAddr(hRexxAPI, 0, "RexxDeregisterFunction",
(PFN *)&pRexxDeregisterFunction)) {
- die("REXX not available\n");
+ Perl_die(aTHX_ "REXX not available\n");
}
if (handlerName)
} else {
res = NEWSV(729,0);
}
- if (rc || SvTRUE(GvSV(errgv))) {
- if (SvTRUE(GvSV(errgv))) {
- die ("Error inside perl function called from REXX compartment.\n%s", SvPV(GvSV(errgv), na)) ;
+ if (rc || SvTRUE(GvSV(PL_errgv))) {
+ if (SvTRUE(GvSV(PL_errgv))) {
+ STRLEN n_a;
+ Perl_die(aTHX_ "Error inside perl function called from REXX compartment.\n%s", SvPV(GvSV(PL_errgv), n_a)) ;
}
- die ("REXX compartment returned non-zero status %li", rc);
+ Perl_die(aTHX_ "REXX compartment returned non-zero status %li", rc);
}
return res;
return PERLCALL(NULL, argc, argv, queue, ret);
}
-#define in_rexx_compartment() exec_in_REXX("return StartPerl()\r\n", \
+#define in_rexx_compartment() exec_in_REXX(aTHX_ "return StartPerl()\r\n", \
"StartPerl", PERLSTART)
#define REXX_call(cv) ( exec_cv = (cv), in_rexx_compartment())
#define REXX_eval_with(cmd,name,cv) ( exec_cv = (cv), \
- exec_in_REXX(cmd,name,PERLSTART))
+ exec_in_REXX(aTHX_ cmd,name,PERLSTART))
#define REXX_eval(cmd) REXX_eval_with(cmd,NULL,NULL)
static ULONG
PERLCALL(PSZ name, ULONG argc, PRXSTRING argv, PSZ queue, PRXSTRING ret)
{
+ dTHX;
EXCEPTIONREGISTRATIONRECORD xreg = { NULL, _emx_exception };
int i, rc;
unsigned long len;
}
static int
-not_here(s)
-char *s;
-{
- croak("%s not implemented on this architecture", s);
- return -1;
-}
-
-static int
-constant(name, arg)
-char *name;
-int arg;
+constant(char *name, int arg)
{
errno = EINVAL;
return 0;
char * name
int arg
-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);
- }
-
int
_set(name,value,...)
char * name
var->shvname.strlength, var->shvname.strptr,
namelen, var->shvvalue.strptr);
if (var->shvret & RXSHV_NEWV || !var->shvvalue.strptr)
- PUSHs(&sv_undef);
+ PUSHs(&PL_sv_undef);
else
PUSHs(sv_2mortal(newSVpv(var->shvvalue.strptr,
namelen)));
PUSHs(sv_2mortal(newSVpv(sv.shvvalue.strptr, valuelen)));
DosFreeMem(sv.shvvalue.strptr);
} else
- PUSHs(&sv_undef);
+ PUSHs(&PL_sv_undef);
} else if (rc != RXSHV_LVAR) {
die("Error %i when in _next", rc);
} else {