#include <uaidef.h>
#include <uicdef.h>
#include <stsdef.h>
-#if __CRTL_VER >= 70000000 /* FIXME to earliest version */
#include <efndef.h>
#define NO_EFN EFN$C_ENF
-#else
-#define NO_EFN 0;
-#endif
#if __CRTL_VER < 70301000 && __CRTL_VER >= 70300000
int decc$feature_get_index(const char *name);
#include <libfildef.h>
#endif
-#if defined(__VMS_VER) && __VMS_VER >= 70000000 && __DECC_VER >= 50200000
-# define RTL_USES_UTC 1
-#endif
-
#if !defined(__VAX) && __CRTL_VER >= 80200000
#ifdef lstat
#undef lstat
/* munching */
static int no_translate_barewords;
-#ifndef RTL_USES_UTC
-static int tz_updated = 1;
-#endif
-
/* DECC Features that may need to affect how Perl interprets
* displays filename information
*/
return;
}
}
-#ifndef RTL_USES_UTC
- if (len == 6 || len == 2) {
- char uplnm[7];
- int i;
- for (i = 0; lnm[i]; i++) uplnm[i] = _toupper(lnm[i]);
- uplnm[len] = '\0';
- if (!strcmp(uplnm,"UCX$TZ")) tz_updated = 1;
- if (!strcmp(uplnm,"TZ")) tz_updated = 1;
- }
-#endif
}
(void) vmssetenv(lnm,eqv,NULL);
}
/*}}}*/
-#ifndef HOMEGROWN_POSIX_SIGNALS
/*
* The C RTL's sigaction fails to check for invalid signal numbers so we
* help it out a bit. The docs are correct, but the actual routine doesn't
return sigaction(sig, act, oact);
}
/*}}}*/
-#endif
#ifdef KILL_BY_SIGPRC
#include <errnodef.h>
0 /* 28 SIGWINCH */
};
-#if __VMS_VER >= 60200000
static int initted = 0;
if (!initted) {
initted = 1;
sig_code[16] = C$_SIGUSR1;
sig_code[17] = C$_SIGUSR2;
-#if __CRTL_VER >= 70000000
sig_code[20] = C$_SIGCHLD;
-#endif
#if __CRTL_VER >= 70300000
sig_code[28] = C$_SIGWINCH;
#endif
}
-#endif
if (sig < _SIG_MIN) return 0;
if (sig > _MY_SIG_MAX) return 0;
}
/* Special case 1 - sys$posix_root = / */
-#if __CRTL_VER >= 70000000
if (!decc_disable_posix_root) {
if (strncasecmp(spec, "SYS$POSIX_ROOT:", 15) == 0) {
*cp1 = '/';
cp2 = cp2 + 15;
}
}
-#endif
/* Special case 2 - Convert NLA0: to /dev/null */
-#if __CRTL_VER < 70000000
- cmp_rslt = strncmp(spec,"NLA0:", 5);
- if (cmp_rslt != 0)
- cmp_rslt = strncmp(spec,"nla0:", 5);
-#else
cmp_rslt = strncasecmp(spec,"NLA0:", 5);
-#endif
if (cmp_rslt == 0) {
strcpy(rslt, "/dev/null");
cp1 = cp1 + 9;
}
/* Also handle special case "SYS$SCRATCH:" */
-#if __CRTL_VER < 70000000
- cmp_rslt = strncmp(spec,"SYS$SCRATCH:", 12);
- if (cmp_rslt != 0)
- cmp_rslt = strncmp(spec,"sys$scratch:", 12);
-#else
cmp_rslt = strncasecmp(spec,"SYS$SCRATCH:", 12);
-#endif
tmp = PerlMem_malloc(VMS_MAXRSS);
if (tmp == NULL) _ckvmssts_noperl(SS$_INSFMEM);
if (cmp_rslt == 0) {
}
/*}}}*/
-#ifdef HOMEGROWN_POSIX_SIGNALS
- /* Signal handling routines, pulled into the core from POSIX.xs.
- *
- * We need these for threads, so they've been rolled into the core,
- * rather than left in POSIX.xs.
- *
- * (DRS, Oct 23, 1997)
- */
-
- /* sigset_t is atomic under VMS, so these routines are easy */
-/*{{{int my_sigemptyset(sigset_t *) */
-int my_sigemptyset(sigset_t *set) {
- if (!set) { SETERRNO(EFAULT,SS$_ACCVIO); return -1; }
- *set = 0; return 0;
-}
-/*}}}*/
-
-
-/*{{{int my_sigfillset(sigset_t *)*/
-int my_sigfillset(sigset_t *set) {
- int i;
- if (!set) { SETERRNO(EFAULT,SS$_ACCVIO); return -1; }
- for (i = 0; i < NSIG; i++) *set |= (1 << i);
- return 0;
-}
-/*}}}*/
-
-
-/*{{{int my_sigaddset(sigset_t *set, int sig)*/
-int my_sigaddset(sigset_t *set, int sig) {
- if (!set) { SETERRNO(EFAULT,SS$_ACCVIO); return -1; }
- if (sig > NSIG) { SETERRNO(EINVAL,LIB$_INVARG); return -1; }
- *set |= (1 << (sig - 1));
- return 0;
-}
-/*}}}*/
-
-
-/*{{{int my_sigdelset(sigset_t *set, int sig)*/
-int my_sigdelset(sigset_t *set, int sig) {
- if (!set) { SETERRNO(EFAULT,SS$_ACCVIO); return -1; }
- if (sig > NSIG) { SETERRNO(EINVAL,LIB$_INVARG); return -1; }
- *set &= ~(1 << (sig - 1));
- return 0;
-}
-/*}}}*/
-
-
-/*{{{int my_sigismember(sigset_t *set, int sig)*/
-int my_sigismember(sigset_t *set, int sig) {
- if (!set) { SETERRNO(EFAULT,SS$_ACCVIO); return -1; }
- if (sig > NSIG) { SETERRNO(EINVAL,LIB$_INVARG); return -1; }
- return *set & (1 << (sig - 1));
-}
-/*}}}*/
-
-
-/*{{{int my_sigprocmask(int how, sigset_t *set, sigset_t *oset)*/
-int my_sigprocmask(int how, sigset_t *set, sigset_t *oset) {
- sigset_t tempmask;
-
- /* If set and oset are both null, then things are badly wrong. Bail out. */
- if ((oset == NULL) && (set == NULL)) {
- set_errno(EFAULT); set_vaxc_errno(SS$_ACCVIO);
- return -1;
- }
-
- /* If set's null, then we're just handling a fetch. */
- if (set == NULL) {
- tempmask = sigblock(0);
- }
- else {
- switch (how) {
- case SIG_SETMASK:
- tempmask = sigsetmask(*set);
- break;
- case SIG_BLOCK:
- tempmask = sigblock(*set);
- break;
- case SIG_UNBLOCK:
- tempmask = sigblock(0);
- sigsetmask(*oset & ~tempmask);
- break;
- default:
- set_errno(EINVAL); set_vaxc_errno(LIB$_INVARG);
- return -1;
- }
- }
-
- /* Did they pass us an oset? If so, stick our holding mask into it */
- if (oset)
- *oset = tempmask;
-
- return 0;
-}
-/*}}}*/
-#endif /* HOMEGROWN_POSIX_SIGNALS */
-
-
/* Used for UTC calculation in my_gmtime(), my_localtime(), my_time(),
* my_utime(), and flex_stat(), all of which operate on UTC unless
* VMSISH_TIMES is true.
#undef time
-/*
- * DEC C previous to 6.0 corrupts the behavior of the /prefix
- * qualifier with the extern prefix pragma. This provisional
- * hack circumvents this prefix pragma problem in previous
- * precompilers.
- */
-#if defined(__VMS_VER) && __VMS_VER >= 70000000
-# if defined(VMS_WE_ARE_CASE_SENSITIVE) && (__DECC_VER < 60000000)
-# pragma __extern_prefix save
-# pragma __extern_prefix "" /* set to empty to prevent prefixing */
-# define gmtime decc$__utctz_gmtime
-# define localtime decc$__utctz_localtime
-# define time decc$__utc_time
-# pragma __extern_prefix restore
-
- struct tm *gmtime(), *localtime();
-
-# endif
-#endif
-
-
static time_t toutc_dst(time_t loc) {
struct tm *rsltmp;
(gmtime_emulation_type == 1 ? toloc_dst(secs) : \
((secs) + utc_offset_secs))))
-#ifndef RTL_USES_UTC
-/*
-
- ucx$tz = "EST5EDT4,M4.1.0,M10.5.0" typical
- DST starts on 1st sun of april at 02:00 std time
- ends on last sun of october at 02:00 dst time
- see the UCX management command reference, SET CONFIG TIMEZONE
- for formatting info.
-
- No, it's not as general as it should be, but then again, NOTHING
- will handle UK times in a sensible way.
-*/
-
-
-/*
- parse the DST start/end info:
- (Jddd|ddd|Mmon.nth.dow)[/hh:mm:ss]
-*/
-
-static char *
-tz_parse_startend(char *s, struct tm *w, int *past)
-{
- int dinm[] = {31,28,31,30,31,30,31,31,30,31,30,31};
- int ly, dozjd, d, m, n, hour, min, sec, j, k;
- time_t g;
-
- if (!s) return 0;
- if (!w) return 0;
- if (!past) return 0;
-
- ly = 0;
- if (w->tm_year % 4 == 0) ly = 1;
- if (w->tm_year % 100 == 0) ly = 0;
- if (w->tm_year+1900 % 400 == 0) ly = 1;
- if (ly) dinm[1]++;
-
- dozjd = isdigit(*s);
- if (*s == 'J' || *s == 'j' || dozjd) {
- if (!dozjd && !isdigit(*++s)) return 0;
- d = *s++ - '0';
- if (isdigit(*s)) {
- d = d*10 + *s++ - '0';
- if (isdigit(*s)) {
- d = d*10 + *s++ - '0';
- }
- }
- if (d == 0) return 0;
- if (d > 366) return 0;
- d--;
- if (!dozjd && d > 58 && ly) d++; /* after 28 feb */
- g = d * 86400;
- dozjd = 1;
- } else if (*s == 'M' || *s == 'm') {
- if (!isdigit(*++s)) return 0;
- m = *s++ - '0';
- if (isdigit(*s)) m = 10*m + *s++ - '0';
- if (*s != '.') return 0;
- if (!isdigit(*++s)) return 0;
- n = *s++ - '0';
- if (n < 1 || n > 5) return 0;
- if (*s != '.') return 0;
- if (!isdigit(*++s)) return 0;
- d = *s++ - '0';
- if (d > 6) return 0;
- }
-
- if (*s == '/') {
- if (!isdigit(*++s)) return 0;
- hour = *s++ - '0';
- if (isdigit(*s)) hour = 10*hour + *s++ - '0';
- if (*s == ':') {
- if (!isdigit(*++s)) return 0;
- min = *s++ - '0';
- if (isdigit(*s)) min = 10*min + *s++ - '0';
- if (*s == ':') {
- if (!isdigit(*++s)) return 0;
- sec = *s++ - '0';
- if (isdigit(*s)) sec = 10*sec + *s++ - '0';
- }
- }
- } else {
- hour = 2;
- min = 0;
- sec = 0;
- }
-
- if (dozjd) {
- if (w->tm_yday < d) goto before;
- if (w->tm_yday > d) goto after;
- } else {
- if (w->tm_mon+1 < m) goto before;
- if (w->tm_mon+1 > m) goto after;
-
- j = (42 + w->tm_wday - w->tm_mday)%7; /*dow of mday 0 */
- k = d - j; /* mday of first d */
- if (k <= 0) k += 7;
- k += 7 * ((n>4?4:n)-1); /* mday of n'th d */
- if (n == 5 && k+7 <= dinm[w->tm_mon]) k += 7;
- if (w->tm_mday < k) goto before;
- if (w->tm_mday > k) goto after;
- }
-
- if (w->tm_hour < hour) goto before;
- if (w->tm_hour > hour) goto after;
- if (w->tm_min < min) goto before;
- if (w->tm_min > min) goto after;
- if (w->tm_sec < sec) goto before;
- goto after;
-
-before:
- *past = 0;
- return s;
-after:
- *past = 1;
- return s;
-}
-
-
-
-
-/* parse the offset: (+|-)hh[:mm[:ss]] */
-
-static char *
-tz_parse_offset(char *s, int *offset)
-{
- int hour = 0, min = 0, sec = 0;
- int neg = 0;
- if (!s) return 0;
- if (!offset) return 0;
-
- if (*s == '-') {neg++; s++;}
- if (*s == '+') s++;
- if (!isdigit(*s)) return 0;
- hour = *s++ - '0';
- if (isdigit(*s)) hour = hour*10+(*s++ - '0');
- if (hour > 24) return 0;
- if (*s == ':') {
- if (!isdigit(*++s)) return 0;
- min = *s++ - '0';
- if (isdigit(*s)) min = min*10 + (*s++ - '0');
- if (min > 59) return 0;
- if (*s == ':') {
- if (!isdigit(*++s)) return 0;
- sec = *s++ - '0';
- if (isdigit(*s)) sec = sec*10 + (*s++ - '0');
- if (sec > 59) return 0;
- }
- }
-
- *offset = (hour*60+min)*60 + sec;
- if (neg) *offset = -*offset;
- return s;
-}
-
-/*
- input time is w, whatever type of time the CRTL localtime() uses.
- sets dst, the zone, and the gmtoff (seconds)
-
- caches the value of TZ and UCX$TZ env variables; note that
- my_setenv looks for these and sets a flag if they're changed
- for efficiency.
-
- We have to watch out for the "australian" case (dst starts in
- october, ends in april)...flagged by "reverse" and checked by
- scanning through the months of the previous year.
-
-*/
-
-static int
-tz_parse(pTHX_ time_t *w, int *dst, char *zone, int *gmtoff)
-{
- time_t when;
- struct tm *w2;
- char *s,*s2;
- char *dstzone, *tz, *s_start, *s_end;
- int std_off, dst_off, isdst;
- int y, dststart, dstend;
- static char envtz[1025]; /* longer than any logical, symbol, ... */
- static char ucxtz[1025];
- static char reversed = 0;
-
- if (!w) return 0;
-
- if (tz_updated) {
- tz_updated = 0;
- reversed = -1; /* flag need to check */
- envtz[0] = ucxtz[0] = '\0';
- tz = my_getenv("TZ",0);
- if (tz) my_strlcpy(envtz, tz, sizeof(envtz));
- tz = my_getenv("UCX$TZ",0);
- if (tz) my_strlcpy(ucxtz, tz, sizeof(ucxtz));
- if (!envtz[0] && !ucxtz[0]) return 0; /* we give up */
- }
- tz = envtz;
- if (!*tz) tz = ucxtz;
-
- s = tz;
- while (isalpha(*s)) s++;
- s = tz_parse_offset(s, &std_off);
- if (!s) return 0;
- if (!*s) { /* no DST, hurray we're done! */
- isdst = 0;
- goto done;
- }
-
- dstzone = s;
- while (isalpha(*s)) s++;
- s2 = tz_parse_offset(s, &dst_off);
- if (s2) {
- s = s2;
- } else {
- dst_off = std_off - 3600;
- }
-
- if (!*s) { /* default dst start/end?? */
- if (tz != ucxtz) { /* if TZ tells zone only, UCX$TZ tells rule */
- s = strchr(ucxtz,',');
- }
- if (!s || !*s) s = ",M4.1.0,M10.5.0"; /* we know we do dst, default rule */
- }
- if (*s != ',') return 0;
-
- when = *w;
- when = _toutc(when); /* convert to utc */
- when = when - std_off; /* convert to pseudolocal time*/
-
- w2 = localtime(&when);
- y = w2->tm_year;
- s_start = s+1;
- s = tz_parse_startend(s_start,w2,&dststart);
- if (!s) return 0;
- if (*s != ',') return 0;
-
- when = *w;
- when = _toutc(when); /* convert to utc */
- when = when - dst_off; /* convert to pseudolocal time*/
- w2 = localtime(&when);
- if (w2->tm_year != y) { /* spans a year, just check one time */
- when += dst_off - std_off;
- w2 = localtime(&when);
- }
- s_end = s+1;
- s = tz_parse_startend(s_end,w2,&dstend);
- if (!s) return 0;
-
- if (reversed == -1) { /* need to check if start later than end */
- int j, ds, de;
-
- when = *w;
- if (when < 2*365*86400) {
- when += 2*365*86400;
- } else {
- when -= 365*86400;
- }
- w2 =localtime(&when);
- when = when + (15 - w2->tm_yday) * 86400; /* jan 15 */
-
- for (j = 0; j < 12; j++) {
- w2 =localtime(&when);
- tz_parse_startend(s_start,w2,&ds);
- tz_parse_startend(s_end,w2,&de);
- if (ds != de) break;
- when += 30*86400;
- }
- reversed = 0;
- if (de && !ds) reversed = 1;
- }
-
- isdst = dststart && !dstend;
- if (reversed) isdst = dststart || !dstend;
-
-done:
- if (dst) *dst = isdst;
- if (gmtoff) *gmtoff = isdst ? dst_off : std_off;
- if (isdst) tz = dstzone;
- if (zone) {
- while(isalpha(*tz)) *zone++ = *tz++;
- *zone = '\0';
- }
- return 1;
-}
-
-#endif /* !RTL_USES_UTC */
-
/* my_time(), my_localtime(), my_gmtime()
* By default traffic in UTC time values, using CRTL gmtime() or
* SYS$TIMEZONE_DIFFERENTIAL to determine offset from local time zone.
when = time(NULL);
# ifdef VMSISH_TIME
-# ifdef RTL_USES_UTC
if (VMSISH_TIME) when = _toloc(when);
-# else
- if (!VMSISH_TIME) when = _toutc(when);
-# endif
# endif
if (timep != NULL) *timep = when;
return when;
# ifdef VMSISH_TIME
if (VMSISH_TIME) when = _toutc(when); /* Input was local time */
# endif
-# ifdef RTL_USES_UTC /* this implies that the CRTL has a working gmtime() */
return gmtime(&when);
-# else
- /* CRTL localtime() wants local time as input, so does no tz correction */
- rsltmp = localtime(&when);
- if (rsltmp) rsltmp->tm_isdst = 0; /* We already took DST into account */
- return rsltmp;
-#endif
} /* end of my_gmtime() */
/*}}}*/
if (gmtime_emulation_type == 0) my_time(NULL); /* Init UTC */
when = *timep;
-# ifdef RTL_USES_UTC
# ifdef VMSISH_TIME
if (VMSISH_TIME) when = _toutc(when);
# endif
/* CRTL localtime() wants UTC as input, does tz correction itself */
return localtime(&when);
-# else /* !RTL_USES_UTC */
- whenutc = when;
-# ifdef VMSISH_TIME
- if (!VMSISH_TIME) when = _toloc(whenutc); /* input was UTC */
- if (VMSISH_TIME) whenutc = _toutc(when); /* input was truelocal */
-# endif
- dst = -1;
-#ifndef RTL_USES_UTC
- if (tz_parse(aTHX_ &when, &dst, 0, &offset)) { /* truelocal determines DST*/
- when = whenutc - offset; /* pseudolocal time*/
- }
-# endif
/* CRTL localtime() wants local time as input, so does no tz correction */
rsltmp = localtime(&when);
if (rsltmp && gmtime_emulation_type != 1) rsltmp->tm_isdst = dst;
return rsltmp;
-# endif
} /* end of my_localtime() */
/*}}}*/
_ckvmssts_noperl(sys$getjpiw(0,0,0,jpilst,iosb,0,0));
_ckvmssts_noperl(iosb[0]);
-#if defined(__VMS_VER) && __VMS_VER >= 60000000
-
/* find out the space required for the profile */
_ckvmssts_noperl(sys$create_user_profile(&usrdsc,&usrprolst,0,0,
&usrprodsc.dsc$w_length,&profile_context));
PerlMem_free(usrprodsc.dsc$a_pointer);
if (retsts == SS$_NOCALLPRIV) retsts = SS$_NOPRIV; /* not really 3rd party */
-#else
-
- retsts = sys$check_access(&objtyp,&namdsc,&usrdsc,armlst);
-
-#endif
-
if (retsts == SS$_NOPRIV || retsts == SS$_NOSUCHOBJECT ||
retsts == SS$_INVFILFOROP || retsts == RMS$_FNF || retsts == RMS$_SYN ||
retsts == RMS$_DIR || retsts == RMS$_DEV || retsts == RMS$_DNF) {
VMS_DEVICE_ENCODE
(statbufp->st_dev, statbufp->st_devnam, statbufp->crtl_stat.st_dev);
-# ifdef RTL_USES_UTC
# ifdef VMSISH_TIME
if (VMSISH_TIME) {
statbufp->st_mtime = _toloc(statbufp->st_mtime);
statbufp->st_ctime = _toloc(statbufp->st_ctime);
}
# endif
-# else
-# ifdef VMSISH_TIME
- if (!VMSISH_TIME) { /* Return UTC instead of local time */
-# else
- if (1) {
-# endif
- statbufp->st_mtime = _toutc(statbufp->st_mtime);
- statbufp->st_atime = _toutc(statbufp->st_atime);
- statbufp->st_ctime = _toutc(statbufp->st_ctime);
- }
-#endif
return 0;
}
return -1;
VMS_INO_T_COPY(statbufp->st_ino, statbufp->crtl_stat.st_ino);
VMS_DEVICE_ENCODE
(statbufp->st_dev, statbufp->st_devnam, statbufp->crtl_stat.st_dev);
-# ifdef RTL_USES_UTC
# ifdef VMSISH_TIME
if (VMSISH_TIME) {
statbufp->st_mtime = _toloc(statbufp->st_mtime);
statbufp->st_ctime = _toloc(statbufp->st_ctime);
}
# endif
-# else
-# ifdef VMSISH_TIME
- if (!VMSISH_TIME) { /* Return UTC instead of local time */
-# else
- if (1) {
-# endif
- statbufp->st_mtime = _toutc(statbufp->st_mtime);
- statbufp->st_atime = _toutc(statbufp->st_atime);
- statbufp->st_ctime = _toutc(statbufp->st_ctime);
- }
-# endif
}
/* If we were successful, leave errno where we found it */
if (retval == 0) RESTORE_ERRNO;
# undef _tolower
#endif
#define _tolower(c) (((c) < 'A' || (c) > 'Z') ? (c) : (c) | 040)
-/* DECC 1.3 has a funny definition of abs; it's fixed in DECC 4.0, so this
- * can go away once DECC 1.3 isn't in use any more. */
-#if defined(__ALPHA) && (defined(__DECC) || defined(__DECCXX))
-#undef abs
-#define abs(__x) __ABS(__x)
-#undef labs
-#define labs(__x) __LABS(__x)
-#endif /* __ALPHA && __DECC */
/* Assorted things to look like Unix */
#ifdef __GNUC__
*/
#define ALTERNATE_SHEBANG "$"
-/* Lower case entry points for these are missing in some earlier RTLs
- * so we borrow the defines and declares from errno.h and upcase them.
- */
-#if defined(VMS_WE_ARE_CASE_SENSITIVE) && (__DECC_VER < 50500000)
-# define errno (*CMA$TIS_ERRNO_GET_ADDR())
-# define vaxc$errno (*CMA$TIS_VMSERRNO_GET_ADDR())
- int *CMA$TIS_ERRNO_GET_ADDR (void); /* UNIX style error code */
- int *CMA$TIS_VMSERRNO_GET_ADDR (void); /* VMS error (errno == EVMSERR) */
-#endif
-
/* Macros to set errno using the VAX thread-safe calls, if present */
#if (defined(__DECC) || defined(__DECCXX)) && !defined(__ALPHA)
# define set_errno(v) (cma$tis_errno_set_value(v))
#define PERL_SOCK_SYSWRITE_IS_SEND
#endif
-#if __CRTL_VER < 70000000
-#define BIT_BUCKET "_NLA0:"
-#else
#define BIT_BUCKET "/dev/null"
-#endif
#define PERL_SYS_INIT_BODY(c,v) MALLOC_CHECK_TAINT2(*c,*v) vms_image_init((c),(v)); PERLIO_INIT; MALLOC_INIT
#define PERL_SYS_TERM_BODY() HINTS_REFCNT_TERM; OP_REFCNT_TERM; PERLIO_TERM; MALLOC_TERM
#define dXSUB_SYS
* This symbol, if defined, indicates that the ioctl() routine is
* available to set I/O characteristics
*/
-#if defined(__CRTL_VER) && __CRTL_VER >= 70000000
#define HAS_IOCTL /**/
-#else
-#undef HAS_IOCTL /**/
-#endif
/* HAS_UTIME:
* This symbol, if defined, indicates that the routine utime() is
#define localtime(t) my_localtime(t)
#define time(t) my_time(t)
-/* If we're using an older version of VMS whose Unix signal emulation
- * isn't very POSIXish, then roll our own.
- */
-#if __VMS_VER < 70000000 || __DECC_VER < 50200000
-# define HOMEGROWN_POSIX_SIGNALS
-#endif
-#ifdef HOMEGROWN_POSIX_SIGNALS
-# define sigemptyset(t) my_sigemptyset(t)
-# define sigfillset(t) my_sigfillset(t)
-# define sigaddset(t, u) my_sigaddset(t, u)
-# define sigdelset(t, u) my_sigdelset(t, u)
-# define sigismember(t, u) my_sigismember(t, u)
-# define sigprocmask(t, u, v) my_sigprocmask(t, u, v)
-# ifndef _SIGSET_T
- typedef int sigset_t;
-# endif
- /* The tools for sigprocmask() are there, just not the routine itself */
-# ifndef SIG_UNBLOCK
-# define SIG_UNBLOCK 1
-# endif
-# ifndef SIG_BLOCK
-# define SIG_BLOCK 2
-# endif
-# ifndef SIG_SETMASK
-# define SIG_SETMASK 3
-# endif
-# define sigaction sigvec
-# define sa_flags sv_onstack
-# define sa_handler sv_handler
-# define sa_mask sv_mask
-# define sigsuspend(set) sigpause(*set)
-# define sigpending(a) (not_here("sigpending"),0)
-#else
/*
* The C RTL's sigaction fails to check for invalid signal numbers so we
* help it out a bit.
*/
-# ifndef DONT_MASK_RTL_CALLS
+#ifndef DONT_MASK_RTL_CALLS
# define sigaction(a,b,c) Perl_my_sigaction(aTHX_ a,b,c)
-# endif
#endif
#ifdef KILL_BY_SIGPRC
# define kill Perl_my_kill
# pragma __member_alignment __restore
#endif
-/*
- * DEC C previous to 6.0 corrupts the behavior of the /prefix
- * qualifier with the extern prefix pragma. This provisional
- * hack circumvents this prefix pragma problem in previous
- * precompilers.
- */
-#if defined(__VMS_VER) && __VMS_VER >= 70000000
-# if defined(VMS_WE_ARE_CASE_SENSITIVE) && (__DECC_VER < 60000000)
-# pragma __extern_prefix save
-# pragma __extern_prefix "" /* set to empty to prevent prefixing */
-# define geteuid decc$__unix_geteuid
-# define getuid decc$__unix_getuid
-# define stat(__p1,__p2) decc$__utc_stat(__p1,__p2)
-# define fstat(__p1,__p2) decc$__utc_fstat(__p1,__p2)
-# pragma __extern_prefix restore
-# endif
-#endif
-
#ifndef DONT_MASK_RTL_CALLS /* defined for vms.c so we can see RTL calls */
# ifdef stat
# undef stat
int Perl_my_chdir (pTHX_ const char *);
int Perl_my_chmod(pTHX_ const char *, mode_t);
FILE * Perl_my_tmpfile (void);
-#ifndef HOMEGROWN_POSIX_SIGNALS
int Perl_my_sigaction (pTHX_ int, const struct sigaction*, struct sigaction*);
-#endif
#ifdef KILL_BY_SIGPRC
unsigned int Perl_sig_to_vmscondition (int);
int Perl_my_kill (int, int);
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_sigaddset (sigset_t *, int);
-int my_sigdelset (sigset_t *, int);
-int my_sigismember (sigset_t *, int);
-int my_sigprocmask (int, sigset_t *, sigset_t *);
-#endif
I32 Perl_cando_by_name (pTHX_ I32, bool, const char *);
int Perl_flex_fstat (pTHX_ int, Stat_t *);
int Perl_flex_lstat (pTHX_ const char *, Stat_t *);
projects / platform / upstream / perl.git / commitdiff