Not quite so relicy as thought in #11651 (op/concat #4 and #5

[p5sagit/p5-mst-13.2.git] / vms / vmsish.h

diff --git a/vms/vmsish.h b/vms/vmsish.h
index 2eb8e93..93af772 100644 (file)
--- a/vms/vmsish.h
+++ b/vms/vmsish.h
@@ -310,7 +310,7 @@
 #define _ckvmssts_noperl(call) STMT_START { register unsigned long int __ckvms_sts; \
   if (!((__ckvms_sts=(call))&1)) { \
   set_errno(EVMSERR); set_vaxc_errno(__ckvms_sts); \
-  fprintf(Perl_debug_log,"Fatal VMS error (status=%d) at %s, line %d", \
+  fprintf(stderr,"Fatal VMS error (status=%d) at %s, line %d", \
   __ckvms_sts,__FILE__,__LINE__); lib$signal(__ckvms_sts); } } STMT_END
 
 #ifdef VMS_DO_SOCKETS
@@ -411,6 +411,7 @@
 
 
 #ifndef DONT_MASK_RTL_CALLS
+#  define fwrite my_fwrite     /* for PerlSIO_fwrite */
 #  define fdopen my_fdopen
 #  define fclose my_fclose
 #endif
@@ -491,6 +492,14 @@ struct utimbuf {
 #  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
+#    define sigaction(a,b,c) Perl_my_sigaction(a,b,c)
+#  endif
 #endif
 
 /* VMS doesn't use a real sys_nerr, but we need this when scanning for error
@@ -501,7 +510,6 @@ struct utimbuf {
 
 /* Look up new %ENV values on the fly */
 #define DYNAMIC_ENV_FETCH 1
-#define ENV_HV_NAME "%EnV%VmS%"
   /* Special getenv function for retrieving %ENV elements. */
 #define ENVgetenv(v) my_getenv(v,FALSE)
 #define ENVgetenv_len(v,l) my_getenv_len(v,l,FALSE)
@@ -747,6 +755,9 @@ char *      my_gconvert (double, int, int, char *);
 int    Perl_kill_file (pTHX_ char *);
 int    Perl_my_chdir (pTHX_ char *);
 FILE * Perl_my_tmpfile ();
+#ifndef HOMEGROWN_POSIX_SIGNALS
+int    Perl_my_sigaction (pTHX_ int, const struct sigaction*, struct sigaction*);
+#endif
 int    Perl_my_utime (pTHX_ char *, struct utimbuf *);
 void   Perl_vms_image_init (int *, char ***);
 struct dirent *        Perl_readdir (pTHX_ DIR *);
@@ -774,7 +785,7 @@ unsigned long int   Perl_do_aspawn (pTHX_ void *, void **, void **);
 unsigned long int      Perl_do_spawn (pTHX_ char *);
 FILE *  my_fdopen (int, const char *);
 int     my_fclose (FILE *);
-int    my_fwrite (void *, size_t, size_t, FILE *);
+int    my_fwrite (const void *, size_t, size_t, FILE *);
 int    Perl_my_flush (pTHX_ FILE *);
 struct passwd *        Perl_my_getpwnam (pTHX_ char *name);
 struct passwd *        Perl_my_getpwuid (pTHX_ Uid_t uid);