/* dl_vms.xs
*
* Platform: OpenVMS, VAX or AXP
- * Author: Charles Bailey bailey@genetics.upenn.edu
+ * Author: Charles Bailey bailey@newman.upenn.edu
* Revised: 12-Dec-1994
*
* Implementation Note
vmssts stv;
{
vmssts vec[3];
+ dTHX;
vec[0] = stv ? 2 : 1;
vec[1] = sts; vec[2] = stv;
static unsigned int
findsym_handler(void *sig, void *mech)
{
+ dTHX;
unsigned long int myvec[8],args, *usig = (unsigned long int *) sig;
/* Be paranoid and assume signal vector passed in might be readonly */
myvec[0] = args = usig[0] > 10 ? 9 : usig[0] - 1;
static void
-dl_private_init()
+dl_private_init(pTHX)
{
- dl_generic_private_init();
- dl_require_symbols = perl_get_av("DynaLoader::dl_require_symbols", 0x4);
+ dl_generic_private_init(aTHX);
+ dl_require_symbols = get_av("DynaLoader::dl_require_symbols", 0x4);
/* Set up the static control blocks for dl_expand_filespec() */
dlfab = cc$rms_fab;
dlnam = cc$rms_nam;
MODULE = DynaLoader PACKAGE = DynaLoader
BOOT:
- (void)dl_private_init();
+ (void)dl_private_init(aTHX);
void
dl_expandspec(filespec)
DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "\tSYNCHK sys$parse = %d\n",sts));
if (!(sts & 1)) {
dl_set_error(dlfab.fab$l_sts,dlfab.fab$l_stv);
- ST(0) = &sv_undef;
+ ST(0) = &PL_sv_undef;
}
else {
/* Now set up a default spec - everything but the name */
DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "\tname/default sys$parse = %d\n",sts));
if (!(sts & 1)) {
dl_set_error(dlfab.fab$l_sts,dlfab.fab$l_stv);
- ST(0) = &sv_undef;
+ ST(0) = &PL_sv_undef;
}
else {
/* Now find the actual file */
DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "\tsys$search = %d\n",sts));
if (!(sts & 1)) {
dl_set_error(dlfab.fab$l_sts,dlfab.fab$l_stv);
- ST(0) = &sv_undef;
+ ST(0) = &PL_sv_undef;
}
else {
- ST(0) = sv_2mortal(newSVpv(dlnam.nam$l_rsa,dlnam.nam$b_rsl));
+ ST(0) = sv_2mortal(newSVpvn(dlnam.nam$l_rsa,dlnam.nam$b_rsl));
DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "\tresult = \\%.*s\\\n",
dlnam.nam$b_rsl,dlnam.nam$l_rsa));
}
}
void
-dl_load_file(filespec)
+dl_load_file(filespec, flags)
char * filespec
- CODE:
+ int flags
+ PREINIT:
+ dTHX;
char vmsspec[NAM$C_MAXRSS];
SV *reqSV, **reqSVhndl;
STRLEN deflen;
struct libref *dlptr;
vmssts sts, failed = 0;
void (*entry)();
+ CODE:
- DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dl_load_file(%s):\n",filespec));
+ DLDEBUG(1,PerlIO_printf(PerlIO_stderr(), "dl_load_file(%s,%x):\n", filespec,flags));
specdsc.dsc$a_pointer = tovmsspec(filespec,vmsspec);
specdsc.dsc$w_length = strlen(specdsc.dsc$a_pointer);
DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "\tVMS-ified filespec is %s\n",
specdsc.dsc$a_pointer));
- New(7901,dlptr,1,struct libref);
+ New(1399,dlptr,1,struct libref);
dlptr->name.dsc$b_dtype = dlptr->defspec.dsc$b_dtype = DSC$K_DTYPE_T;
dlptr->name.dsc$b_class = dlptr->defspec.dsc$b_class = DSC$K_CLASS_S;
sts = sys$filescan(&specdsc,namlst,0);
dlptr->name.dsc$w_length = namlst[0].len;
dlptr->name.dsc$a_pointer = savepvn(namlst[0].string,namlst[0].len);
dlptr->defspec.dsc$w_length = specdsc.dsc$w_length - namlst[0].len;
- dlptr->defspec.dsc$a_pointer = safemalloc(dlptr->defspec.dsc$w_length + 1);
+ New(1097, dlptr->defspec.dsc$a_pointer, dlptr->defspec.dsc$w_length + 1, char);
deflen = namlst[0].string - specdsc.dsc$a_pointer;
memcpy(dlptr->defspec.dsc$a_pointer,specdsc.dsc$a_pointer,deflen);
memcpy(dlptr->defspec.dsc$a_pointer + deflen,
Safefree(dlptr->name.dsc$a_pointer);
Safefree(dlptr->defspec.dsc$a_pointer);
Safefree(dlptr);
- ST(0) = &sv_undef;
+ ST(0) = &PL_sv_undef;
}
else {
- ST(0) = sv_2mortal(newSViv((IV) dlptr));
+ ST(0) = sv_2mortal(newSViv(PTR2IV(dlptr)));
}
(unsigned long int) entry));
if (!(sts & 1)) {
/* error message already saved by findsym_handler */
- ST(0) = &sv_undef;
+ ST(0) = &PL_sv_undef;
}
- else ST(0) = sv_2mortal(newSViv((IV) entry));
+ else ST(0) = sv_2mortal(newSViv(PTR2IV(entry)));
void
CODE:
DLDEBUG(2,PerlIO_printf(PerlIO_stderr(), "dl_install_xsub(name=%s, symref=%x)\n",
perl_name, symref));
- ST(0)=sv_2mortal(newRV((SV*)newXS(perl_name, (void(*)())symref, filename)));
+ ST(0) = sv_2mortal(newRV((SV*)newXS(perl_name,
+ (void(*)(pTHX_ CV *))symref,
+ filename)));
char *