static int nvars;
static char * trace;
+/*
static RXSTRING rxcommand = { 9, "RXCOMMAND" };
static RXSTRING rxsubroutine = { 12, "RXSUBROUTINE" };
static RXSTRING rxfunction = { 11, "RXFUNCTION" };
+*/
static ULONG PERLCALL(PCSZ name, ULONG argc, PRXSTRING argv, PCSZ queue, PRXSTRING ret);
static long incompartment;
+static LONG APIENTRY (*pRexxStart) (LONG, PRXSTRING, PSZ, PRXSTRING,
+ PSZ, LONG, PRXSYSEXIT, PSHORT, PRXSTRING);
+static APIRET APIENTRY (*pRexxRegisterFunctionExe) (PSZ,
+ RexxFunctionHandler *);
+static APIRET APIENTRY (*pRexxDeregisterFunction) (PSZ);
+
+static ULONG (*pRexxVariablePool) (PSHVBLOCK pRequest);
+
static SV*
exec_in_REXX(pTHX_ char *cmd, char * handlerName, RexxFunctionHandler *handler)
{
- HMODULE hRexx, hRexxAPI;
- BYTE buf[200];
- LONG APIENTRY (*pRexxStart) (LONG, PRXSTRING, PSZ, PRXSTRING,
- PSZ, LONG, PRXSYSEXIT, PSHORT, PRXSTRING);
- APIRET APIENTRY (*pRexxRegisterFunctionExe) (PSZ,
- RexxFunctionHandler *);
- APIRET APIENTRY (*pRexxDeregisterFunction) (PSZ);
RXSTRING args[1];
RXSTRING inst[2];
RXSTRING result;
Perl_die(aTHX_ "Attempt to reenter into REXX compartment");
incompartment = 1;
- if (DosLoadModule(buf, sizeof buf, "REXX", &hRexx)
- || DosLoadModule(buf, sizeof buf, "REXXAPI", &hRexxAPI)
- || DosQueryProcAddr(hRexx, 0, "RexxStart", (PFN *)&pRexxStart)
- || DosQueryProcAddr(hRexxAPI, 0, "RexxRegisterFunctionExe",
- (PFN *)&pRexxRegisterFunctionExe)
- || DosQueryProcAddr(hRexxAPI, 0, "RexxDeregisterFunction",
- (PFN *)&pRexxDeregisterFunction)) {
- Perl_die(aTHX_ "REXX not available\n");
- }
-
if (handlerName)
pRexxRegisterFunctionExe(handlerName, handler);
incompartment = 0;
pRexxDeregisterFunction("StartPerl");
+#if 0 /* Do we want to restore these? */
DosFreeModule(hRexxAPI);
DosFreeModule(hRexx);
+#endif
if (!RXNULLSTRING(result)) {
res = newSVpv(RXSTRPTR(result), RXSTRLEN(result));
DosFreeMem(RXSTRPTR(result));
int i, rc;
unsigned long len;
char *str;
- char **arr;
SV *res;
dSP;
static void
initialize(void)
{
+ *(PFN *)&pRexxStart = loadByOrdinal(ORD_RexxStart, 1);
+ *(PFN *)&pRexxRegisterFunctionExe
+ = loadByOrdinal(ORD_RexxRegisterFunctionExe, 1);
+ *(PFN *)&pRexxDeregisterFunction
+ = loadByOrdinal(ORD_RexxDeregisterFunction, 1);
+ *(PFN *)&pRexxVariablePool = loadByOrdinal(ORD_RexxVariablePool, 1);
needstrs(8);
needvars(8);
trace = getenv("PERL_REXX_DEBUG");
MAKERXSTRING(var->shvvalue, value, valuelen);
if (trace)
fprintf(stderr, " %.*s='%.*s'",
- var->shvname.strlength, var->shvname.strptr,
- var->shvvalue.strlength, var->shvvalue.strptr);
+ (int)var->shvname.strlength, var->shvname.strptr,
+ (int)var->shvvalue.strlength, var->shvvalue.strptr);
}
if (trace)
fprintf(stderr, "\n");
vars[n-1].shvnext = NULL;
- rc = RexxVariablePool(vars);
+ rc = pRexxVariablePool(vars);
if (trace)
- fprintf(stderr, " rc=%X\n", rc);
+ fprintf(stderr, " rc=%#lX\n", rc);
RETVAL = (rc & ~RXSHV_NEWV) ? FALSE : TRUE;
}
OUTPUT:
if (trace)
fprintf(stderr, "\n");
vars[items-1].shvnext = NULL;
- rc = RexxVariablePool(vars);
+ rc = pRexxVariablePool(vars);
if (!(rc & ~RXSHV_NEWV)) {
for (i = 0; i < items; ++i) {
int namelen;
namelen = var->shvvaluelen; /* is */
if (trace)
fprintf(stderr, " %.*s='%.*s'\n",
- var->shvname.strlength, var->shvname.strptr,
+ (int)var->shvname.strlength, var->shvname.strptr,
namelen, var->shvvalue.strptr);
if (var->shvret & RXSHV_NEWV || !var->shvvalue.strptr)
PUSHs(&PL_sv_undef);
}
} else {
if (trace)
- fprintf(stderr, " rc=%X\n", rc);
+ fprintf(stderr, " rc=%#lX\n", rc);
}
}
DosFreeMem(sv.shvvalue.strptr);
MAKERXSTRING(sv.shvvalue, NULL, 0);
}
- rc = RexxVariablePool(&sv);
+ rc = pRexxVariablePool(&sv);
} while (!rc && memcmp(stem, sv.shvname.strptr, len) != 0);
if (!rc) {
EXTEND(SP, 2);
die("Error %i when in _next", rc);
} else {
if (trace)
- fprintf(stderr, " rc=%X\n", rc);
+ fprintf(stderr, " rc=%#lX\n", rc);
}
}
MAKERXSTRING(var->shvvalue, NULL, 0);
}
vars[items-1].shvnext = NULL;
- RETVAL = (RexxVariablePool(vars) & ~RXSHV_NEWV) ? FALSE : TRUE;
+ RETVAL = (pRexxVariablePool(vars) & ~RXSHV_NEWV) ? FALSE : TRUE;
}
OUTPUT:
RETVAL
_register(name)
char * name
CODE:
- RETVAL = RexxRegisterFunctionExe(name, PERLCALL);
+ RETVAL = pRexxRegisterFunctionExe(name, PERLCALL);
OUTPUT:
RETVAL