# define YIELD pthread_yield(NULL)
# endif
# endif
-# ifndef VMS
# define pthread_mutexattr_default NULL
# define pthread_condattr_default NULL
-# endif
#endif
#ifndef PTHREAD_CREATE
# Space-separated list of "dynamic" extensions which should be built for
# run-time dynamic loading.
-dynamic_ext = Fcntl Errno IO Opcode Data::Dumper attrs re VMS::Stdio VMS::DCLsym B SDBM_File POSIX
+dynamic_ext = $extensions
# Space-separated list of "static" extensions to build into perlshr (case counts).
MYEXT = DynaLoader
$ THEN
$ perl_arch = "''perl_arch'-thread"
$ perl_archname = "''perl_archname'-thread"
+$ perl_d_old_pthread_create_joinable = "undef"
+$ perl_old_pthread_create_joinable = " "
$ ELSE
$ perl_d_old_pthread_create_joinable = "undef"
$ perl_old_pthread_create_joinable = " "
$ if (teststatus.nes."1")
$ THEN
$! Okay, off64_t failed. Must not exist
-$ perl_d_off64t = "undef"
+$ perl_d_off64_t = "undef"
$ ELSE
-$ perl_d_off64t="define"
+$ perl_d_off64_t="define"
$ ENDIF
-$ WRITE_RESULT "d_off64t is ''perl_d_off64t'"
+$ WRITE_RESULT "d_off64_t is ''perl_d_off64_t'"
$!
$! Check to see if gethostname exists
$!
$ ENDIF
$ WRITE_RESULT "d_fcntl is ''perl_d_fcntl'"
$!
+$! Check for memchr
+$!
+$ OS
+$ WS "#ifdef __DECC
+$ WS "#include <stdlib.h>
+$ WS "#endif
+$ WS "#include <string.h>
+$ WS "int main()
+$ WS "{"
+$ WS "char * place;
+$ WS "place = memchr(""foo"", 47, 3)
+$ WS "exit(0);
+$ WS "}"
+$ CS
+$ DEFINE SYS$ERROR _NLA0:
+$ DEFINE SYS$OUTPUT _NLA0:
+$ on error then continue
+$ on warning then continue
+$ 'Checkcc' temp.c
+$ savedstatus = $status
+$ teststatus = f$extract(9,1,savedstatus)
+$ if (teststatus.nes."1")
+$ THEN
+$ perl_d_memchr="undef"
+$ DEASSIGN SYS$OUTPUT
+$ DEASSIGN SYS$ERROR
+$ ELSE
+$ If (Needs_Opt.eqs."Yes")
+$ THEN
+$ link temp.obj,temp.opt/opt
+$ else
+$ link temp.obj
+$ endif
+$ savedstatus = $status
+$ teststatus = f$extract(9,1,savedstatus)
+$ DEASSIGN SYS$OUTPUT
+$ DEASSIGN SYS$ERROR
+$ if (teststatus.nes."1")
+$ THEN
+$ perl_d_memchr="undef"
+$ ELSE
+$ perl_d_memchr="define"
+$ ENDIF
+$ ENDIF
+$ WRITE_RESULT "d_memchr is ''perl_d_memchr'"
+$!
$! Check for access
$!
$ OS
$ ENDIF
$ WRITE_RESULT "i_niin is ''perl_i_niin'"
$!
+$! Check for <netinet/tcp.h>
+$!
+$ if ("''Has_Dec_C_Sockets'".eqs."T").or.("''Has_Socketshr'".eqs."T")
+$ THEN
+$ OS
+$ WS "#ifdef __DECC
+$ WS "#include <stdlib.h>
+$ WS "#endif
+$ WS "#include <stdio.h>
+$ if ("''Has_Socketshr'".eqs."T")
+$ THEN
+$ WS "#include <socketshr.h>"
+$ else
+$ WS "#include <netdb.h>
+$ endif
+$ WS "#include <netinet/tcp.h>"
+$ WS "int main()
+$ WS "{"
+$ WS "exit(0);
+$ WS "}"
+$ CS
+$ DEFINE SYS$ERROR _NLA0:
+$ DEFINE SYS$OUTPUT _NLA0:
+$ on error then continue
+$ on warning then continue
+$ 'Checkcc' temp.c
+$ If (Needs_Opt.eqs."Yes")
+$ THEN
+$ link temp.obj,temp.opt/opt
+$ else
+$ link temp.obj
+$ endif
+$ teststatus = f$extract(9,1,$status)
+$ DEASSIGN SYS$OUTPUT
+$ DEASSIGN SYS$ERROR
+$ if (teststatus.nes."1")
+$ THEN
+$ perl_i_netinettcp="undef"
+$ ELSE
+$ perl_i_netinettcp="define"
+$ ENDIF
+$ ELSE
+$ perl_i_netinettcp="undef"
+$ ENDIF
+$ WRITE_RESULT "i_netinettcp is ''perl_i_netinettcp'"
+$!
$! Check for endhostent
$!
$ if ("''Has_Dec_C_Sockets'".eqs."T").or.("''Has_Socketshr'".eqs."T")
$ if (teststatus.nes."1")
$ THEN
$ perl_d_sched_yield="undef"
+$ perl_sched_yield = " "
$ ELSE
$ perl_d_sched_yield="define"
+$ perl_sched_yield = "sched_yield"
$ ENDIF
$ ELSE
$ perl_d_sched_yield="undef"
+$ perl_sched_yield = " "
$ ENDIF
$ WRITE_RESULT "d_sched_yield is ''perl_d_sched_yield'"
+$ WRITE_RESULT "sched_yield is ''perl_sched_yield'"
$!
$! Check for generic pointer size
$!
$ WC "# This file generated by Configure.COM on a VMS system."
$ WC "# Time: " + perl_cf_time
$ WC ""
+$ WC "CONFIGDOTSH=true"
$ WC "package='" + perl_package + "'"
$ WC "CONFIG='" + perl_config + "'"
$ WC "cf_time='" + perl_cf_time + "'"
$ WC "d_getsent='" + perl_d_getsent + "'"
$ WC "d_select='" + perl_d_select + "'"
$ WC "i_niin='" + perl_i_niin + "'"
+$ WC "i_netinettcp='" + perl_i_netinettcp + "'"
$ WC "i_neterrno='" + perl_i_neterrno + "'"
$ WC "d_stdstdio='" + perl_d_stdstdio + "'"
$ WC "d_stdio_ptr_lval='" + perl_d_stdio_ptr_lval + "'"
$ WC "i_poll='" + perl_i_poll + "'"
$ WC "i_inttypes='" + perl_i_inttypes + "'"
$ WC "d_int64t='" + perl_d_int64t + "'"
-$ WC "d_off64t='" + perl_d_off64t + "'"
+$ WC "d_off64_t='" + perl_d_off64_t + "'"
$ WC "d_fstat64='" + perl_d_fstat64 + "'"
$ WC "d_ftruncate64='" + perl_d_ftruncate64 + "'"
$ WC "d_lseek64='" + perl_d_lseek64 + "'"
$ WC "sig_num_init='" + perl_sig_num_with_commas + "'"
$ WC "i_sysmount='" + perl_i_sysmount + "'"
$ WC "d_fstatfs='" + perl_d_fstatfs + "'"
+$ WC "d_memchr='" + perl_d_memchr + "'"
$ WC "d_statfsflags='" + perl_d_statfsflags + "'"
+$ WC "fflushNULL='define'"
+$ WC "fflushall='undef'"
+$ WC "d_stdio_stream_array='undef'"
$ WC "i_sysstatvfs='" + perl_i_sysstatvfs + "'"
$ WC "i_machcthreads='" + perl_i_machcthreads + "'"
$ WC "i_pthread='" + perl_i_pthread + "'"
$ WC "installusrbinperl='" + perl_installusrbinperl + "'"
$ WC "crosscompile='" + perl_crosscompile + "'"
$ WC "multiarch='" + perl_multiarch + "'"
+$ WC "sched_yield='" + perl_sched_yield + "'"
$!
$! ##WRITE NEW CONSTANTS HERE##
$!
{LNM$C_NAMLENGTH, LNM$_STRING, eqv, &eqvlen},
{0, 0, 0, 0}};
$DESCRIPTOR(crtlenv,"CRTL_ENV"); $DESCRIPTOR(clisym,"CLISYM");
+#if defined(USE_THREADS)
+ /* 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 dTHR 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);
+ } else {
+ thr = NULL;
+ }
+#endif
if (!lnm || !eqv || idx > LNM$_MAX_INDEX) {
set_errno(EINVAL); set_vaxc_errno(SS$_BADPARAM); return 0;
if (eqvlen > 1024) {
set_errno(EVMSERR); set_vaxc_errno(LIB$_STRTRU);
eqvlen = 1024;
- if (ckWARN(WARN_MISC))
- warner(WARN_MISC,"Value of CLI symbol \"%s\" too long",lnm);
+ /* Special hack--we might be called before the interpreter's */
+ /* 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(USE_THREADS)
+ if (thr && PL_curcop) {
+#endif
+ if (ckWARN(WARN_MISC)) {
+ warner(WARN_MISC,"Value of CLI symbol \"%s\" too long",lnm);
+ }
+#if defined(USE_THREADS)
+ } else {
+ warner(WARN_MISC,"Value of CLI symbol \"%s\" too long",lnm);
+ }
+#endif
+
}
strncpy(eqv,eqvdsc.dsc$a_pointer,eqvlen);
}
} /* end of vmstrnenv */
/*}}}*/
-
/*{{{ int my_trnlnm(const char *lnm, char *eqv, unsigned long int idx)*/
/* Define as a function so we can access statics. */
int my_trnlnm(const char *lnm, char *eqv, unsigned long int idx)
char *
my_getenv_len(const char *lnm, unsigned long *len, bool sys)
{
- char buf[LNM$C_NAMLENGTH+1], *cp1, *cp2;
+ char *buf, *cp1, *cp2;
unsigned long idx = 0;
-
+ static char __my_getenv_len_eqv[LNM$C_NAMLENGTH+1];
+ SV *tmpsv;
+
+ if (PL_curinterp) { /* Perl interpreter running -- may be threaded */
+ /* Set up a temporary buffer for the return value; Perl will
+ * clean it up at the next statement transition */
+ tmpsv = sv_2mortal(newSVpv("",LNM$C_NAMLENGTH+1));
+ if (!tmpsv) return NULL;
+ buf = SvPVX(tmpsv);
+ }
+ else buf = __my_getenv_len_eqv; /* Assume no interpreter ==> single thread */
for (cp1 = (char *)lnm, cp2 = buf; *cp1; cp1++,cp2++) *cp2 = _toupper(*cp1);
if (cp1 - lnm == 7 && !strncmp(buf,"DEFAULT",7)) {
getcwd(buf,LNM$C_NAMLENGTH);
#endif
)))
return buf;
- else return Nullch;
+ else
+ return Nullch;
}
} /* end of my_getenv_len() */
my_waitpid(Pid_t pid, int *statusp, int flags)
{
struct pipe_details *info;
+ dTHR;
for (info = open_pipes; info != NULL; info = info->next)
if (info->pid == pid) break;
vms_do_exec(char *cmd)
{
+ dTHR;
if (vfork_called) { /* this follows a vfork - act Unixish */
vfork_called--;
if (vfork_called < 0) {
do_spawn(char *cmd)
{
unsigned long int sts, substs, hadcmd = 1;
+ dTHR;
TAINT_ENV();
TAINT_PROPER("spawn");
} /* end of flex_fstat() */
/*}}}*/
-/*{{{ int flex_stat(char *fspec, Stat_t *statbufp)*/
+/*{{{ int flex_stat(const char *fspec, Stat_t *statbufp)*/
int
-flex_stat(char *fspec, Stat_t *statbufp)
+flex_stat(const char *fspec, Stat_t *statbufp)
{
dTHR;
char fileified[NAM$C_MAXRSS+1];
+ char temp_fspec[NAM$C_MAXRSS+300];
int retval = -1;
+ strcpy(temp_fspec, fspec);
if (statbufp == (Stat_t *) &PL_statcache)
- do_tovmsspec(fspec,namecache,0);
- if (is_null_device(fspec)) { /* Fake a stat() for the null device */
+ 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_mode = S_IFBLK | S_IREAD | S_IWRITE | S_IEXEC;
* the file with null type, specify this by calling flex_stat() with
* a '.' at the end of fspec.
*/
- if (do_fileify_dirspec(fspec,fileified,0) != NULL) {
+ if (do_fileify_dirspec(temp_fspec,fileified,0) != NULL) {
retval = stat(fileified,(stat_t *) statbufp);
if (!retval && statbufp == (Stat_t *) &PL_statcache)
strcpy(namecache,fileified);
}
- if (retval) retval = stat(fspec,(stat_t *) statbufp);
+ if (retval) retval = stat(temp_fspec,(stat_t *) statbufp);
if (!retval) {
statbufp->st_dev = encode_dev(statbufp->st_devnam);
# ifdef RTL_USES_UTC
/* Note that we do, in fact, have this */
#define HAS_GETENV_SV
+#define HAS_GETENV_LEN
#ifndef DONT_MASK_RTL_CALLS
# ifdef getenv
#endif
I32 cando_by_name (I32, I32, char *);
int flex_fstat (int, Stat_t *);
-int flex_stat (char *, Stat_t *);
+int flex_stat (const char *, Stat_t *);
int trim_unixpath (char *, char*, int);
int my_vfork ();
bool vms_do_aexec (SV *, SV **, SV **);
projects / p5sagit/p5-mst-13.2.git / commitdiff