[p5sagit/p5-mst-13.2.git] / ext / DynaLoader / dl_vms.xs

/* dl_vms.xs
 * 
 * Platform:  OpenVMS, VAX or AXP
 * Author:    Charles Bailey  bailey@genetics.upenn.edu
 * Revised:   12-Dec-1994
 *
 *                           Implementation Note
 *     This section is added as an aid to users and DynaLoader developers, in
 * order to clarify the process of dynamic linking under VMS.
 *     dl_vms.xs uses the supported VMS dynamic linking call, which allows
 * a running program to map an arbitrary file of executable code and call
 * routines within that file.  This is done via the VMS RTL routine
 * lib$find_image_symbol, whose calling sequence is as follows:
 *   status = lib$find_image_symbol(imgname,symname,symval,defspec);
 *   where
 *     status  = a standard VMS status value (unsigned long int)
 *     imgname = a fixed-length string descriptor, passed by
 *               reference, containing the NAME ONLY of the image
 *               file to be mapped.  An attempt will be made to
 *               translate this string as a logical name, so it may
 *               not contain any characters which are not allowed in
 *               logical names.  If no translation is found, imgname
 *               is used directly as the name of the image file.
 *     symname = a fixed-length string descriptor, passed by
 *               reference, containing the name of the routine
 *               to be located.
 *     symval  = an unsigned long int, passed by reference, into
 *               which is written the entry point address of the
 *               routine whose name is specified in symname.
 *     defspec = a fixed-length string descriptor, passed by
 *               reference, containing a default file specification
 *               whichis used to fill in any missing parts of the
 *               image file specification after the imgname argument
 *               is processed.
 * In order to accommodate the handling of the imgname argument, the routine
 * dl_expandspec() is provided for use by perl code (e.g. dl_findfile)
 * which wants to see what image file lib$find_image_symbol would use if
 * it were passed a given file specification.  The file specification passed
 * to dl_expandspec() and dl_load_file() can be partial or complete, and can
 * use VMS or Unix syntax; these routines perform the necessary conversions.
 *    In general, writers of perl extensions need only conform to the
 * procedures set out in the DynaLoader documentation, and let the details
 * be taken care of by the routines here and in DynaLoader.pm.  If anyone
 * comes across any incompatibilities, please let me know.  Thanks.
 *
 */

#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"

#include "dlutils.c"    /* dl_debug, LastError; SaveError not used  */
/* N.B.:
 * dl_debug and LastError 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>
#include <rms.h>
#include <ssdef.h>
#include <starlet.h>

typedef unsigned long int vmssts;

struct libref {
  struct dsc$descriptor_s name;
  struct dsc$descriptor_s defspec;
};

/* Static data for dl_expand_filespec() - This is static to save
 * initialization on each call; if you need context-independence,
 * just make these auto variables in dl_expandspec() and dl_load_file()
 */
static char dlesa[NAM$C_MAXRSS], dlrsa[NAM$C_MAXRSS];
static struct FAB dlfab;
static struct NAM dlnam;

/* $PutMsg action routine - records error message in LastError */
static vmssts
copy_errmsg(msg,unused)
    struct dsc$descriptor_s *   msg;
    vmssts  unused;
{
    if (*(msg->dsc$a_pointer) == '%') { /* first line */
      if (LastError)
        strncpy((LastError = saferealloc(LastError,msg->dsc$w_length)),
                 msg->dsc$a_pointer, msg->dsc$w_length);
      else
        strncpy((LastError = safemalloc(msg->dsc$w_length)),
                 msg->dsc$a_pointer, msg->dsc$w_length);
      return 0;
    }
    else { /* continuation line */
      int errlen = strlen(LastError);
      LastError = saferealloc(LastError, errlen + msg->dsc$w_length + 1);
      LastError[errlen] = '\n';  LastError[errlen+1] = '\0';
      strncat(LastError, msg->dsc$a_pointer, msg->dsc$w_length);
    }
}

/* Use $PutMsg to retrieve error message for failure status code */
static void
dl_set_error(sts,stv)
    vmssts  sts;
    vmssts  stv;
{
    vmssts vec[3];

    vec[0] = stv ? 2 : 1;
    vec[1] = sts;  vec[2] = stv;
    _ckvmssts(sys$putmsg(vec,copy_errmsg,0,0));
}

static void
dl_private_init()
{
    dl_generic_private_init();
    /* Set up the static control blocks for dl_expand_filespec() */
    dlfab = cc$rms_fab;
    dlnam = cc$rms_nam;
    dlfab.fab$l_nam = &dlnam;
    dlnam.nam$l_esa = dlesa;
    dlnam.nam$b_ess = sizeof dlesa;
    dlnam.nam$l_rsa = dlrsa;
    dlnam.nam$b_rss = sizeof dlrsa;
}
MODULE = DynaLoader PACKAGE = DynaLoader

BOOT:
    (void)dl_private_init();

void
dl_expandspec(filespec)
    char *	filespec
    CODE:
    char vmsspec[NAM$C_MAXRSS], defspec[NAM$C_MAXRSS];
    size_t deflen;
    vmssts sts;

    tovmsspec(filespec,vmsspec);
    dlfab.fab$l_fna = vmsspec;
    dlfab.fab$b_fns = strlen(vmsspec);
    dlfab.fab$l_dna = 0;
    dlfab.fab$b_dns = 0;
    DLDEBUG(1,fprintf(stderr,"dl_expand_filespec(%s):\n",vmsspec));
    /* On the first pass, just parse the specification string */
    dlnam.nam$b_nop = NAM$M_SYNCHK;
    sts = sys$parse(&dlfab);
    DLDEBUG(2,fprintf(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;
    }
    else {
      /* Now set up a default spec - everything but the name */
      deflen = dlnam.nam$l_name - dlesa;
      memcpy(defspec,dlesa,deflen);
      memcpy(defspec+deflen,dlnam.nam$l_type,
             dlnam.nam$b_type + dlnam.nam$b_ver);
      deflen += dlnam.nam$b_type + dlnam.nam$b_ver;
      memcpy(vmsspec,dlnam.nam$l_name,dlnam.nam$b_name);
      DLDEBUG(2,fprintf(stderr,"\tsplit filespec: name = %.*s, default = %.*s\n",
                        dlnam.nam$b_name,vmsspec,deflen,defspec));
      /* . . . and go back to expand it */
      dlnam.nam$b_nop = 0;
      dlfab.fab$l_dna = defspec;
      dlfab.fab$b_dns = deflen;
      dlfab.fab$b_fns = dlnam.nam$b_name;
      sts = sys$parse(&dlfab);
      DLDEBUG(2,fprintf(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;
      }
      else {
        /* Now find the actual file */
        sts = sys$search(&dlfab);
        DLDEBUG(2,fprintf(stderr,"\tsys$search = %d\n",sts));
        if (!(sts & 1) && sts != RMS$_FNF) {
          dl_set_error(dlfab.fab$l_sts,dlfab.fab$l_stv);
          ST(0) = &sv_undef;
        }
        else {
          ST(0) = sv_2mortal(newSVpv(dlnam.nam$l_rsa,dlnam.nam$b_rsl));
          DLDEBUG(1,fprintf(stderr,"\tresult = \\%.*s\\\n",
                            dlnam.nam$b_rsl,dlnam.nam$l_rsa));
        }
      }
    }

void
dl_load_file(filespec)
    char *	filespec
    CODE:
    char vmsspec[NAM$C_MAXRSS];
    AV *reqAV;
    SV *reqSV, **reqSVhndl;
    STRLEN deflen;
    struct dsc$descriptor_s
      specdsc = {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0},
      symdsc  = {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0};
    struct fscnlst {
      unsigned short int len;
      unsigned short int code;
      char *string;
    }  namlst[2] = {{0,FSCN$_NAME,0},{0,0,0}};
    struct libref *dlptr;
    vmssts sts, failed = 0;
    void *entry;

    DLDEBUG(1,fprintf(stderr,"dl_load_file(%s):\n",filespec));
    specdsc.dsc$a_pointer = tovmsspec(filespec,vmsspec);
    specdsc.dsc$w_length = strlen(specdsc.dsc$a_pointer);
    DLDEBUG(2,fprintf(stderr,"\tVMS-ified filespec is %s\n",
                      specdsc.dsc$a_pointer));
    New(7901,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);
    DLDEBUG(2,fprintf(stderr,"\tsys$filescan: returns %d, name is %.*s\n",
                      sts,namlst[0].len,namlst[0].string));
    if (!(sts & 1)) {
      failed = 1;
      dl_set_error(sts,0);
    }
    else {
      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);
      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,
             namlst[0].string + namlst[0].len,
             dlptr->defspec.dsc$w_length - deflen);
      DLDEBUG(2,fprintf(stderr,"\tlibref = name: %s, defspec: %.*s\n",
                        dlptr->name.dsc$a_pointer,
                        dlptr->defspec.dsc$w_length,
                        dlptr->defspec.dsc$a_pointer));
      if (!(reqAV = GvAV(gv_fetchpv("DynaLoader::dl_require_symbols",
                                     FALSE,SVt_PVAV)))
          || !(reqSVhndl = av_fetch(reqAV,0,FALSE)) || !(reqSV = *reqSVhndl)) {
        DLDEBUG(2,fprintf(stderr,"\t@dl_require_symbols empty, returning untested libref\n"));
      }
      else {
        symdsc.dsc$w_length = SvCUR(reqSV);
        symdsc.dsc$a_pointer = SvPVX(reqSV);
        DLDEBUG(2,fprintf(stderr,"\t$dl_require_symbols[0] = %.*s\n",
                          symdsc.dsc$w_length, symdsc.dsc$a_pointer));
        sts = lib$find_image_symbol(&(dlptr->name),&symdsc,
                                    &entry,&(dlptr->defspec));
        DLDEBUG(2,fprintf(stderr,"\tlib$find_image_symbol returns %d\n",sts));
        if (!(sts&1)) {
          failed = 1;
          dl_set_error(sts,0);
        }
      }
    }

    if (failed) {
      Safefree(dlptr->name.dsc$a_pointer);
      Safefree(dlptr->defspec.dsc$a_pointer);
      Safefree(dlptr);
      ST(0) = &sv_undef;
    }
    else {
      ST(0) = sv_2mortal(newSViv((IV) dlptr));
    }


void
dl_find_symbol(librefptr,symname)
    void *	librefptr
    SV *	symname
    CODE:
    struct libref thislib = *((struct libref *)librefptr);
    struct dsc$descriptor_s
      symdsc = {SvCUR(symname),DSC$K_DTYPE_T,DSC$K_CLASS_S,SvPVX(symname)};
    void (*entry)();
    vmssts sts;

    DLDEBUG(1,fprintf(stderr,"dl_find_dymbol(%.*s,%.*s):\n",
                      thislib.name.dsc$w_length, thislib.name.dsc$a_pointer,
                      symdsc.dsc$w_length,symdsc.dsc$a_pointer));
    sts = lib$find_image_symbol(&(thislib.name),&symdsc,
                                &entry,&(thislib.defspec));
    DLDEBUG(2,fprintf(stderr,"\tlib$find_image_symbol returns %d\n",sts));
    DLDEBUG(2,fprintf(stderr,"\tentry point is %d\n",
                      (unsigned long int) entry));
    if (!(sts & 1)) {
      dl_set_error(sts,0);
      ST(0) = &sv_undef;
    }
    else ST(0) = sv_2mortal(newSViv((IV) entry));


void
dl_undef_symbols()
    PPCODE:


# These functions should not need changing on any platform:

void
dl_install_xsub(perl_name, symref, filename="$Package")
    char *	perl_name
    void *	symref 
    char *	filename
    CODE:
    DLDEBUG(2,fprintf(stderr,"dl_install_xsub(name=%s, symref=%x)\n",
        perl_name, symref));
    ST(0)=sv_2mortal(newRV((SV*)newXS(perl_name, (void(*)())symref, filename)));


char *
dl_error()
    CODE:
    RETVAL = LastError ;
    OUTPUT:
      RETVAL

# end.
Commit	Line	Data
a0d0e21e	1	/* dl_vms.xs
	2	*
	3	* Platform: OpenVMS, VAX or AXP
	4	* Author: Charles Bailey bailey@genetics.upenn.edu
748a9306	5	* Revised: 12-Dec-1994
a0d0e21e	6	*
	7	* Implementation Note
	8	* This section is added as an aid to users and DynaLoader developers, in
	9	* order to clarify the process of dynamic linking under VMS.
	10	* dl_vms.xs uses the supported VMS dynamic linking call, which allows
	11	* a running program to map an arbitrary file of executable code and call
	12	* routines within that file. This is done via the VMS RTL routine
	13	* lib$find_image_symbol, whose calling sequence is as follows:
	14	* status = lib$find_image_symbol(imgname,symname,symval,defspec);
	15	* where
	16	* status = a standard VMS status value (unsigned long int)
	17	* imgname = a fixed-length string descriptor, passed by
	18	* reference, containing the NAME ONLY of the image
	19	* file to be mapped. An attempt will be made to
	20	* translate this string as a logical name, so it may
	21	* not contain any characters which are not allowed in
	22	* logical names. If no translation is found, imgname
	23	* is used directly as the name of the image file.
	24	* symname = a fixed-length string descriptor, passed by
	25	* reference, containing the name of the routine
	26	* to be located.
	27	* symval = an unsigned long int, passed by reference, into
	28	* which is written the entry point address of the
	29	* routine whose name is specified in symname.
	30	* defspec = a fixed-length string descriptor, passed by
	31	* reference, containing a default file specification
	32	* whichis used to fill in any missing parts of the
	33	* image file specification after the imgname argument
	34	* is processed.
	35	* In order to accommodate the handling of the imgname argument, the routine
	36	* dl_expandspec() is provided for use by perl code (e.g. dl_findfile)
	37	* which wants to see what image file lib$find_image_symbol would use if
	38	* it were passed a given file specification. The file specification passed
	39	* to dl_expandspec() and dl_load_file() can be partial or complete, and can
	40	* use VMS or Unix syntax; these routines perform the necessary conversions.
	41	* In general, writers of perl extensions need only conform to the
	42	* procedures set out in the DynaLoader documentation, and let the details
	43	* be taken care of by the routines here and in DynaLoader.pm. If anyone
	44	* comes across any incompatibilities, please let me know. Thanks.
	45	*
	46	*/
	47
	48	#include "EXTERN.h"
	49	#include "perl.h"
	50	#include "XSUB.h"
	51
	52	#include "dlutils.c" /* dl_debug, LastError; SaveError not used */
	53	/* N.B.:
	54	* dl_debug and LastError are static vars; you'll need to deal
	55	* with them appropriately if you need context independence
	56	*/
	57
	58	#include <descrip.h>
	59	#include <fscndef.h>
	60	#include <lib$routines.h>
	61	#include <rms.h>
	62	#include <ssdef.h>
748a9306	63	#include <starlet.h>
a0d0e21e	64
	65	typedef unsigned long int vmssts;
	66
	67	struct libref {
	68	struct dsc$descriptor_s name;
	69	struct dsc$descriptor_s defspec;
	70	};
	71
	72	/* Static data for dl_expand_filespec() - This is static to save
	73	* initialization on each call; if you need context-independence,
	74	* just make these auto variables in dl_expandspec() and dl_load_file()
	75	*/
	76	static char dlesa[NAM$C_MAXRSS], dlrsa[NAM$C_MAXRSS];
	77	static struct FAB dlfab;
	78	static struct NAM dlnam;
	79
	80	/* $PutMsg action routine - records error message in LastError */
	81	static vmssts
	82	copy_errmsg(msg,unused)
	83	struct dsc$descriptor_s * msg;
	84	vmssts unused;
	85	{
748a9306	86	if ((msg->dsc$a_pointer) == '%') { / first line */
a0d0e21e	87	if (LastError)
	88	strncpy((LastError = saferealloc(LastError,msg->dsc$w_length)),
	89	msg->dsc$a_pointer, msg->dsc$w_length);
	90	else
	91	strncpy((LastError = safemalloc(msg->dsc$w_length)),
	92	msg->dsc$a_pointer, msg->dsc$w_length);
	93	return 0;
	94	}
	95	else { /* continuation line */
	96	int errlen = strlen(LastError);
	97	LastError = saferealloc(LastError, errlen + msg->dsc$w_length + 1);
	98	LastError[errlen] = '\n'; LastError[errlen+1] = '\0';
	99	strncat(LastError, msg->dsc$a_pointer, msg->dsc$w_length);
	100	}
	101	}
	102
	103	/* Use $PutMsg to retrieve error message for failure status code */
	104	static void
	105	dl_set_error(sts,stv)
	106	vmssts sts;
	107	vmssts stv;
	108	{
748a9306	109	vmssts vec[3];
a0d0e21e	110
	111	vec[0] = stv ? 2 : 1;
	112	vec[1] = sts; vec[2] = stv;
748a9306	113	_ckvmssts(sys$putmsg(vec,copy_errmsg,0,0));
a0d0e21e	114	}
	115
	116	static void
	117	dl_private_init()
	118	{
	119	dl_generic_private_init();
	120	/* Set up the static control blocks for dl_expand_filespec() */
	121	dlfab = cc$rms_fab;
	122	dlnam = cc$rms_nam;
	123	dlfab.fab$l_nam = &dlnam;
	124	dlnam.nam$l_esa = dlesa;
	125	dlnam.nam$b_ess = sizeof dlesa;
	126	dlnam.nam$l_rsa = dlrsa;
	127	dlnam.nam$b_rss = sizeof dlrsa;
	128	}
	129	MODULE = DynaLoader PACKAGE = DynaLoader
	130
	131	BOOT:
	132	(void)dl_private_init();
	133
748a9306	134	void
a0d0e21e	135	dl_expandspec(filespec)
	136	char * filespec
	137	CODE:
	138	char vmsspec[NAM$C_MAXRSS], defspec[NAM$C_MAXRSS];
	139	size_t deflen;
	140	vmssts sts;
	141
	142	tovmsspec(filespec,vmsspec);
	143	dlfab.fab$l_fna = vmsspec;
	144	dlfab.fab$b_fns = strlen(vmsspec);
	145	dlfab.fab$l_dna = 0;
	146	dlfab.fab$b_dns = 0;
	147	DLDEBUG(1,fprintf(stderr,"dl_expand_filespec(%s):\n",vmsspec));
	148	/* On the first pass, just parse the specification string */
	149	dlnam.nam$b_nop = NAM$M_SYNCHK;
	150	sts = sys$parse(&dlfab);
	151	DLDEBUG(2,fprintf(stderr,"\tSYNCHK sys$parse = %d\n",sts));
	152	if (!(sts & 1)) {
	153	dl_set_error(dlfab.fab$l_sts,dlfab.fab$l_stv);
	154	ST(0) = &sv_undef;
	155	}
	156	else {
	157	/* Now set up a default spec - everything but the name */
748a9306	158	deflen = dlnam.nam$l_name - dlesa;
a0d0e21e	159	memcpy(defspec,dlesa,deflen);
	160	memcpy(defspec+deflen,dlnam.nam$l_type,
	161	dlnam.nam$b_type + dlnam.nam$b_ver);
	162	deflen += dlnam.nam$b_type + dlnam.nam$b_ver;
	163	memcpy(vmsspec,dlnam.nam$l_name,dlnam.nam$b_name);
	164	DLDEBUG(2,fprintf(stderr,"\tsplit filespec: name = %.s, default = %.s\n",
748a9306	165	dlnam.nam$b_name,vmsspec,deflen,defspec));
a0d0e21e	166	/* . . . and go back to expand it */
	167	dlnam.nam$b_nop = 0;
	168	dlfab.fab$l_dna = defspec;
	169	dlfab.fab$b_dns = deflen;
	170	dlfab.fab$b_fns = dlnam.nam$b_name;
	171	sts = sys$parse(&dlfab);
	172	DLDEBUG(2,fprintf(stderr,"\tname/default sys$parse = %d\n",sts));
	173	if (!(sts & 1)) {
	174	dl_set_error(dlfab.fab$l_sts,dlfab.fab$l_stv);
	175	ST(0) = &sv_undef;
	176	}
	177	else {
	178	/* Now find the actual file */
	179	sts = sys$search(&dlfab);
	180	DLDEBUG(2,fprintf(stderr,"\tsys$search = %d\n",sts));
	181	if (!(sts & 1) && sts != RMS$_FNF) {
	182	dl_set_error(dlfab.fab$l_sts,dlfab.fab$l_stv);
	183	ST(0) = &sv_undef;
	184	}
	185	else {
	186	ST(0) = sv_2mortal(newSVpv(dlnam.nam$l_rsa,dlnam.nam$b_rsl));
	187	DLDEBUG(1,fprintf(stderr,"\tresult = \\%.*s\\\n",
	188	dlnam.nam$b_rsl,dlnam.nam$l_rsa));
	189	}
	190	}
	191	}
	192
748a9306	193	void
a0d0e21e	194	dl_load_file(filespec)
	195	char * filespec
	196	CODE:
	197	char vmsspec[NAM$C_MAXRSS];
	198	AV *reqAV;
	199	SV reqSV, *reqSVhndl;
	200	STRLEN deflen;
	201	struct dsc$descriptor_s
	202	specdsc = {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0},
	203	symdsc = {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0};
	204	struct fscnlst {
	205	unsigned short int len;
	206	unsigned short int code;
	207	char *string;
748a9306	208	} namlst[2] = {{0,FSCN$_NAME,0},{0,0,0}};
a0d0e21e	209	struct libref *dlptr;
	210	vmssts sts, failed = 0;
	211	void *entry;
	212
	213	DLDEBUG(1,fprintf(stderr,"dl_load_file(%s):\n",filespec));
	214	specdsc.dsc$a_pointer = tovmsspec(filespec,vmsspec);
	215	specdsc.dsc$w_length = strlen(specdsc.dsc$a_pointer);
	216	DLDEBUG(2,fprintf(stderr,"\tVMS-ified filespec is %s\n",
	217	specdsc.dsc$a_pointer));
748a9306	218	New(7901,dlptr,1,struct libref);
a0d0e21e	219	dlptr->name.dsc$b_dtype = dlptr->defspec.dsc$b_dtype = DSC$K_DTYPE_T;
	220	dlptr->name.dsc$b_class = dlptr->defspec.dsc$b_class = DSC$K_CLASS_S;
	221	sts = sys$filescan(&specdsc,namlst,0);
	222	DLDEBUG(2,fprintf(stderr,"\tsys$filescan: returns %d, name is %.*s\n",
	223	sts,namlst[0].len,namlst[0].string));
	224	if (!(sts & 1)) {
	225	failed = 1;
	226	dl_set_error(sts,0);
	227	}
	228	else {
	229	dlptr->name.dsc$w_length = namlst[0].len;
	230	dlptr->name.dsc$a_pointer = savepvn(namlst[0].string,namlst[0].len);
	231	dlptr->defspec.dsc$w_length = specdsc.dsc$w_length - namlst[0].len;
	232	dlptr->defspec.dsc$a_pointer = safemalloc(dlptr->defspec.dsc$w_length + 1);
	233	deflen = namlst[0].string - specdsc.dsc$a_pointer;
	234	memcpy(dlptr->defspec.dsc$a_pointer,specdsc.dsc$a_pointer,deflen);
	235	memcpy(dlptr->defspec.dsc$a_pointer + deflen,
	236	namlst[0].string + namlst[0].len,
	237	dlptr->defspec.dsc$w_length - deflen);
	238	DLDEBUG(2,fprintf(stderr,"\tlibref = name: %s, defspec: %.*s\n",
	239	dlptr->name.dsc$a_pointer,
	240	dlptr->defspec.dsc$w_length,
	241	dlptr->defspec.dsc$a_pointer));
	242	if (!(reqAV = GvAV(gv_fetchpv("DynaLoader::dl_require_symbols",
	243	FALSE,SVt_PVAV)))
	244	\|\| !(reqSVhndl = av_fetch(reqAV,0,FALSE)) \|\| !(reqSV = *reqSVhndl)) {
	245	DLDEBUG(2,fprintf(stderr,"\t@dl_require_symbols empty, returning untested libref\n"));
	246	}
	247	else {
	248	symdsc.dsc$w_length = SvCUR(reqSV);
	249	symdsc.dsc$a_pointer = SvPVX(reqSV);
	250	DLDEBUG(2,fprintf(stderr,"\t$dl_require_symbols[0] = %.*s\n",
	251	symdsc.dsc$w_length, symdsc.dsc$a_pointer));
	252	sts = lib$find_image_symbol(&(dlptr->name),&symdsc,
	253	&entry,&(dlptr->defspec));
	254	DLDEBUG(2,fprintf(stderr,"\tlib$find_image_symbol returns %d\n",sts));
	255	if (!(sts&1)) {
	256	failed = 1;
	257	dl_set_error(sts,0);
	258	}
	259	}
	260	}
	261
	262	if (failed) {
	263	Safefree(dlptr->name.dsc$a_pointer);
	264	Safefree(dlptr->defspec.dsc$a_pointer);
	265	Safefree(dlptr);
	266	ST(0) = &sv_undef;
	267	}
	268	else {
748a9306	269	ST(0) = sv_2mortal(newSViv((IV) dlptr));
a0d0e21e	270	}
	271
	272
748a9306	273	void
a0d0e21e	274	dl_find_symbol(librefptr,symname)
	275	void * librefptr
	276	SV * symname
	277	CODE:
	278	struct libref thislib = ((struct libref )librefptr);
	279	struct dsc$descriptor_s
	280	symdsc = {SvCUR(symname),DSC$K_DTYPE_T,DSC$K_CLASS_S,SvPVX(symname)};
	281	void (*entry)();
	282	vmssts sts;
	283
	284	DLDEBUG(1,fprintf(stderr,"dl_find_dymbol(%.s,%.s):\n",
	285	thislib.name.dsc$w_length, thislib.name.dsc$a_pointer,
	286	symdsc.dsc$w_length,symdsc.dsc$a_pointer));
	287	sts = lib$find_image_symbol(&(thislib.name),&symdsc,
	288	&entry,&(thislib.defspec));
	289	DLDEBUG(2,fprintf(stderr,"\tlib$find_image_symbol returns %d\n",sts));
	290	DLDEBUG(2,fprintf(stderr,"\tentry point is %d\n",
	291	(unsigned long int) entry));
	292	if (!(sts & 1)) {
	293	dl_set_error(sts,0);
	294	ST(0) = &sv_undef;
	295	}
748a9306	296	else ST(0) = sv_2mortal(newSViv((IV) entry));
a0d0e21e	297
	298
	299	void
	300	dl_undef_symbols()
	301	PPCODE:
	302
	303
	304	# These functions should not need changing on any platform:
	305
	306	void
	307	dl_install_xsub(perl_name, symref, filename="$Package")
	308	char * perl_name
	309	void * symref
	310	char * filename
	311	CODE:
	312	DLDEBUG(2,fprintf(stderr,"dl_install_xsub(name=%s, symref=%x)\n",
	313	perl_name, symref));
	314	ST(0)=sv_2mortal(newRV((SV)newXS(perl_name, (void()())symref, filename)));
	315
	316
	317	char *
	318	dl_error()
	319	CODE:
	320	RETVAL = LastError ;
	321	OUTPUT:
	322	RETVAL
	323
	324	# end.