After the #6519 a warning about stat() is just that,
[p5sagit/p5-mst-13.2.git] / vms / vmsish.h
index 17aac8a..104eabc 100644 (file)
@@ -75,6 +75,9 @@
   /* getenv used for regular logical names */
 #  define getenv(v) my_getenv(v,TRUE)
 #endif
+#ifdef getenv_len
+#  undef getenv_len
+#endif
 #define getenv_len(v,l) my_getenv_len(v,l,TRUE)
 
 /* DECC introduces this routine in the RTL as of VMS 7.0; for now,
 #define DONT_DECLARE_STD 1
 
 /* Our own contribution to PerlShr's global symbols . . . */
-#define vmstrnenv              Perl_vmstrnenv
-#define my_trnlnm              Perl_my_trnlnm
 #define my_getenv_len          Perl_my_getenv_len
 #define prime_env_iter Perl_prime_env_iter
 #define vmssetenv              Perl_vmssetenv
 #if !defined(PERL_IMPLICIT_CONTEXT)
+#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 tounixspec_ts          Perl_tounixspec_ts
+#define tovmsspec              Perl_tovmsspec
+#define tovmsspec_ts           Perl_tovmsspec_ts
+#define tounixpath             Perl_tounixpath
+#define tounixpath_ts          Perl_tounixpath_ts
+#define tovmspath              Perl_tovmspath
+#define tovmspath_ts           Perl_tovmspath_ts
+#define do_rmdir               Perl_do_rmdir
+#define fileify_dirspec                Perl_fileify_dirspec
+#define fileify_dirspec_ts     Perl_fileify_dirspec_ts
+#define pathify_dirspec                Perl_pathify_dirspec
+#define pathify_dirspec_ts     Perl_pathify_dirspec_ts
+#define trim_unixpath          Perl_trim_unixpath
+#define opendir                        Perl_opendir
+#define rmscopy                        Perl_rmscopy
 #else
+#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 tounixspec_ts(a,b)     Perl_tounixspec_ts(aTHX_ a,b)
+#define tovmsspec(a,b)         Perl_tovmsspec(aTHX_ a,b)
+#define tovmsspec_t(a,b)       Perl_tovmsspec_ts(aTHX_ a,b)
+#define tounixpath(a,b)                Perl_tounixpath(aTHX_ a,b)
+#define tounixpath_ts(a,b)     Perl_tounixpath_ts(aTHX_ a,b)
+#define tovmspath(a,b)         Perl_tovmspath(aTHX_ a,b)
+#define tovmspath_ts(a,b)      Perl_tovmspath_ts(aTHX_ a,b)
+#define do_rmdir(a)            Perl_do_rmdir(aTHX_ a)
+#define fileify_dirspec(a,b)   Perl_fileify_dirspec(aTHX_ a,b)
+#define fileify_dirspec_ts(a,b)        Perl_fileify_dirspec_ts(aTHX_ a,b)
+#define pathify_dirspec                Perl_pathify_dirspec
+#define pathify_dirspec_ts     Perl_pathify_dirspec_ts
+#define rmsexpand(a,b,c,d)     Perl_rmsexpand(aTHX_ a,b,c,d)
+#define rmsexpand_ts(a,b,c,d)  Perl_rmsexpand_ts(aTHX_ a,b,c,d)
+#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)
 #endif
 #define my_crypt               Perl_my_crypt
 #define my_waitpid             Perl_my_waitpid
 #define my_gconvert            Perl_my_gconvert
-#define do_rmdir               Perl_do_rmdir
 #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 rmsexpand      Perl_rmsexpand
-#define rmsexpand_ts   Perl_rmsexpand_ts
-#define fileify_dirspec        Perl_fileify_dirspec
-#define fileify_dirspec_ts     Perl_fileify_dirspec_ts
-#define pathify_dirspec        Perl_pathify_dirspec
-#define pathify_dirspec_ts     Perl_pathify_dirspec_ts
-#define tounixspec             Perl_tounixspec
-#define tounixspec_ts          Perl_tounixspec_ts
-#define tovmsspec              Perl_tovmsspec
-#define tovmsspec_ts           Perl_tovmsspec_ts
-#define tounixpath             Perl_tounixpath
-#define tounixpath_ts          Perl_tounixpath_ts
-#define tovmspath              Perl_tovmspath
-#define tovmspath_ts           Perl_tovmspath_ts
 #define vms_image_init Perl_vms_image_init
-#define opendir                Perl_opendir
 #define readdir                Perl_readdir
 #define telldir                Perl_telldir
 #define seekdir                Perl_seekdir
 #define cando_by_name          Perl_cando_by_name
 #define flex_fstat             Perl_flex_fstat
 #define flex_stat              Perl_flex_stat
-#define trim_unixpath          Perl_trim_unixpath
 #define my_vfork               Perl_my_vfork
 #define vms_do_aexec           Perl_vms_do_aexec
 #define vms_do_exec            Perl_vms_do_exec
 #define my_getpwent            Perl_my_getpwent
 #define my_endpwent            Perl_my_endpwent
 #define my_getlogin            Perl_my_getlogin
-#define rmscopy                Perl_rmscopy
 #define init_os_extras Perl_init_os_extras
 
 /* Delete if at all possible, changing protections if necessary. */
 #  define vfork my_vfork
 #endif
 
+/*
+ * Toss in a shim to tmpfile which creates a plain temp file if the
+ * RMS tmp mechanism won't work (e.g. if someone is relying on ACLs
+ * from a specific directory to permit creation of files).
+ */
+#ifndef DONT_MASK_RTL_CALLS
+#  define tmpfile my_tmpfile
+#endif
+
+
 /* BIG_TIME:
  *     This symbol is defined if Time_t is an unsigned type on this system.
  */
  */
 #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 COMPLEX_STATUS 1       /* We track both "POSIX" and VMS values */
 
 #define HINT_V_VMSISH          24
-#define HINT_M_VMSISH_STATUS   0x20000000 /* system, $? return VMS status */
-#define HINT_M_VMSISH_EXIT     0x40000000 /* exit(1) ==> SS$_NORMAL */
+#define HINT_M_VMSISH_HUSHED   0x20000000 /* stifle error msgs on exit */
+#define HINT_M_VMSISH_STATUS   0x40000000 /* system, $? return VMS status */
 #define HINT_M_VMSISH_TIME     0x80000000 /* times are local, not UTC */
 #define NATIVE_HINTS           (PL_hints >> HINT_V_VMSISH)  /* used in op.c */
 
 #define TEST_VMSISH(h) (PL_curcop->op_private & ((h) >> HINT_V_VMSISH))
+#define VMSISH_HUSHED  TEST_VMSISH(HINT_M_VMSISH_HUSHED)
 #define VMSISH_STATUS  TEST_VMSISH(HINT_M_VMSISH_STATUS)
-#define VMSISH_EXIT    TEST_VMSISH(HINT_M_VMSISH_EXIT)
 #define VMSISH_TIME    TEST_VMSISH(HINT_M_VMSISH_TIME)
 
 /* Flags for vmstrnenv() */
 
 #ifdef VMS_DO_SOCKETS
 #include "sockadapt.h"
+#define PERL_SOCK_SYSREAD_IS_RECV
+#define PERL_SOCK_SYSWRITE_IS_SEND
 #endif
 
 #define BIT_BUCKET "_NLA0:"
 #define PERL_SYS_INIT(c,v)     vms_image_init((c),(v)); MALLOC_INIT
-#define PERL_SYS_TERM()                MALLOC_TERM
+#define PERL_SYS_TERM()                OP_REFCNT_TERM; MALLOC_TERM
 #define dXSUB_SYS
 #define HAS_KILL
 #define HAS_WAIT
 
+#define PERL_FS_VER_FMT                "%d_%d_%d"
+/* Temporary; we need to add support for this to Configure.Com */
+#ifdef PERL_INC_VERSION_LIST
+#  undef PERL_INC_VERSION_LIST
+#endif
+
 /* VMS:
  *     This symbol, if defined, indicates that the program is running under
  *     VMS.  It's a symbol automagically defined by all VMS C compilers I've seen.
   
 /* USEMYBINMODE
  *     This symbol, if defined, indicates that the program should
- *     use the routine my_binmode(FILE *fp, char iotype) to insure
+ *     use the routine my_binmode(FILE *fp, char iotype, int mode) to insure
  *     that a file is in "binary" mode -- that is, that no translation
  *     of bytes occurs on read or write operations.
  */
@@ -428,8 +479,9 @@ struct utimbuf {
 /* Ditto for sys$hash_passwrod() . . . */
 #define crypt  my_crypt
 
-/* Tweak arg to mkdir first, so we can tolerate trailing /. */
+/* Tweak arg to mkdir & chdir first, so we can tolerate trailing /. */
 #define Mkdir(dir,mode) my_mkdir((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)
@@ -532,6 +584,25 @@ struct mystat
 };
 typedef unsigned mydev_t;
 typedef unsigned myino_t;
+
+/*
+ * 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
@@ -551,6 +622,7 @@ typedef unsigned myino_t;
 #define S_IDGRP (S_IWGRP | S_IXGRP)
 #define S_IDOTH (S_IWOTH | S_IXOTH)
 
+
 /* Prototypes for functions unique to vms.c.  Don't include replacements
  * for routines in the mainline source files excluded by #ifndef VMS;
  * their prototypes are already in proto.h.
@@ -584,38 +656,62 @@ void      prime_env_iter (void);
 void   init_os_extras ();
 /* prototype section start marker; `typedef' passes through cpp */
 typedef char  __VMS_PROTOTYPES__;
-int    vmstrnenv (const char *, char *, unsigned long int, struct dsc$descriptor_s **, unsigned long int);
-int    my_trnlnm (const char *, char *, 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 *);
+char * Perl_tovmsspec (char *, char *);
+char * Perl_tovmsspec_ts (char *, char *);
+char * Perl_tounixpath (char *, char *);
+char * Perl_tounixpath_ts (char *, char *);
+char * Perl_tovmspath (char *, char *);
+char * Perl_tovmspath_ts (char *, char *);
+int    Perl_do_rmdir (char *);
+char * Perl_fileify_dirspec (char *, char *);
+char * Perl_fileify_dirspec_ts (char *, char *);
+char * Perl_pathify_dirspec (char *, char *);
+char * Perl_pathify_dirspec_ts (char *, char *);
+char * Perl_rmsexpand (char *, char *, char *, unsigned);
+char * Perl_rmsexpand_ts (char *, char *, char *, unsigned);
+int    Perl_trim_unixpath (char *, char*, int);
+DIR *  Perl_opendir (char *);
+int    Perl_rmscopy (char *, char *, int);
 #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 *);
+char * Perl_tounixspec_ts (pTHX_ char *, char *);
+char * Perl_tovmsspec (pTHX_ char *, char *);
+char * Perl_tovmsspec_ts (pTHX_ char *, char *);
+char * Perl_tounixpath (pTHX_ char *, char *);
+char * Perl_tounixpath_ts (pTHX_ char *, char *);
+char * Perl_tovmspath (pTHX_ char *, char *);
+char * Perl_tovmspath_ts (pTHX_ char *, char *);
+int    Perl_do_rmdir (pTHX_ char *);
+char * Perl_fileify_dirspec (pTHX_ char *, char *);
+char * Perl_fileify_dirspec_ts (pTHX_ char *, char *);
+char * Perl_pathify_dirspec (pTHX_ char *, char *);
+char * Perl_pathify_dirspec_ts (pTHX_ char *, char *);
+char * Perl_rmsexpand (pTHX_ char *, char *, char *, unsigned);
+char * Perl_rmsexpand_ts (pTHX_ char *, char *, char *, unsigned);
+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 **);
 char * my_crypt (const char *, const char *);
 Pid_t  my_waitpid (Pid_t, int *, int);
 char * my_gconvert (double, int, int, char *);
-int    do_rmdir (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 *);
-char * rmsexpand (char *, char *, char *, unsigned);
-char * rmsexpand_ts (char *, char *, char *, unsigned);
-char * fileify_dirspec (char *, char *);
-char * fileify_dirspec_ts (char *, char *);
-char * pathify_dirspec (char *, char *);
-char * pathify_dirspec_ts (char *, char *);
-char * tounixspec (char *, char *);
-char * tounixspec_ts (char *, char *);
-char * tovmsspec (char *, char *);
-char * tovmsspec_ts (char *, char *);
-char * tounixpath (char *, char *);
-char * tounixpath_ts (char *, char *);
-char * tovmspath (char *, char *);
-char * tovmspath_ts (char *, char *);
 void   vms_image_init (int *, char ***);
-DIR *  opendir (char *);
 struct dirent *        readdir (DIR *);
 long   telldir (DIR *);
 void   seekdir (DIR *, long);
@@ -632,10 +728,9 @@ int     my_sigdelset   (sigset_t *, int);
 int     my_sigismember (sigset_t *, int);
 int     my_sigprocmask (int, sigset_t *, sigset_t *);
 #endif
-I32    cando_by_name (I32, I32, char *);
+I32    cando_by_name (I32, Uid_t, char *);
 int    flex_fstat (int, 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 **);
 bool   vms_do_exec (char *);
@@ -648,7 +743,6 @@ struct passwd *     my_getpwuid (Uid_t uid);
 struct passwd *        my_getpwent ();
 void   my_endpwent ();
 char * my_getlogin ();
-int    rmscopy (char *, char *, int);
 typedef char __VMS_SEPYTOTORP__;
 /* prototype section end marker; `typedef' passes through cpp */
 
@@ -678,6 +772,9 @@ typedef char __VMS_SEPYTOTORP__;
 #undef HAS_NTOHL
 #endif
 
-#define TMPPATH "sys$scratch:perl-eXXXXXX"
+/* The C RTL manual says to undef the macro for DEC C 5.2 and lower. */
+#if defined(fileno) && defined(__DECC_VER) && __DECC_VER < 50300000
+#  undef fileno 
+#endif 
 
 #endif  /* __vmsish_h_included */