/*{{{int vmstrnenv(const char *lnm, char *eqv, unsigned long int idx, struct dsc$descriptor_s **tabvec, unsigned long int flags) */
int
-Perl_vmstrnenv(pTHX_ const char *lnm, char *eqv, unsigned long int idx,
+Perl_vmstrnenv(const char *lnm, char *eqv, unsigned long int idx,
struct dsc$descriptor_s **tabvec, unsigned long int flags)
{
char uplnm[LNM$C_NAMLENGTH+1], *cp1, *cp2;
{LNM$C_NAMLENGTH, LNM$_STRING, eqv, &eqvlen},
{0, 0, 0, 0}};
$DESCRIPTOR(crtlenv,"CRTL_ENV"); $DESCRIPTOR(clisym,"CLISYM");
-#if defined(USE_THREADS)
+#if defined(PERL_IMPLICIT_CONTEXT)
+ pTHX = NULL;
+# if defined(USE_5005THREADS)
/* We jump through these hoops because we can be called at */
/* platform-specific initialization time, which is before anything is */
/* set up--we can't even do a plain dTHX since that relies on the */
/* interpreter structure to be initialized */
- struct perl_thread *thr;
if (PL_curinterp) {
- thr = PL_threadnum? THR : (struct perl_thread*)SvPVX(PL_thrsv);
+ aTHX = PL_threadnum? THR : (struct perl_thread*)SvPVX(PL_thrsv);
+ } else {
+ aTHX = NULL;
+ }
+# else
+ if (PL_curinterp) {
+ aTHX = PERL_GET_INTERP;
} else {
- thr = NULL;
+ aTHX = NULL;
}
+
+# endif
#endif
if (!lnm || !eqv || idx > PERL_LNM_MAX_ALLOWED_INDEX) {
/*{{{ SV *my_getenv_len(const char *lnm, bool sys)*/
char *
-my_getenv_len(const char *lnm, unsigned long *len, bool sys)
+Perl_my_getenv_len(pTHX_ const char *lnm, unsigned long *len, bool sys)
{
- dTHX;
char *buf, *cp1, *cp2;
unsigned long idx = 0;
static char __my_getenv_len_eqv[LNM$C_NAMLENGTH+1];
} /* end of my_getenv_len() */
/*}}}*/
-static void create_mbx(unsigned short int *, struct dsc$descriptor_s *);
+static void create_mbx(pTHX_ unsigned short int *, struct dsc$descriptor_s *);
static void riseandshine(unsigned long int dummy) { sys$wake(0,0); }
* find, in preparation for iterating over it.
*/
{
- dTHX;
static int primed = 0;
HV *seenhv = NULL, *envhv;
char cmd[LNM$C_NAMLENGTH+24], mbxnam[LNM$C_NAMLENGTH], *buf = Nullch;
$DESCRIPTOR(clidsc,"DCL"); $DESCRIPTOR(clitabdsc,"DCLTABLES");
$DESCRIPTOR(crtlenv,"CRTL_ENV"); $DESCRIPTOR(clisym,"CLISYM");
$DESCRIPTOR(local,"_LOCAL"); $DESCRIPTOR(mbxdsc,mbxnam);
+#if defined(PERL_IMPLICIT_CONTEXT)
+ pTHX;
+#endif
#if defined(USE_THREADS) || defined(USE_ITHREADS)
static perl_mutex primenv_mutex;
MUTEX_INIT(&primenv_mutex);
#endif
+#if defined(PERL_IMPLICIT_CONTEXT)
+ /* We jump through these hoops because we can be called at */
+ /* platform-specific initialization time, which is before anything is */
+ /* set up--we can't even do a plain dTHX since that relies on the */
+ /* interpreter structure to be initialized */
+#if defined(USE_5005THREADS)
+ if (PL_curinterp) {
+ aTHX = PL_threadnum? THR : (struct perl_thread*)SvPVX(PL_thrsv);
+ } else {
+ aTHX = NULL;
+ }
+#else
+ if (PL_curinterp) {
+ aTHX = PERL_GET_INTERP;
+ } else {
+ aTHX = NULL;
+ }
+#endif
+#endif
+
if (primed || !PL_envgv) return;
MUTEX_LOCK(&primenv_mutex);
if (primed) { MUTEX_UNLOCK(&primenv_mutex); return; }
* Like setenv() returns 0 for success, non-zero on error.
*/
int
-vmssetenv(char *lnm, char *eqv, struct dsc$descriptor_s **tabvec)
+Perl_vmssetenv(pTHX_ char *lnm, char *eqv, struct dsc$descriptor_s **tabvec)
{
char uplnm[LNM$C_NAMLENGTH], *cp1, *cp2;
unsigned short int curtab, ivlnm = 0, ivsym = 0, ivenv = 0;
tmpdsc = {6,DSC$K_DTYPE_T,DSC$K_CLASS_S,0};
$DESCRIPTOR(crtlenv,"CRTL_ENV"); $DESCRIPTOR(clisym,"CLISYM");
$DESCRIPTOR(local,"_LOCAL");
- dTHX;
for (cp1 = lnm, cp2 = uplnm; *cp1; cp1++, cp2++) {
*cp2 = _toupper(*cp1);
* used for redirection of sys$error
*/
void
-Perl_vmssetuserlnm(char *name, char *eqv)
+Perl_vmssetuserlnm(pTHX_ char *name, char *eqv)
{
$DESCRIPTOR(d_tab, "LNM$PROCESS");
struct dsc$descriptor_d d_name = {0,DSC$K_DTYPE_T,DSC$K_CLASS_D,0};
* be upcased by the caller.
*/
char *
-my_crypt(const char *textpasswd, const char *usrname)
+Perl_my_crypt(pTHX_ const char *textpasswd, const char *usrname)
{
# ifndef UAI$C_PREFERRED_ALGORITHM
# define UAI$C_PREFERRED_ALGORITHM 127
*/
/*{{{int kill_file(char *name)*/
int
-kill_file(char *name)
+Perl_kill_file(pTHX_ char *name)
{
char vmsname[NAM$C_MAXRSS+1], rspec[NAM$C_MAXRSS+1];
unsigned long int jpicode = JPI$_UIC, type = ACL$C_FILE;
unsigned long int cxt = 0, aclsts, fndsts, rmsts = -1;
- dTHX;
struct dsc$descriptor_s fildsc = {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0};
struct myacedef {
unsigned char myace$b_length;
/*{{{int my_mkdir(char *,Mode_t)*/
int
-my_mkdir(char *dir, Mode_t mode)
+Perl_my_mkdir(pTHX_ char *dir, Mode_t mode)
{
STRLEN dirlen = strlen(dir);
- dTHX;
/* zero length string sometimes gives ACCVIO */
if (dirlen == 0) return -1;
/*{{{int my_chdir(char *)*/
int
-my_chdir(char *dir)
+Perl_my_chdir(pTHX_ char *dir)
{
STRLEN dirlen = strlen(dir);
- dTHX;
/* zero length string sometimes gives ACCVIO */
if (dirlen == 0) return -1;
{
FILE *fp;
char *cp;
- dTHX;
if ((fp = tmpfile())) return fp;
static void
-create_mbx(unsigned short int *chan, struct dsc$descriptor_s *namdsc)
+create_mbx(pTHX_ unsigned short int *chan, struct dsc$descriptor_s *namdsc)
{
unsigned long int mbxbufsiz;
static unsigned long int syssize = 0;
unsigned long int dviitm = DVI$_DEVNAM;
- dTHX;
char csize[LNM$C_NAMLENGTH+1];
if (!syssize) {
pInfo info;
pCBuf curr;
pCBuf curr2;
+#if defined(PERL_IMPLICIT_CONTEXT)
+ void *thx; /* Either a thread or an interpreter */
+ /* pointer, depending on how we're built */
+#endif
};
static unsigned long int
-pipe_exit_routine()
+pipe_exit_routine(pTHX)
{
pInfo info;
unsigned long int retsts = SS$_NORMAL, abort = SS$_TIMEOUT;
int sts, did_stuff, need_eof;
- dTHX;
/*
first we try sending an EOF...ignore if doesn't work, make sure we
static void
popen_completion_ast(pInfo info)
{
- dTHX;
pInfo i = open_pipes;
int iss;
if (info->in && !info->in_done) { /* only for mode=w */
if (info->in->shut_on_empty && info->in->need_wake) {
info->in->need_wake = FALSE;
- _ckvmssts(sys$dclast(pipe_tochild2_ast,info->in,0));
+ _ckvmssts_noperl(sys$dclast(pipe_tochild2_ast,info->in,0));
} else {
- _ckvmssts(sys$cancel(info->in->chan_out));
+ _ckvmssts_noperl(sys$cancel(info->in->chan_out));
}
}
info->out->shut_on_empty = TRUE;
iss = sys$qio(0,info->out->chan_in,IO$_WRITEOF|IO$M_NORSWAIT, 0, 0, 0, 0, 0, 0, 0, 0, 0);
if (iss == SS$_MBFULL) iss = SS$_NORMAL;
- _ckvmssts(iss);
+ _ckvmssts_noperl(iss);
}
if (info->err && !info->err_done) { /* we were piping stderr */
info->err->shut_on_empty = TRUE;
iss = sys$qio(0,info->err->chan_in,IO$_WRITEOF|IO$M_NORSWAIT, 0, 0, 0, 0, 0, 0, 0, 0, 0);
if (iss == SS$_MBFULL) iss = SS$_NORMAL;
- _ckvmssts(iss);
+ _ckvmssts_noperl(iss);
}
- _ckvmssts(sys$setef(pipe_ef));
+ _ckvmssts_noperl(sys$setef(pipe_ef));
}
-static unsigned long int setup_cmddsc(char *cmd, int check_img);
+static unsigned long int setup_cmddsc(pTHX_ char *cmd, int check_img);
static void vms_execfree(pTHX);
/*
*/
static unsigned short
-popen_translate(char *logical, char *result)
+popen_translate(pTHX_ char *logical, char *result)
{
int iss;
$DESCRIPTOR(d_table,"LNM$PROCESS_TABLE");
#define INITIAL_TOCHILDQUEUE 2
static pPipe
-pipe_tochild_setup(char *rmbx, char *wmbx)
+pipe_tochild_setup(pTHX_ char *rmbx, char *wmbx)
{
- dTHX;
pPipe p;
pCBuf b;
char mbx1[64], mbx2[64];
New(1368, p, 1, Pipe);
- create_mbx(&p->chan_in , &d_mbx1);
- create_mbx(&p->chan_out, &d_mbx2);
+ create_mbx(aTHX_ &p->chan_in , &d_mbx1);
+ create_mbx(aTHX_ &p->chan_out, &d_mbx2);
_ckvmssts(lib$getdvi(&dviitm, &p->chan_in, 0, &p->bufsize));
p->buf = 0;
p->curr = 0;
p->curr2 = 0;
p->info = 0;
+#ifdef PERL_IMPLICIT_CONTEXT
+ p->thx = aTHX;
+#endif
n = sizeof(CBuf) + p->bufsize;
static void
pipe_tochild1_ast(pPipe p)
{
- dTHX;
pCBuf b = p->curr;
int iss = p->iosb.status;
int eof = (iss == SS$_ENDOFFILE);
+#ifdef PERL_IMPLICIT_CONTEXT
+ pTHX = p->thx;
+#endif
if (p->retry) {
if (eof) {
static void
pipe_tochild2_ast(pPipe p)
{
- dTHX;
pCBuf b = p->curr2;
int iss = p->iosb2.status;
int n = sizeof(CBuf) + p->bufsize;
int done = (p->info && p->info->done) ||
iss == SS$_CANCEL || iss == SS$_ABORT;
+#if defined(PERL_IMPLICIT_CONTEXT)
+ pTHX = p->thx;
+#endif
do {
if (p->type) { /* type=1 has old buffer, dispose */
static pPipe
-pipe_infromchild_setup(char *rmbx, char *wmbx)
+pipe_infromchild_setup(pTHX_ char *rmbx, char *wmbx)
{
- dTHX;
pPipe p;
char mbx1[64], mbx2[64];
struct dsc$descriptor_s d_mbx1 = {sizeof mbx1, DSC$K_DTYPE_T,
unsigned int dviitm = DVI$_DEVBUFSIZ;
New(1367, p, 1, Pipe);
- create_mbx(&p->chan_in , &d_mbx1);
- create_mbx(&p->chan_out, &d_mbx2);
+ create_mbx(aTHX_ &p->chan_in , &d_mbx1);
+ create_mbx(aTHX_ &p->chan_out, &d_mbx2);
_ckvmssts(lib$getdvi(&dviitm, &p->chan_in, 0, &p->bufsize));
New(1367, p->buf, p->bufsize, char);
p->info = 0;
p->type = 0;
p->iosb.status = SS$_NORMAL;
+#if defined(PERL_IMPLICIT_CONTEXT)
+ p->thx = aTHX;
+#endif
pipe_infromchild_ast(p);
strcpy(wmbx, mbx1);
static void
pipe_infromchild_ast(pPipe p)
{
- dTHX;
int iss = p->iosb.status;
int eof = (iss == SS$_ENDOFFILE);
int myeof = (eof && (p->iosb.dvispec == mypid || p->iosb.dvispec == 0));
int kideof = (eof && (p->iosb.dvispec == p->info->pid));
+#if defined(PERL_IMPLICIT_CONTEXT)
+ pTHX = p->thx;
+#endif
if (p->info && p->info->closing && p->chan_out) { /* output shutdown */
_ckvmssts(sys$dassgn(p->chan_out));
}
static pPipe
-pipe_mbxtofd_setup(int fd, char *out)
+pipe_mbxtofd_setup(pTHX_ int fd, char *out)
{
- dTHX;
pPipe p;
char mbx[64];
unsigned long dviitm = DVI$_DEVBUFSIZ;
New(1366, p, 1, Pipe);
p->fd_out = dup(fd);
- create_mbx(&p->chan_in, &d_mbx);
+ create_mbx(aTHX_ &p->chan_in, &d_mbx);
_ckvmssts(lib$getdvi(&dviitm, &p->chan_in, 0, &p->bufsize));
New(1366, p->buf, p->bufsize+1, char);
p->shut_on_empty = FALSE;
static void
pipe_mbxtofd_ast(pPipe p)
{
- dTHX;
int iss = p->iosb.status;
int done = p->info->done;
int iss2;
int eof = (iss == SS$_ENDOFFILE);
int myeof = eof && ((p->iosb.dvispec == mypid)||(p->iosb.dvispec == 0));
int err = !(iss&1) && !eof;
-
+#if defined(PERL_IMPLICIT_CONTEXT)
+ pTHX = p->thx;
+#endif
if (done && myeof) { /* end piping */
close(p->fd_out);
static pPLOC head_PLOC = 0;
void
-free_pipelocs(void *head)
+free_pipelocs(pTHX_ void *head)
{
pPLOC p, pnext;
}
static void
-store_pipelocs()
+store_pipelocs(pTHX)
{
int i;
pPLOC p;
p->dir[NAM$C_MAXRSS] = '\0';
}
#endif
- Perl_call_atexit(&free_pipelocs, head_PLOC);
+ Perl_call_atexit(aTHX_ &free_pipelocs, head_PLOC);
}
static char *
-find_vmspipe(void)
+find_vmspipe(pTHX)
{
static int vmspipe_file_status = 0;
static char vmspipe_file[NAM$C_MAXRSS+1];
}
static FILE *
-vmspipe_tempfile(void)
+vmspipe_tempfile(pTHX)
{
char file[NAM$C_MAXRSS+1];
FILE *fp;
static PerlIO *
-safe_popen(char *cmd, char *mode)
+safe_popen(pTHX_ char *cmd, char *mode)
{
- dTHX;
static int handler_set_up = FALSE;
unsigned long int sts, flags=1; /* nowait - gnu c doesn't allow &1 */
unsigned int table = LIB$K_CLI_GLOBAL_SYM;
/* see if we can find a VMSPIPE.COM */
tfilebuf[0] = '@';
- vmspipe = find_vmspipe();
+ vmspipe = find_vmspipe(aTHX);
if (vmspipe) {
strcpy(tfilebuf+1,vmspipe);
} else { /* uh, oh...we're in tempfile hell */
- tpipe = vmspipe_tempfile();
+ tpipe = vmspipe_tempfile(aTHX);
if (!tpipe) { /* a fish popular in Boston */
if (ckWARN(WARN_PIPE)) {
Perl_warner(aTHX_ WARN_PIPE,"unable to find VMSPIPE.COM for i/o piping");
vmspipedsc.dsc$a_pointer = tfilebuf;
vmspipedsc.dsc$w_length = strlen(tfilebuf);
- if (!(setup_cmddsc(cmd,0) & 1)) { set_errno(EINVAL); return Nullfp; }
+ if (!(setup_cmddsc(aTHX_ cmd,0) & 1)) { set_errno(EINVAL); return Nullfp; }
New(1301,info,1,Info);
info->mode = *mode;
if (*mode == 'r') { /* piping from subroutine */
- info->out = pipe_infromchild_setup(mbx,out);
+ info->out = pipe_infromchild_setup(aTHX_ mbx,out);
if (info->out) {
info->out->pipe_done = &info->out_done;
info->out_done = FALSE;
return Nullfp;
}
- info->err = pipe_mbxtofd_setup(fileno(stderr), err);
+ info->err = pipe_mbxtofd_setup(aTHX_ fileno(stderr), err);
if (info->err) {
info->err->pipe_done = &info->err_done;
info->err_done = FALSE;
} else { /* piping to subroutine , mode=w*/
- info->in = pipe_tochild_setup(in,mbx);
+ info->in = pipe_tochild_setup(aTHX_ in,mbx);
info->fp = PerlIO_open(mbx, mode);
if (info->in) {
info->in->pipe_done = &info->in_done;
}
- info->out = pipe_mbxtofd_setup(fileno(stdout), out);
+ info->out = pipe_mbxtofd_setup(aTHX_ fileno(stdout), out);
if (info->out) {
info->out->pipe_done = &info->out_done;
info->out_done = FALSE;
info->out->info = info;
}
- info->err = pipe_mbxtofd_setup(fileno(stderr), err);
+ info->err = pipe_mbxtofd_setup(aTHX_ fileno(stderr), err);
if (info->err) {
info->err->pipe_done = &info->err_done;
info->err_done = FALSE;
TAINT_ENV();
TAINT_PROPER("popen");
PERL_FLUSHALL_FOR_CHILD;
- return safe_popen(cmd,mode);
+ return safe_popen(aTHX_ cmd,mode);
}
/*}}}*/
/*{{{ I32 my_pclose(FILE *fp)*/
I32 Perl_my_pclose(pTHX_ FILE *fp)
{
- dTHX;
pInfo info, last = NULL;
unsigned long int retsts;
int done, iss;
/* sort-of waitpid; use only with popen() */
/*{{{Pid_t my_waitpid(Pid_t pid, int *statusp, int flags)*/
Pid_t
-my_waitpid(Pid_t pid, int *statusp, int flags)
+Perl_my_waitpid(pTHX_ Pid_t pid, int *statusp, int flags)
{
pInfo info;
int done;
- dTHX;
for (info = open_pipes; info != NULL; info = info->next)
if (info->pid == pid) break;
static int background_process(int argc, char **argv);
-static void pipe_and_fork(char **cmargv);
+static void pipe_and_fork(pTHX_ char **cmargv);
/*{{{ void getredirection(int *ac, char ***av)*/
static void
PerlIO_printf(Perl_debug_log,"'|' and '>' may not both be specified on command line");
exit(LIB$_INVARGORD);
}
- pipe_and_fork(cmargv);
+ pipe_and_fork(aTHX_ cmargv);
}
/* Check for input from a pipe (mailbox) */
PerlIO_printf(Perl_debug_log,"Can't open output file %s as stdout",out);
exit(vaxc$errno);
}
- if (out != NULL) Perl_vmssetuserlnm("SYS$OUTPUT",out);
+ if (out != NULL) Perl_vmssetuserlnm(aTHX_ "SYS$OUTPUT",out);
if (err != NULL) {
if (strcmp(err,"&1") == 0) {
dup2(fileno(stdout), fileno(Perl_debug_log));
- Perl_vmssetuserlnm("SYS$ERROR","SYS$OUTPUT");
+ Perl_vmssetuserlnm(aTHX_ "SYS$ERROR","SYS$OUTPUT");
} else {
FILE *tmperr;
if (NULL == (tmperr = fopen(err, errmode, "mbc=32", "mbf=2")))
{
exit(vaxc$errno);
}
- Perl_vmssetuserlnm("SYS$ERROR",err);
+ Perl_vmssetuserlnm(aTHX_ "SYS$ERROR",err);
}
}
#ifdef ARGPROC_DEBUG
0
};
-static void pipe_and_fork(char **cmargv)
+static void pipe_and_fork(pTHX_ char **cmargv)
{
char subcmd[2048];
$DESCRIPTOR(cmddsc, "");
cmddsc.dsc$a_pointer = subcmd;
cmddsc.dsc$w_length = strlen(cmddsc.dsc$a_pointer);
- create_mbx(&child_chan,&mbxdsc);
+ create_mbx(aTHX_ &child_chan,&mbxdsc);
#ifdef ARGPROC_DEBUG
PerlIO_printf(Perl_debug_log, "Pipe Mailbox Name = '%s'\n", mbxdsc.dsc$a_pointer);
PerlIO_printf(Perl_debug_log, "Sub Process Command = '%s'\n", cmddsc.dsc$a_pointer);
unsigned long int iprv[(sizeof(union prvdef) + sizeof(unsigned long int) - 1) / sizeof(unsigned long int)];
unsigned short int dummy, rlen;
struct dsc$descriptor_s **tabvec;
- dTHX;
+#if defined(PERL_IMPLICIT_CONTEXT)
+ pTHX = NULL;
+#endif
struct itmlst_3 jpilist[4] = { {sizeof iprv, JPI$_IMAGPRIV, iprv, &dummy},
{sizeof rlst, JPI$_RIGHTSLIST, rlst, &rlen},
{ sizeof rsz, JPI$_RIGHTS_SIZE, &rsz, &dummy},
{ 0, 0, 0, 0} };
- _ckvmssts(sys$getjpiw(0,NULL,NULL,jpilist,iosb,NULL,NULL));
- _ckvmssts(iosb[0]);
+ _ckvmssts_noperl(sys$getjpiw(0,NULL,NULL,jpilist,iosb,NULL,NULL));
+ _ckvmssts_noperl(iosb[0]);
for (i = 0; i < sizeof iprv / sizeof(unsigned long int); i++) {
if (iprv[i]) { /* Running image installed with privs? */
- _ckvmssts(sys$setprv(0,iprv,0,NULL)); /* Turn 'em off. */
+ _ckvmssts_noperl(sys$setprv(0,iprv,0,NULL)); /* Turn 'em off. */
will_taint = TRUE;
break;
}
if (jpilist[1].bufadr != rlst) Safefree(jpilist[1].bufadr);
jpilist[1].bufadr = New(1320,mask,rsz,unsigned long int);
jpilist[1].buflen = rsz * sizeof(unsigned long int);
- _ckvmssts(sys$getjpiw(0,NULL,NULL,&jpilist[1],iosb,NULL,NULL));
- _ckvmssts(iosb[0]);
+ _ckvmssts_noperl(sys$getjpiw(0,NULL,NULL,&jpilist[1],iosb,NULL,NULL));
+ _ckvmssts_noperl(iosb[0]);
}
mask = jpilist[1].bufadr;
/* Check attribute flags for each identifier (2nd longword); protected
tabvec[tabidx]->dsc$b_dtype = DSC$K_DTYPE_T;
tabvec[tabidx]->dsc$b_class = DSC$K_CLASS_D;
tabvec[tabidx]->dsc$a_pointer = NULL;
- _ckvmssts(lib$scopy_r_dx(&len,eqv,tabvec[tabidx]));
+ _ckvmssts_noperl(lib$scopy_r_dx(&len,eqv,tabvec[tabidx]));
}
if (tabidx) { tabvec[tabidx] = NULL; env_tables = tabvec; }
* Collect all the version numbers for the current file.
*/
static void
-collectversions(dd)
- DIR *dd;
+collectversions(pTHX_ DIR *dd)
{
struct dsc$descriptor_s pat;
struct dsc$descriptor_s res;
char *p, *text, buff[sizeof dd->entry.d_name];
int i;
unsigned long context, tmpsts;
- dTHX;
/* Convenient shorthand. */
e = &dd->entry;
*/
/*{{{ struct dirent *readdir(DIR *dd)*/
struct dirent *
-readdir(DIR *dd)
+Perl_readdir(pTHX_ DIR *dd)
{
struct dsc$descriptor_s res;
char *p, buff[sizeof dd->entry.d_name];
dd->entry.d_namlen = strlen(dd->entry.d_name);
dd->entry.vms_verscount = 0;
- if (dd->vms_wantversions) collectversions(dd);
+ if (dd->vms_wantversions) collectversions(aTHX_ dd);
return &dd->entry;
} /* end of readdir() */
*/
/*{{{ void seekdir(DIR *dd,long count)*/
void
-seekdir(DIR *dd, long count)
+Perl_seekdir(pTHX_ DIR *dd, long count)
{
int vms_wantversions;
- dTHX;
/* If we haven't done anything yet... */
if (dd->count == 0)
}
static char *
-setup_argstr(SV *really, SV **mark, SV **sp)
+setup_argstr(pTHX_ SV *really, SV **mark, SV **sp)
{
- dTHX;
char *junk, *tmps = Nullch;
register size_t cmdlen = 0;
size_t rlen;
static unsigned long int
-setup_cmddsc(char *cmd, int check_img)
+setup_cmddsc(pTHX_ char *cmd, int check_img)
{
char vmsspec[NAM$C_MAXRSS+1], resspec[NAM$C_MAXRSS+1];
$DESCRIPTOR(defdsc,".EXE");
unsigned long int cxt = 0, flags = 1, retsts = SS$_NORMAL;
register char *s, *rest, *cp, *wordbreak;
register int isdcl;
- dTHX;
if (strlen(cmd) >
(sizeof(vmsspec) > sizeof(resspec) ? sizeof(resspec) : sizeof(vmsspec)))
/* {{{ bool vms_do_aexec(SV *really,SV **mark,SV **sp) */
bool
-vms_do_aexec(SV *really,SV **mark,SV **sp)
+Perl_vms_do_aexec(pTHX_ SV *really,SV **mark,SV **sp)
{
- dTHX;
if (sp > mark) {
if (vfork_called) { /* this follows a vfork - act Unixish */
vfork_called--;
else return do_aexec(really,mark,sp);
}
/* no vfork - act VMSish */
- return vms_do_exec(setup_argstr(really,mark,sp));
+ return vms_do_exec(setup_argstr(aTHX_ really,mark,sp));
}
/* {{{bool vms_do_exec(char *cmd) */
bool
-vms_do_exec(char *cmd)
+Perl_vms_do_exec(pTHX_ char *cmd)
{
- dTHX;
if (vfork_called) { /* this follows a vfork - act Unixish */
vfork_called--;
if (vfork_called < 0) {
TAINT_ENV();
TAINT_PROPER("exec");
- if ((retsts = setup_cmddsc(cmd,1)) & 1)
+ if ((retsts = setup_cmddsc(aTHX_ cmd,1)) & 1)
retsts = lib$do_command(&VMScmd);
switch (retsts) {
} /* end of vms_do_exec() */
/*}}}*/
-unsigned long int do_spawn(char *);
+unsigned long int Perl_do_spawn(pTHX_ char *);
/* {{{ unsigned long int do_aspawn(void *really,void **mark,void **sp) */
unsigned long int
-do_aspawn(void *really,void **mark,void **sp)
+Perl_do_aspawn(pTHX_ void *really,void **mark,void **sp)
{
- dTHX;
- if (sp > mark) return do_spawn(setup_argstr((SV *)really,(SV **)mark,(SV **)sp));
+ if (sp > mark) return do_spawn(setup_argstr(aTHX_ (SV *)really,(SV **)mark,(SV **)sp));
return SS$_ABORT;
} /* end of do_aspawn() */
/* {{{unsigned long int do_spawn(char *cmd) */
unsigned long int
-do_spawn(char *cmd)
+Perl_do_spawn(pTHX_ char *cmd)
{
unsigned long int sts, substs, hadcmd = 1;
- dTHX;
TAINT_ENV();
TAINT_PROPER("spawn");
hadcmd = 0;
sts = lib$spawn(0,0,0,0,0,0,&substs,0,0,0,0,0,0);
}
- else if ((sts = setup_cmddsc(cmd,0)) & 1) {
+ else if ((sts = setup_cmddsc(aTHX_ cmd,0)) & 1) {
sts = lib$spawn(&VMScmd,0,0,0,0,0,&substs,0,0,0,0,0,0);
}
/*{{{ int my_flush(FILE *fp)*/
int
-my_flush(FILE *fp)
+Perl_my_flush(pTHX_ FILE *fp)
{
int res;
if ((res = fflush(fp)) == 0 && fp) {
/*
* This routine does most of the work extracting the user information.
*/
-static int fillpasswd (const char *name, struct passwd *pwd)
+static int fillpasswd (pTHX_ const char *name, struct passwd *pwd)
{
- dTHX;
static struct {
unsigned char length;
char pw_gecos[UAI$S_OWNER+1];
* Get information for a named user.
*/
/*{{{struct passwd *getpwnam(char *name)*/
-struct passwd *my_getpwnam(char *name)
+struct passwd *Perl_my_getpwnam(pTHX_ char *name)
{
struct dsc$descriptor_s name_desc;
union uicdef uic;
unsigned long int status, sts;
- dTHX;
__pwdcache = __passwd_empty;
- if (!fillpasswd(name, &__pwdcache)) {
+ if (!fillpasswd(aTHX_ name, &__pwdcache)) {
/* We still may be able to determine pw_uid and pw_gid */
name_desc.dsc$w_length= strlen(name);
name_desc.dsc$b_dtype= DSC$K_DTYPE_T;
* Called by my_getpwent with uid=-1 to list all users.
*/
/*{{{struct passwd *my_getpwuid(Uid_t uid)*/
-struct passwd *my_getpwuid(Uid_t uid)
+struct passwd *Perl_my_getpwuid(pTHX_ Uid_t uid)
{
const $DESCRIPTOR(name_desc,__pw_namecache);
unsigned short lname;
union uicdef uic;
unsigned long int status;
- dTHX;
if (uid == (unsigned int) -1) {
do {
__pwdcache.pw_uid = uic.uic$l_uic;
__pwdcache.pw_gid = uic.uic$v_group;
- fillpasswd(__pw_namecache, &__pwdcache);
+ fillpasswd(aTHX_ __pw_namecache, &__pwdcache);
return &__pwdcache;
} /* end of my_getpwuid() */
* Get information for next user.
*/
/*{{{struct passwd *my_getpwent()*/
-struct passwd *my_getpwent()
+struct passwd *Perl_my_getpwent(pTHX)
{
return (my_getpwuid((unsigned int) -1));
}
* Finish searching rights database for users.
*/
/*{{{void my_endpwent()*/
-void my_endpwent()
+void Perl_my_endpwent(pTHX)
{
- dTHX;
if (contxt) {
_ckvmssts(sys$finish_rdb(&contxt));
contxt= 0;
*/
static int
-tz_parse(time_t *w, int *dst, char *zone, int *gmtoff)
+tz_parse(pTHX_ time_t *w, int *dst, char *zone, int *gmtoff)
{
time_t when;
struct tm *w2;
*/
/*{{{time_t my_time(time_t *timep)*/
-time_t my_time(time_t *timep)
+time_t Perl_my_time(pTHX_ time_t *timep)
{
- dTHX;
time_t when;
struct tm *tm_p;
/*{{{struct tm *my_gmtime(const time_t *timep)*/
struct tm *
-my_gmtime(const time_t *timep)
+Perl_my_gmtime(pTHX_ const time_t *timep)
{
- dTHX;
char *p;
time_t when;
struct tm *rsltmp;
/*{{{struct tm *my_localtime(const time_t *timep)*/
struct tm *
-my_localtime(const time_t *timep)
+Perl_my_localtime(pTHX_ const time_t *timep)
{
- dTHX;
time_t when, whenutc;
struct tm *rsltmp;
int dst, offset;
static const long int utime_baseadjust[2] = { 0x4beb4000, 0x7c9567 };
/*{{{int my_utime(char *path, struct utimbuf *utimes)*/
-int my_utime(char *file, struct utimbuf *utimes)
+int Perl_my_utime(pTHX_ char *file, struct utimbuf *utimes)
{
- dTHX;
register int i;
long int bintime[2], len = 2, lowbit, unixtime,
secscale = 10000000; /* seconds --> 100 ns intervals */
* on the first call.
*/
#define LOCKID_MASK 0x80000000 /* Use 0 to force device name use only */
-static mydev_t encode_dev (const char *dev)
+static mydev_t encode_dev (pTHX_ const char *dev)
{
int i;
unsigned long int f;
mydev_t enc;
char c;
const char *q;
- dTHX;
if (!dev || !dev[0]) return 0;
is_null_device(name)
const char *name;
{
- dTHX;
/* The VMS null device is named "_NLA0:", usually abbreviated as "NL:".
The underscore prefix, controller letter, and unit number are
independently optional; for our purposes, the colon punctuation
/*{{{I32 cando_by_name(I32 bit, Uid_t effective, char *fname)*/
I32
-cando_by_name(I32 bit, Uid_t effective, char *fname)
+Perl_cando_by_name(pTHX_ I32 bit, Uid_t effective, char *fname)
{
static char usrname[L_cuserid];
static struct dsc$descriptor_s usrdsc =
char vmsname[NAM$C_MAXRSS+1], fileified[NAM$C_MAXRSS+1];
unsigned long int objtyp = ACL$C_FILE, access, retsts, privused, iosb[2];
unsigned short int retlen;
- dTHX;
struct dsc$descriptor_s namdsc = {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0};
union prvdef curprv;
struct itmlst_3 armlst[3] = {{sizeof access, CHP$_ACCESS, &access, &retlen},
/*{{{ int flex_fstat(int fd, Stat_t *statbuf)*/
int
-flex_fstat(int fd, Stat_t *statbufp)
+Perl_flex_fstat(pTHX_ int fd, Stat_t *statbufp)
{
- dTHX;
if (!fstat(fd,(stat_t *) statbufp)) {
if (statbufp == (Stat_t *) &PL_statcache) *namecache == '\0';
- statbufp->st_dev = encode_dev(statbufp->st_devnam);
+ statbufp->st_dev = encode_dev(aTHX_ statbufp->st_devnam);
# ifdef RTL_USES_UTC
# ifdef VMSISH_TIME
if (VMSISH_TIME) {
/*{{{ int flex_stat(const char *fspec, Stat_t *statbufp)*/
int
-flex_stat(const char *fspec, Stat_t *statbufp)
+Perl_flex_stat(pTHX_ const char *fspec, Stat_t *statbufp)
{
- dTHX;
char fileified[NAM$C_MAXRSS+1];
char temp_fspec[NAM$C_MAXRSS+300];
int retval = -1;
do_tovmsspec(temp_fspec,namecache,0);
if (is_null_device(temp_fspec)) { /* Fake a stat() for the null device */
memset(statbufp,0,sizeof *statbufp);
- statbufp->st_dev = encode_dev("_NLA0:");
+ statbufp->st_dev = encode_dev(aTHX_ "_NLA0:");
statbufp->st_mode = S_IFBLK | S_IREAD | S_IWRITE | S_IEXEC;
statbufp->st_uid = 0x00010001;
statbufp->st_gid = 0x0001;
}
if (retval) retval = stat(temp_fspec,(stat_t *) statbufp);
if (!retval) {
- statbufp->st_dev = encode_dev(statbufp->st_devnam);
+ statbufp->st_dev = encode_dev(aTHX_ statbufp->st_devnam);
# ifdef RTL_USES_UTC
# ifdef VMSISH_TIME
if (VMSISH_TIME) {
void
-mod2fname(CV *cv)
+mod2fname(pTHX_ CV *cv)
{
dXSARGS;
char ultimate_name[NAM$C_MAXRSS+1], work_name[NAM$C_MAXRSS*8 + 1],
}
void
-init_os_extras()
+init_os_extras(pTHX)
{
char* file = __FILE__;
- dTHX;
char temp_buff[512];
if (my_trnlnm("DECC$DISABLE_TO_VMS_LOGNAME_TRANSLATION", temp_buff, 0)) {
no_translate_barewords = TRUE;
newXSproto("DynaLoader::mod2fname", mod2fname, file, "$");
newXS("File::Copy::rmscopy",rmscopy_fromperl,file);
- store_pipelocs();
+ store_pipelocs(aTHX);
return;
}
#define HAS_GETENV_SV
#define HAS_GETENV_LEN
+/* All this stiff is for the x2P programs. Hopefully they'll still work */
+#if defined(PERL_FOR_X2P)
+#ifndef aTHX_
+#define aTHX_
+#endif
+#ifndef pTHX_
+#define pTHX_
+#endif
+#ifndef pTHX
+#define pTHX
+#endif
+#endif
+
#ifndef DONT_MASK_RTL_CALLS
# ifdef getenv
# undef getenv
# endif
/* getenv used for regular logical names */
-# define getenv(v) my_getenv(v,TRUE)
+# define getenv(v) Perl_my_getenv(aTHX_ v,TRUE)
#endif
#ifdef getenv_len
# undef getenv_len
#endif
-#define getenv_len(v,l) my_getenv_len(v,l,TRUE)
+#define getenv_len(v,l) Perl_my_getenv_len(aTHX_ v,l,TRUE)
/* DECC introduces this routine in the RTL as of VMS 7.0; for now,
* we'll use ours, since it gives us the full VMS exit status. */
#define DONT_DECLARE_STD 1
/* Our own contribution to PerlShr's global symbols . . . */
-#define my_getenv_len Perl_my_getenv_len
#define prime_env_iter Perl_prime_env_iter
-#define vmssetenv Perl_vmssetenv
+#define vms_image_init Perl_vms_image_init
+#define my_tmpfile Perl_my_tmpfile
+#define vmstrnenv Perl_vmstrnenv
#if !defined(PERL_IMPLICIT_CONTEXT)
+#define my_getenv_len Perl_my_getenv_len
+#define vmssetenv Perl_vmssetenv
#define my_trnlnm Perl_my_trnlnm
-#define vmstrnenv Perl_vmstrnenv
#define my_setenv Perl_my_setenv
#define my_getenv Perl_my_getenv
#define tounixspec Perl_tounixspec
#define trim_unixpath Perl_trim_unixpath
#define opendir Perl_opendir
#define rmscopy Perl_rmscopy
+#define my_mkdir Perl_my_mkdir
+#define vms_do_aexec Perl_vms_do_aexec
+#define vms_do_exec Perl_vms_do_exec
+#define my_waitpid Perl_my_waitpid
+#define my_crypt Perl_my_crypt
+#define kill_file Perl_kill_file
+#define my_utime Perl_my_utime
+#define my_chdir Perl_my_chdir
+#define do_aspawn Perl_do_aspawn
+#define seekdir Perl_seekdir
+#define my_gmtime Perl_my_gmtime
+#define my_localtime Perl_my_localtime
+#define my_time Perl_my_time
+#define do_spawn Perl_do_spawn
+#define flex_fstat Perl_flex_fstat
+#define flex_stat Perl_flex_stat
+#define cando_by_name Perl_cando_by_name
+#define my_getpwnam Perl_my_getpwnam
+#define my_getpwuid Perl_my_getpwuid
+#define my_flush Perl_my_flush
+#define readdir Perl_readdir
#else
+#define my_getenv_len(a,b,c) Perl_my_getenv_len(aTHX_ a,b,c)
+#define vmssetenv(a,b,c) Perl_vmssetenv(aTHX_ a,b,c)
#define my_trnlnm(a,b,c) Perl_my_trnlnm(aTHX_ a,b,c)
-#define vmstrnenv(a,b,c,d,e) Perl_vmstrnenv(aTHX_ a,b,c,d,e)
#define my_setenv(a,b) Perl_my_setenv(aTHX_ a,b)
#define my_getenv(a,b) Perl_my_getenv(aTHX_ a,b)
#define tounixspec(a,b) Perl_tounixspec(aTHX_ a,b)
#define trim_unixpath(a,b,c) Perl_trim_unixpath(aTHX_ a,b,c)
#define opendir(a) Perl_opendir(aTHX_ a)
#define rmscopy(a,b,c) Perl_rmscopy(aTHX_ a,b,c)
+#define my_mkdir(a,b) Perl_my_mkdir(aTHX_ a,b)
+#define vms_do_aexec(a,b,c) Perl_vms_do_aexec(aTHX_ a,b,c)
+#define vms_do_exec(a) Perl_vms_do_exec(aTHX_ a)
+#define my_waitpid(a,b,c) Perl_my_waitpid(aTHX_ a,b,c)
+#define my_crypt(a,b) Perl_my_crypt(aTHX_ a,b)
+#define kill_file(a) Perl_kill_file(aTHX_ a)
+#define my_utime(a,b) Perl_my_utime(aTHX_ a,b)
+#define my_chdir(a) Perl_my_chdir(aTHX_ a)
+#define do_aspawn(a,b,c) Perl_do_aspawn(aTHX_ a,b,c)
+#define seekdir(a,b) Perl_seekdir(aTHX_ a,b)
+#define my_gmtime(a) Perl_my_gmtime(aTHX_ a)
+#define my_localtime(a) Perl_my_localtime(aTHX_ a)
+#define my_time(a) Perl_my_time(aTHX_ a)
+#define do_spawn(a) Perl_do_spawn(aTHX_ a)
+#define flex_fstat(a,b) Perl_flex_fstat(aTHX_ a,b)
+#define cando_by_name(a,b,c) Perl_cando_by_name(aTHX_ a,b,c)
+#define flex_stat(a,b) Perl_flex_stat(aTHX_ a,b)
+#define my_getpwnam(a) Perl_my_getpwnam(aTHX_ a)
+#define my_getpwuid(a) Perl_my_getpwuid(aTHX_ a)
+#define my_flush(a) Perl_my_flush(aTHX_ a)
+#define readdir(a) Perl_readdir(aTHX_ a)
#endif
-#define my_crypt Perl_my_crypt
-#define my_waitpid Perl_my_waitpid
#define my_gconvert Perl_my_gconvert
-#define kill_file Perl_kill_file
-#define my_mkdir Perl_my_mkdir
-#define my_chdir Perl_my_chdir
-#define my_tmpfile Perl_my_tmpfile
-#define my_utime Perl_my_utime
-#define vms_image_init Perl_vms_image_init
-#define readdir Perl_readdir
#define telldir Perl_telldir
-#define seekdir Perl_seekdir
#define closedir Perl_closedir
#define vmsreaddirversions Perl_vmsreaddirversions
-#define my_gmtime Perl_my_gmtime
-#define my_localtime Perl_my_localtime
-#define my_time Perl_my_time
#define my_sigemptyset Perl_my_sigemptyset
#define my_sigfillset Perl_my_sigfillset
#define my_sigaddset Perl_my_sigaddset
#define my_sigdelset Perl_my_sigdelset
#define my_sigismember Perl_my_sigismember
#define my_sigprocmask Perl_my_sigprocmask
-#define cando_by_name Perl_cando_by_name
-#define flex_fstat Perl_flex_fstat
-#define flex_stat Perl_flex_stat
#define my_vfork Perl_my_vfork
-#define vms_do_aexec Perl_vms_do_aexec
-#define vms_do_exec Perl_vms_do_exec
-#define do_aspawn Perl_do_aspawn
-#define do_spawn Perl_do_spawn
#define my_fdopen Perl_my_fdopen
#define my_fclose Perl_my_fclose
#define my_fwrite Perl_my_fwrite
-#define my_flush Perl_my_flush
-#define my_getpwnam Perl_my_getpwnam
-#define my_getpwuid Perl_my_getpwuid
#define my_getpwent Perl_my_getpwent
#define my_endpwent Perl_my_endpwent
#define my_getlogin Perl_my_getlogin
* from a specific directory to permit creation of files).
*/
#ifndef DONT_MASK_RTL_CALLS
-# define tmpfile my_tmpfile
+# define tmpfile Perl_my_tmpfile
#endif
#define getlogin my_getlogin
/* Ditto for sys$hash_password() . . . */
-#define crypt my_crypt
+#define crypt(a,b) Perl_my_crypt(aTHX_ a,b)
/* Tweak arg to mkdir & chdir first, so we can tolerate trailing /. */
-#define Mkdir(dir,mode) my_mkdir((dir),(mode))
+#define Mkdir(dir,mode) Perl_my_mkdir(aTHX_ (dir),(mode))
#define Chdir(dir) my_chdir((dir))
/* Use our own stat() clones, which handle Unix-style directory names */
#define Stat(name,bufptr) flex_stat(name,bufptr)
-#define Fstat(fd,bufptr) flex_fstat(fd,bufptr)
+#define Fstat(fd,bufptr) Perl_flex_fstat(aTHX_ fd,bufptr)
/* Setup for the dirent routines:
* opendir(), closedir(), readdir(), seekdir(), telldir(), and
void init_os_extras ();
/* prototype section start marker; `typedef' passes through cpp */
typedef char __VMS_PROTOTYPES__;
+int Perl_vmstrnenv (const char *, char *, unsigned long int, struct dsc$descriptor_s **, unsigned long int);
#if !defined(PERL_IMPLICIT_CONTEXT)
char * Perl_my_getenv (const char *, bool);
-int Perl_vmstrnenv (const char *, char *, unsigned long int, struct dsc$descriptor_s **, unsigned long int);
int Perl_my_trnlnm (const char *, char *, unsigned long int);
char * Perl_tounixspec (char *, char *);
char * Perl_tounixspec_ts (char *, char *);
int Perl_trim_unixpath (char *, char*, int);
DIR * Perl_opendir (char *);
int Perl_rmscopy (char *, char *, int);
+int Perl_my_mkdir (char *, Mode_t);
+bool Perl_vms_do_aexec (SV *, SV **, SV **);
#else
-int Perl_vmstrnenv (pTHX_ const char *, char *, unsigned long int, struct dsc$descriptor_s **, unsigned long int);
char * Perl_my_getenv (pTHX_ const char *, bool);
int Perl_my_trnlnm (pTHX_ const char *, char *, unsigned long int);
char * Perl_tounixspec (pTHX_ char *, char *);
int Perl_trim_unixpath (pTHX_ char *, char*, int);
DIR * Perl_opendir (pTHX_ char *);
int Perl_rmscopy (pTHX_ char *, char *, int);
-#endif
-char * my_getenv_len (const char *, unsigned long *, bool);
-int vmssetenv (char *, char *, struct dsc$descriptor_s **);
-void Perl_vmssetuserlnm(char *name, char *eqv);
-char * my_crypt (const char *, const char *);
-Pid_t my_waitpid (Pid_t, int *, int);
+int Perl_my_mkdir (pTHX_ char *, Mode_t);
+bool Perl_vms_do_aexec (pTHX_ SV *, SV **, SV **);
+#endif
+char * Perl_my_getenv_len (pTHX_ const char *, unsigned long *, bool);
+int Perl_vmssetenv (pTHX_ char *, char *, struct dsc$descriptor_s **);
+void Perl_vmssetuserlnm(pTHX_ char *name, char *eqv);
+char * Perl_my_crypt (pTHX_ const char *, const char *);
+Pid_t Perl_my_waitpid (pTHX_ Pid_t, int *, int);
char * my_gconvert (double, int, int, char *);
-int kill_file (char *);
-int my_mkdir (char *, Mode_t);
-int my_chdir (char *);
-FILE * my_tmpfile (void);
-int my_utime (char *, struct utimbuf *);
-void vms_image_init (int *, char ***);
-struct dirent * readdir (DIR *);
+int Perl_kill_file (pTHX_ char *);
+int Perl_my_chdir (pTHX_ char *);
+FILE * Perl_my_tmpfile ();
+int Perl_my_utime (pTHX_ char *, struct utimbuf *);
+void Perl_vms_image_init (int *, char ***);
+struct dirent * Perl_readdir (pTHX_ DIR *);
long telldir (DIR *);
-void seekdir (DIR *, long);
+void Perl_seekdir (pTHX_ DIR *, long);
void closedir (DIR *);
void vmsreaddirversions (DIR *, int);
-struct tm * my_gmtime (const time_t *);
-struct tm * my_localtime (const time_t *);
-time_t my_time (time_t *);
+struct tm * Perl_my_gmtime (pTHX_ const time_t *);
+struct tm * Perl_my_localtime (pTHX_ const time_t *);
+time_t Perl_my_time (pTHX_ time_t *);
#ifdef HOMEGROWN_POSIX_SIGNALS
int my_sigemptyset (sigset_t *);
int my_sigfillset (sigset_t *);
int my_sigismember (sigset_t *, int);
int my_sigprocmask (int, sigset_t *, sigset_t *);
#endif
-I32 cando_by_name (I32, Uid_t, char *);
-int flex_fstat (int, Stat_t *);
-int flex_stat (const char *, Stat_t *);
+I32 Perl_cando_by_name (pTHX_ I32, Uid_t, char *);
+int Perl_flex_fstat (pTHX_ int, Stat_t *);
+int Perl_flex_stat (pTHX_ const char *, Stat_t *);
int my_vfork ();
-bool vms_do_aexec (SV *, SV **, SV **);
-bool vms_do_exec (char *);
-unsigned long int do_aspawn (void *, void **, void **);
-unsigned long int do_spawn (char *);
-FILE * my_fdopen (int, const char *);
+bool Perl_vms_do_exec (pTHX_ char *);
+unsigned long int Perl_do_aspawn (pTHX_ void *, void **, void **);
+unsigned long int Perl_do_spawn (pTHX_ char *);
+FILE * my_fdopen (int, char *);
int my_fclose (FILE *);
int my_fwrite (void *, size_t, size_t, FILE *);
-int my_flush (FILE *);
-struct passwd * my_getpwnam (char *name);
-struct passwd * my_getpwuid (Uid_t uid);
-struct passwd * my_getpwent ();
+int Perl_my_flush (pTHX_ FILE *);
+struct passwd * Perl_my_getpwnam (pTHX_ char *name);
+struct passwd * Perl_my_getpwuid (pTHX_ Uid_t uid);
void my_endpwent ();
char * my_getlogin ();
typedef char __VMS_SEPYTOTORP__;