/* dl_vms.xs
*
- * Platform: OpenVMS, VAX or AXP
+ * Platform: OpenVMS, VAX or AXP or IA64
* Author: Charles Bailey bailey@newman.upenn.edu
- * Revised: 12-Dec-1994
+ * Revised: See http://public.activestate.com/cgi-bin/perlbrowse
*
* Implementation Note
* This section is added as an aid to users and DynaLoader developers, in
#include "perl.h"
#include "XSUB.h"
-/* N.B.:
- * dl_debug and dl_last_error are static vars; you'll need to deal
- * with them appropriately if you need context independence
- */
-
#include <descrip.h>
#include <fscndef.h>
#include <lib$routines.h>
/* $PutMsg action routine - records error message in dl_last_error */
static vmssts
-copy_errmsg(msg,unused)
- struct dsc$descriptor_s * msg;
- vmssts unused;
+copy_errmsg(struct dsc$descriptor_s *msg, vmssts unused)
{
+ dTHX;
dMY_CXT;
if (*(msg->dsc$a_pointer) == '%') { /* first line */
- if (dl_last_error)
- strncpy((dl_last_error = saferealloc(dl_last_error,msg->dsc$w_length+1)),
- msg->dsc$a_pointer, msg->dsc$w_length);
- else
- strncpy((dl_last_error = safemalloc(msg->dsc$w_length+1)),
- msg->dsc$a_pointer, msg->dsc$w_length);
- dl_last_error[msg->dsc$w_length] = '\0';
+ sv_setpvn(MY_CXT.x_dl_last_error, msg->dsc$a_pointer, (STRLEN)msg->dsc$w_length);
}
else { /* continuation line */
- int errlen = strlen(dl_last_error);
- dl_last_error = saferealloc(dl_last_error, errlen + msg->dsc$w_length + 2);
- dl_last_error[errlen] = '\n'; dl_last_error[errlen+1] = '\0';
- strncat(dl_last_error, msg->dsc$a_pointer, msg->dsc$w_length);
- dl_last_error[errlen+msg->dsc$w_length+1] = '\0';
+ sv_catpvn(MY_CXT.x_dl_last_error, msg->dsc$a_pointer, (STRLEN)msg->dsc$w_length);
}
+ DLDEBUG(2,PerlIO_printf(Perl_debug_log, "Saved error message: %s\n", dl_last_error));
return 0;
}
/* Use $PutMsg to retrieve error message for failure status code */
static void
-dl_set_error(sts,stv)
- vmssts sts;
- vmssts stv;
+dl_set_error(vmssts sts, vmssts stv)
{
vmssts vec[3];
dTHX;
_ckvmssts(sys$putmsg(vec,copy_errmsg,0,0));
}
-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;
- while (--args) myvec[args] = usig[args];
- _ckvmssts(sys$putmsg(myvec,copy_errmsg,0,0));
- DLDEBUG(2,PerlIO_printf(Perl_debug_log, "findsym_handler: received\n\t%s\n",dl_last_error));
- return SS$_CONTINUE;
-}
-
/* wrapper for lib$find_image_symbol, so signalled errors can be saved
* for dl_error and then returned */
static unsigned long int
struct dsc$descriptor_s *defspec)
{
unsigned long int retsts;
- VAXC$ESTABLISH(findsym_handler);
+ VAXC$ESTABLISH(lib$sig_to_ret);
retsts = lib$find_image_symbol(imgname,symname,entry,defspec,DL_CASE_SENSITIVE);
return retsts;
}
dl_generic_private_init(aTHX);
{
dMY_CXT;
- dl_require_symbols = get_av("DynaLoader::dl_require_symbols", 0x4);
+ dl_require_symbols = get_av("DynaLoader::dl_require_symbols", GV_ADDMULTI);
/* Set up the static control blocks for dl_expand_filespec() */
dl_fab = cc$rms_fab;
dl_nam = cc$rms_nam;
}
void
-dl_load_file(filespec, flags)
- char * filespec
+dl_load_file(filename, flags=0)
+ char * filename
int flags
PREINIT:
dTHX;
+ dMY_CXT;
char vmsspec[NAM$C_MAXRSS];
SV *reqSV, **reqSVhndl;
STRLEN deflen;
struct libref *dlptr;
vmssts sts, failed = 0;
void (*entry)();
- dMY_CXT;
CODE:
- DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", filespec,flags));
- specdsc.dsc$a_pointer = tovmsspec(filespec,vmsspec);
+ DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", filename,flags));
+ specdsc.dsc$a_pointer = tovmsspec(filename,vmsspec);
specdsc.dsc$w_length = strlen(specdsc.dsc$a_pointer);
- DLDEBUG(2,PerlIO_printf(Perl_debug_log, "\tVMS-ified filespec is %s\n",
+ if (specdsc.dsc$w_length == 0) { /* undef in, empty out */
+ XSRETURN_EMPTY;
+ }
+ DLDEBUG(2,PerlIO_printf(Perl_debug_log, "\tVMS-ified filename is %s\n",
specdsc.dsc$a_pointer));
- New(1399,dlptr,1,struct libref);
+ Newx(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;
- New(1097, dlptr->defspec.dsc$a_pointer, dlptr->defspec.dsc$w_length + 1, char);
+ Newx(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,
void (*entry)();
vmssts sts;
- DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_find_dymbol(%.*s,%.*s):\n",
+ DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_find_symbol(%.*s,%.*s):\n",
thislib.name.dsc$w_length, thislib.name.dsc$a_pointer,
symdsc.dsc$w_length,symdsc.dsc$a_pointer));
sts = my_find_image_symbol(&(thislib.name),&symdsc,
DLDEBUG(2,PerlIO_printf(Perl_debug_log, "\tentry point is %d\n",
(unsigned long int) entry));
if (!(sts & 1)) {
- /* error message already saved by findsym_handler */
+ dl_set_error(sts,0);
ST(0) = &PL_sv_undef;
}
else ST(0) = sv_2mortal(newSViv(PTR2IV(entry)));
dl_install_xsub(perl_name, symref, filename="$Package")
char * perl_name
void * symref
- char * filename
+ const char * filename
CODE:
DLDEBUG(2,PerlIO_printf(Perl_debug_log, "dl_install_xsub(name=%s, symref=%x)\n",
perl_name, symref));
- ST(0) = sv_2mortal(newRV((SV*)newXS(perl_name,
- (void(*)(pTHX_ CV *))symref,
- filename)));
+ ST(0) = sv_2mortal(newRV((SV*)newXS_flags(perl_name,
+ (void(*)(pTHX_ CV *))symref,
+ filename, NULL,
+ XS_DYNAMIC_FILENAME)));
char *
OUTPUT:
RETVAL
+#if defined(USE_ITHREADS)
+
+void
+CLONE(...)
+ CODE:
+ MY_CXT_CLONE;
+
+ /* MY_CXT_CLONE just does a memcpy on the whole structure, so to avoid
+ * using Perl variables that belong to another thread, we create our
+ * own for this thread.
+ */
+ MY_CXT.x_dl_last_error = newSVpvn("", 0);
+ dl_require_symbols = get_av("DynaLoader::dl_require_symbols", GV_ADDMULTI);
+
+#endif
+
# end.
https://perl5.git.perl.org / perl5.git / blobdiff