[blead-307-g8e0aa7c] more vms thread ctx fixes
[email protected] (John Malmberg)
| Newsgroups | perl.perl5.porters,perl.vmsperl |
|---|---|
| Message-ID | <[email protected]> |
If Perl_my_trnlnm is called with a null implicit context, it would access violate. create_mbx does not need a implicit context. -John [email protected] Personal Opinion Only
vms_threadctx2.gdiff
(text/plain, 3.2 KB)
--- /rsync_root/perl/vms/vms.c Sat Jan 10 17:15:14 2009
+++ vms/vms.c Sat Jan 10 13:38:25 2009
@@ -1043,6 +1043,12 @@
/* fully initialized, in which case either thr or PL_curcop */
/* might be bogus. We have to check, since ckWARN needs them */
/* both to be valid if running threaded */
+#if defined(PERL_IMPLICIT_CONTEXT)
+ if (aTHX == NULL) {
+ fprintf(stderr,
+ "%Perl-VMS-Init, Value of CLI symbol \"%s\" too long",lnm);
+ } else
+#endif
if (ckWARN(WARN_MISC)) {
Perl_warner(aTHX_ packWARN(WARN_MISC),"Value of CLI symbol \"%s\" too long",lnm);
}
@@ -1108,13 +1114,17 @@
/* Define as a function so we can access statics. */
int Perl_my_trnlnm(pTHX_ const char *lnm, char *eqv, unsigned long int idx)
{
- return vmstrnenv(lnm,eqv,idx,fildev,
+ int flags = 0;
+
+#if defined(PERL_IMPLICIT_CONTEXT)
+ if (aTHX != NULL)
+#endif
#ifdef SECURE_INTERNAL_GETENV
- (PL_curinterp ? PL_tainting : will_taint) ? PERL__TRNENV_SECURE : 0
-#else
- 0
+ flags = (PL_curinterp ? PL_tainting : will_taint) ?
+ PERL__TRNENV_SECURE : 0;
#endif
- );
+
+ return vmstrnenv(lnm, eqv, idx, fildev, flags);
}
/*}}}*/
@@ -1333,7 +1343,7 @@
} /* end of my_getenv_len() */
/*}}}*/
-static void create_mbx(pTHX_ unsigned short int *, struct dsc$descriptor_s *);
+static void create_mbx(unsigned short int *, struct dsc$descriptor_s *);
static void riseandshine(unsigned long int dummy) { sys$wake(0,0); }
@@ -2764,7 +2774,7 @@
static void
-create_mbx(pTHX_ unsigned short int *chan, struct dsc$descriptor_s *namdsc)
+create_mbx(unsigned short int *chan, struct dsc$descriptor_s *namdsc)
{
unsigned long int mbxbufsiz;
static unsigned long int syssize = 0;
@@ -3214,8 +3224,8 @@
n = sizeof(Pipe);
_ckvmssts_noperl(lib$get_vm(&n, &p));
- create_mbx(aTHX_ &p->chan_in , &d_mbx1);
- create_mbx(aTHX_ &p->chan_out, &d_mbx2);
+ create_mbx(&p->chan_in , &d_mbx1);
+ create_mbx(&p->chan_out, &d_mbx2);
_ckvmssts_noperl(lib$getdvi(&dviitm, &p->chan_in, 0, &p->bufsize));
p->buf = 0;
@@ -3384,8 +3394,8 @@
int n = sizeof(Pipe);
_ckvmssts_noperl(lib$get_vm(&n, &p));
- create_mbx(aTHX_ &p->chan_in , &d_mbx1);
- create_mbx(aTHX_ &p->chan_out, &d_mbx2);
+ create_mbx(&p->chan_in , &d_mbx1);
+ create_mbx(&p->chan_out, &d_mbx2);
_ckvmssts_noperl(lib$getdvi(&dviitm, &p->chan_in, 0, &p->bufsize));
n = p->bufsize * sizeof(char);
@@ -3539,7 +3549,7 @@
_ckvmssts_noperl(lib$get_vm(&n, &p));
p->fd_out = dup(fd);
- create_mbx(aTHX_ &p->chan_in, &d_mbx);
+ create_mbx(&p->chan_in, &d_mbx);
_ckvmssts_noperl(lib$getdvi(&dviitm, &p->chan_in, 0, &p->bufsize));
n = (p->bufsize+1) * sizeof(char);
_ckvmssts_noperl(lib$get_vm(&n, &p->buf));
@@ -4111,7 +4121,7 @@
/* Now create a mailbox to be read by the application */
- create_mbx(aTHX_ &p_chan, &d_mbx1);
+ create_mbx(&p_chan, &d_mbx1);
/* write the name of the created terminal to the mailbox */
status = sys$qiow(NO_EFN, p_chan, IO$_WRITEVBLK|IO$M_NOW,