X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/d2c25739add64fa456c06f60e5029d44b4a14912..6a3877213b55d5920eb5e5c6dcf5a318e5bccc83:/perl.h

diff --git a/perl.h b/perl.h
index 7ad3176..d913929 100644
--- a/perl.h
+++ b/perl.h
@@ -1,7 +1,7 @@
 /*    perl.h
  *
- *    Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999,
- *    2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, by Larry Wall and others
+ *    Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001
+ *    2002, 2003, 2004, 2005, 2006, 2007, 2008 by Larry Wall and others
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -1306,8 +1306,12 @@ EXTERN_C char *crypt(const char *, const char *);
 #endif
 
 #define ERRSV GvSV(PL_errgv)
-/* FIXME? Change the assignments to PL_defgv to instantiate GvSV?  */
-#define DEFSV GvSVn(PL_defgv)
+#ifdef PERL_CORE
+# define DEFSV (0 + GvSVn(PL_defgv))
+#else
+# define DEFSV GvSVn(PL_defgv)
+#endif
+#define DEFSV_set(sv) (GvSV(PL_defgv) = (sv))
 #define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv))
 
 #define ERRHV GvHV(PL_errgv)	/* XXX unused, here for compatibility */
@@ -1539,15 +1543,15 @@ EXTERN_C char *crypt(const char *, const char *);
 #   define S_IRWXO (S_IROTH|S_IWOTH|S_IXOTH)
 #endif
 
-/* BeOS 5.0 seems to define S_IREAD and S_IWRITE in <posix/fcntl.h>
+/* BeOS 5.0 and Haiku R1 seem to define S_IREAD and S_IWRITE in <posix/fcntl.h>
  * which would get included through <sys/file.h >, but that is 3000
  * lines in the future.  --jhi */
 
-#if !defined(S_IREAD) && !defined(__BEOS__)
+#if !defined(S_IREAD) && !(defined(__BEOS__) || defined(__HAIKU__))
 #   define S_IREAD S_IRUSR
 #endif
 
-#if !defined(S_IWRITE) && !defined(__BEOS__)
+#if !defined(S_IWRITE) && !(defined(__BEOS__) || defined(__HAIKU__))
 #   define S_IWRITE S_IWUSR
 #endif
 
@@ -2571,7 +2575,10 @@ typedef struct clone_params CLONE_PARAMS;
 #   define ISHISH "macos classic"
 #endif
 
-#if defined(__BEOS__)
+#if defined(__HAIKU__)
+#   include "haiku/haikuish.h"
+#   define ISHISH "haiku"
+#elif defined(__BEOS__)
 #   include "beos/beosish.h"
 #   define ISHISH "beos"
 #endif
@@ -2651,7 +2658,11 @@ typedef struct clone_params CLONE_PARAMS;
 #    if HAS_FLOATINGPOINT_H
 #      include <floatingpoint.h>
 #    endif
-#    define PERL_FPU_INIT fpsetmask(0)
+/* Some operating systems have this as a macro, which in turn expands to a comma
+   expression, and the last sub-expression is something that gets calculated,
+   and then they have the gall to warn that a value computed is not used. Hence
+   cast to void.  */
+#    define PERL_FPU_INIT (void)fpsetmask(0)
 #  else
 #    if defined(SIGFPE) && defined(SIG_IGN) && !defined(PERL_MICRO)
 #      define PERL_FPU_INIT       PL_sigfpe_saved = (Sighandler_t) signal(SIGFPE, SIG_IGN)
@@ -2721,6 +2732,9 @@ typedef struct clone_params CLONE_PARAMS;
 
 #ifndef PERL_MICRO
 #if defined __GNUC__ && !defined(__INTEL_COMPILER)
+#  if __GNUC__ == 3 && __GNUC_MINOR__ >= 1 || __GNUC__ > 3 /* 3.1 -> */
+#    define HASATTRIBUTE_DEPRECATED
+#  endif
 #  if __GNUC__ >= 3 /* 3.0 -> */ /* XXX Verify this version */
 #    define HASATTRIBUTE_FORMAT
 #    if defined __MINGW32__
@@ -2930,9 +2944,9 @@ typedef pthread_key_t	perl_key;
 		  PL_statusvalue_vms == SS$_NORMAL;	\
 		else					\
 		  if (MY_POSIX_EXIT)			\
-		    PL_statusvalue_vms =	\
-		       (C_FAC_POSIX | (evalue << 3 ) | (evalue == 1)? \
-		        (STS$K_ERROR | STS$M_INHIB_MSG) : 1); \
+		    PL_statusvalue_vms =		\
+		       (C_FAC_POSIX | (evalue << 3 ) |	\
+		       ((evalue == 1) ? (STS$K_ERROR | STS$M_INHIB_MSG) : 1)); \
 		  else					\
 		    PL_statusvalue_vms = SS$_ABORT; \
 	      } else { /* forgive them Perl, for they have sinned */ \
@@ -2958,6 +2972,9 @@ typedef pthread_key_t	perl_key;
    * actual exit code will can be retrieved by the calling program or
    * shell.
    *
+   * A POSIX exit code is from 0 to 255.  If the exit code is higher
+   * than this, it needs to be assumed that it is a VMS exit code and
+   * passed through.
    */
 
 #   define STATUS_EXIT_SET(n)				\
@@ -2965,9 +2982,10 @@ typedef pthread_key_t	perl_key;
 	    I32 evalue = (I32)n;			\
 	    PL_statusvalue = evalue;			\
 	    if (MY_POSIX_EXIT)				\
-		PL_statusvalue_vms =			\
-		  (C_FAC_POSIX | (evalue << 3 ) | (evalue == 1)? \
-		   (STS$K_ERROR | STS$M_INHIB_MSG) : 1); \
+		if (evalue > 255) PL_statusvalue_vms = evalue; else {	\
+		  PL_statusvalue_vms = \
+		    (C_FAC_POSIX | (evalue << 3 ) |	\
+		     ((evalue == 1) ? (STS$K_ERROR | STS$M_INHIB_MSG) : 1));} \
 	    else					\
 		PL_statusvalue_vms = evalue ? evalue : SS$_NORMAL; \
 	    set_vaxc_errno(PL_statusvalue_vms);		\
@@ -3135,6 +3153,9 @@ typedef pthread_key_t	perl_key;
 #  endif
 #endif
 
+#ifdef HASATTRIBUTE_DEPRECATED
+#  define __attribute__deprecated__         __attribute__((deprecated))
+#endif
 #ifdef HASATTRIBUTE_FORMAT
 #  define __attribute__format__(x,y,z)      __attribute__((format(x,y,z)))
 #endif
@@ -3158,6 +3179,9 @@ typedef pthread_key_t	perl_key;
 #endif
 
 /* If we haven't defined the attributes yet, define them to blank. */
+#ifndef __attribute__deprecated__
+#  define __attribute__deprecated__
+#endif
 #ifndef __attribute__format__
 #  define __attribute__format__(x,y,z)
 #endif
@@ -4059,6 +4083,8 @@ struct perl_memory_debug_header {
 	(MEM_ALIGNBYTES - sizeof(struct perl_memory_debug_header) \
 	 %MEM_ALIGNBYTES) % MEM_ALIGNBYTES)
 
+#else
+#  define sTHX	0
 #endif
 
 #ifdef PERL_TRACK_MEMPOOL
@@ -4071,6 +4097,34 @@ struct perl_memory_debug_header {
 #  define INIT_TRACK_MEMPOOL(header, interp)
 #endif
 
+#ifdef I_MALLOCMALLOC
+/* Needed for malloc_size(), malloc_good_size() on some systems */
+#  include <malloc/malloc.h>
+#endif
+
+#ifdef MYMALLOC
+#  define Perl_safesysmalloc_size(where)	Perl_malloced_size(where)
+#else
+#  ifdef HAS_MALLOC_SIZE
+#    ifdef PERL_TRACK_MEMPOOL
+#	define Perl_safesysmalloc_size(where)			\
+	    (malloc_size(((char *)(where)) - sTHX) - sTHX)
+#    else
+#	define Perl_safesysmalloc_size(where) malloc_size(where)
+#    endif
+#  endif
+#  ifdef HAS_MALLOC_GOOD_SIZE
+#    ifdef PERL_TRACK_MEMPOOL
+#	define Perl_malloc_good_size(how_much)			\
+	    (malloc_good_size((how_much) + sTHX) - sTHX)
+#    else
+#	define Perl_malloc_good_size(how_much) malloc_good_size(how_much)
+#    endif
+#  else
+/* Having this as the identity operation makes some code simpler.  */
+#	define Perl_malloc_good_size(how_much)	(how_much)
+#  endif
+#endif
 
 typedef int (CPERLscope(*runops_proc_t)) (pTHX);
 typedef void (CPERLscope(*share_proc_t)) (pTHX_ SV *sv);
@@ -4632,7 +4686,7 @@ typedef regexp*(CPERLscope(*regdupe_t)) (pTHX_ const regexp* r, CLONE_PARAMS *pa
 typedef void (*DESTRUCTORFUNC_NOCONTEXT_t) (void*);
 typedef void (*DESTRUCTORFUNC_t) (pTHX_ void*);
 typedef void (*SVFUNC_t) (pTHX_ SV* const);
-typedef I32  (*SVCOMPARE_t) (pTHX_ SV*, SV*);
+typedef I32  (*SVCOMPARE_t) (pTHX_ SV* const, SV* const);
 typedef void (*XSINIT_t) (pTHX);
 typedef void (*ATEXIT_t) (pTHX_ void*);
 typedef void (*XSUBADDR_t) (pTHX_ CV *);
@@ -5286,8 +5340,9 @@ typedef struct am_table_short AMTS;
 #define PERLDB_ALL		(PERLDBf_SUB	| PERLDBf_LINE	|	\
 				 PERLDBf_NOOPT	| PERLDBf_INTER	|	\
 				 PERLDBf_SUBLINE| PERLDBf_SINGLE|	\
-				 PERLDBf_NAMEEVAL| PERLDBf_NAMEANON )
-					/* No _NONAME, _GOTO, _ASSERTION */
+				 PERLDBf_NAMEEVAL| PERLDBf_NAMEANON |   \
+				 PERLDBf_SAVESRC)
+					/* No _NONAME, _GOTO */
 #define PERLDBf_SUB		0x01	/* Debug sub enter/exit */
 #define PERLDBf_LINE		0x02	/* Keep line # */
 #define PERLDBf_NOOPT		0x04	/* Switch off optimizations */
@@ -5299,6 +5354,9 @@ typedef struct am_table_short AMTS;
 #define PERLDBf_GOTO		0x80	/* Report goto: call DB::goto */
 #define PERLDBf_NAMEEVAL	0x100	/* Informative names for evals */
 #define PERLDBf_NAMEANON	0x200	/* Informative names for anon subs */
+#define PERLDBf_SAVESRC  	0x400	/* Save source lines into @{"_<$filename"} */
+#define PERLDBf_SAVESRC_NOSUBS	0x800	/* Including evals that generate no subrouties */
+#define PERLDBf_SAVESRC_INVALID	0x1000	/* Save source that did not compile */
 
 #define PERLDB_SUB	(PL_perldb && (PL_perldb & PERLDBf_SUB))
 #define PERLDB_LINE	(PL_perldb && (PL_perldb & PERLDBf_LINE))
@@ -5310,7 +5368,9 @@ typedef struct am_table_short AMTS;
 #define PERLDB_GOTO	(PL_perldb && (PL_perldb & PERLDBf_GOTO))
 #define PERLDB_NAMEEVAL	(PL_perldb && (PL_perldb & PERLDBf_NAMEEVAL))
 #define PERLDB_NAMEANON	(PL_perldb && (PL_perldb & PERLDBf_NAMEANON))
-#define PERLDB_ASSERTION (PL_perldb && (PL_perldb & PERLDBf_ASSERTION))
+#define PERLDB_SAVESRC 	(PL_perldb && (PL_perldb & PERLDBf_SAVESRC))
+#define PERLDB_SAVESRC_NOSUBS	(PL_perldb && (PL_perldb & PERLDBf_SAVESRC_NOSUBS))
+#define PERLDB_SAVESRC_INVALID	(PL_perldb && (PL_perldb & PERLDBf_SAVESRC_INVALID))
 
 #ifdef USE_LOCALE_NUMERIC
 
@@ -5656,9 +5716,10 @@ int flock(int fd, int op);
 #if O_TEXT != O_BINARY
     /* If you have different O_TEXT and O_BINARY and you are a CLRF shop,
      * that is, you are somehow DOSish. */
-#   if defined(__BEOS__) || defined(__VOS__) || defined(__CYGWIN__)
-    /* BeOS has O_TEXT != O_BINARY but O_TEXT and O_BINARY have no effect;
-     * BeOS is always UNIXoid (LF), not DOSish (CRLF). */
+#   if defined(__BEOS__) || defined(__HAIKU__) || defined(__VOS__) || \
+	defined(__CYGWIN__)
+    /* BeOS/Haiku has O_TEXT != O_BINARY but O_TEXT and O_BINARY have no effect;
+     * BeOS/Haiku is always UNIXoid (LF), not DOSish (CRLF). */
     /* VOS has O_TEXT != O_BINARY, and they have effect,
      * but VOS always uses LF, never CRLF. */
     /* If you have O_TEXT different from your O_BINARY but you still are
@@ -5974,6 +6035,8 @@ extern void moncontrol(int);
 
 #endif /* Include guard */
 
+#define CLEAR_ERRSV() STMT_START { sv_setpvn(ERRSV,"",0); if (SvMAGICAL(ERRSV)) { mg_free(ERRSV); } SvPOK_only(ERRSV); } STMT_END
+
 /*
  * Local variables:
  * c-indentation-style: bsd