X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/6f4183fe04888927cb36b966262c959c5166404b..b1fb3988eef353a38133699bd3524d8ef738d113:/perl.h

diff --git a/perl.h b/perl.h
index 518f4b3..3860107 100644
--- a/perl.h
+++ b/perl.h
@@ -1,6 +1,6 @@
 /*    perl.h
  *
- *    Copyright (c) 1987-1997, Larry Wall
+ *    Copyright (c) 1987-2000, Larry Wall
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -215,7 +215,10 @@ struct perl_thread;
 #define CALLREG_INTUIT_START CALL_FPTR(PL_regint_start)
 #define CALLREG_INTUIT_STRING CALL_FPTR(PL_regint_string)
 #define CALLREGFREE CALL_FPTR(PL_regfree)
-#define CALLPROTECT CALL_FPTR(PL_protect)
+
+#ifdef PERL_FLEXIBLE_EXCEPTIONS
+#  define CALLPROTECT CALL_FPTR(PL_protect)
+#endif
 
 #define NOOP (void)0
 #define dNOOP extern int Perl___notused
@@ -239,6 +242,7 @@ struct perl_thread;
 #  define aTHXo		aTHX
 #  define aTHXo_	aTHX_
 #  define dTHXo		dTHX
+#  define dTHXoa(x)	dTHXa(x)
 #endif
 
 #ifndef pTHXx
@@ -489,6 +493,10 @@ register struct op *Perl_op asm(stringify(OP_IN_REGISTER));
 #   include <stdlib.h>
 #endif
 
+#ifdef PERL_MICRO /* Last chance to export Perl_my_swap */
+#  define MYSWAP
+#endif
+
 #if !defined(PERL_FOR_X2P) && !defined(WIN32)
 #  include "embed.h"
 #endif
@@ -529,6 +537,19 @@ Malloc_t Perl_realloc (Malloc_t where, MEM_SIZE nbytes);
  * that causes clashes with case-insensitive linkers */
 Free_t   Perl_mfree (Malloc_t where);
 
+typedef struct perl_mstats perl_mstats_t;
+
+struct perl_mstats {
+    unsigned long *nfree;
+    unsigned long *ntotal;
+    long topbucket, topbucket_ev, topbucket_odd, totfree, total, total_chain;
+    long total_sbrk, sbrks, sbrk_good, sbrk_slack, start_slack, sbrked_remains;
+    long minbucket;
+    /* Level 1 info */
+    unsigned long *bucket_mem_size;
+    unsigned long *bucket_available_size;
+};
+
 #  define safemalloc  Perl_malloc
 #  define safecalloc  Perl_calloc
 #  define saferealloc Perl_realloc
@@ -804,6 +825,10 @@ Free_t   Perl_mfree (Malloc_t where);
  * in the face of half-implementations.)
  */
 
+#ifdef I_SYSMODE
+#include <sys/mode.h>
+#endif
+
 #ifndef S_IFMT
 #   ifdef _S_IFMT
 #	define S_IFMT _S_IFMT
@@ -882,12 +907,30 @@ Free_t   Perl_mfree (Malloc_t where);
 #	define S_IWUSR 0200
 #	define S_IXUSR 0100
 #   endif
-#   define S_IRGRP (S_IRUSR>>3)
-#   define S_IWGRP (S_IWUSR>>3)
-#   define S_IXGRP (S_IXUSR>>3)
-#   define S_IROTH (S_IRUSR>>6)
-#   define S_IWOTH (S_IWUSR>>6)
-#   define S_IXOTH (S_IXUSR>>6)
+#endif
+
+#ifndef S_IRGRP
+#   ifdef S_IRUSR
+#       define S_IRGRP (S_IRUSR>>3)
+#       define S_IWGRP (S_IWUSR>>3)
+#       define S_IXGRP (S_IXUSR>>3)
+#   else
+#       define S_IRGRP 0040
+#       define S_IWGRP 0020
+#       define S_IXGRP 0010
+#   endif
+#endif
+
+#ifndef S_IROTH
+#   ifdef S_IRUSR
+#       define S_IROTH (S_IRUSR>>6)
+#       define S_IWOTH (S_IWUSR>>6)
+#       define S_IXOTH (S_IXUSR>>6)
+#   else
+#       define S_IROTH 0040
+#       define S_IWOTH 0020
+#       define S_IXOTH 0010
+#   endif
 #endif
 
 #ifndef S_ISUID
@@ -898,6 +941,30 @@ Free_t   Perl_mfree (Malloc_t where);
 #   define S_ISGID 02000
 #endif
 
+#ifndef S_IRWXU
+#   define S_IRWXU (S_IRUSR|S_IWUSR|S_IXUSR)
+#endif 
+
+#ifndef S_IRWXG
+#   define S_IRWXG (S_IRGRP|S_IWGRP|S_IXGRP)
+#endif 
+
+#ifndef S_IRWXO
+#   define S_IRWXO (S_IROTH|S_IWOTH|S_IXOTH)
+#endif 
+
+#ifndef S_IREAD
+#   define S_IREAD S_IRUSR
+#endif
+
+#ifndef S_IWRITE
+#   define S_IWRITE S_IWUSR
+#endif
+
+#ifndef S_IEXEC
+#   define S_IEXEC S_IXUSR
+#endif
+
 #ifdef ff_next
 #   undef ff_next
 #endif
@@ -919,7 +986,7 @@ Free_t   Perl_mfree (Malloc_t where);
 typedef IVTYPE IV;
 typedef UVTYPE UV;
 
-#if defined(USE_64_BITS) && defined(HAS_QUAD)
+#if defined(USE_64_BIT_INT) && defined(HAS_QUAD)
 #  if QUADKIND == QUAD_IS_INT64_T && defined(INT64_MAX)
 #    define IV_MAX INT64_MAX
 #    define IV_MIN INT64_MIN
@@ -1069,11 +1136,19 @@ typedef UVTYPE UV;
 
 typedef NVTYPE NV;
 
+#ifdef I_IEEEFP
+#   include <ieeefp.h>
+#endif
+
 #ifdef USE_LONG_DOUBLE
+#   ifdef I_SUNMATH
+#       include <sunmath.h>
+#   endif
 #   define NV_DIG LDBL_DIG
+#   ifdef LDBL_MANT_DIG
+#       define NV_MANT_DIG LDBL_MANT_DIG
+#   endif
 #   ifdef HAS_SQRTL
-#       define Perl_modf modfl
-#       define Perl_frexp frexpl
 #       define Perl_cos cosl
 #       define Perl_sin sinl
 #       define Perl_sqrt sqrtl
@@ -1084,10 +1159,31 @@ typedef NVTYPE NV;
 #       define Perl_floor floorl
 #       define Perl_fmod fmodl
 #   endif
+/* e.g. libsunmath doesn't have modfl and frexpl as of mid-March 2000 */
+#   ifdef HAS_MODFL
+#       define Perl_modf(x,y) modfl(x,y)
+#   else
+#       define Perl_modf(x,y) ((long double)modf((double)(x),(double*)(y)))
+#   endif
+#   ifdef HAS_FREXPL
+#       define Perl_frexp(x,y) frexpl(x,y)
+#   else
+#       define Perl_frexp(x,y) ((long double)frexp((double)(x),y))
+#   endif
+#   ifdef HAS_ISNANL
+#       define Perl_isnan(x) isnanl(x)
+#   else
+#       ifdef HAS_ISNAN
+#           define Perl_isnan(x) isnan((double)(x))
+#       else
+#           define Perl_isnan(x) ((x)!=(x))
+#       endif
+#   endif
 #else
 #   define NV_DIG DBL_DIG
-#   define Perl_modf modf
-#   define Perl_frexp frexp
+#   ifdef DBL_MANT_DIG
+#       define NV_MANT_DIG DBL_MANT_DIG
+#   endif
 #   define Perl_cos cos
 #   define Perl_sin sin
 #   define Perl_sqrt sqrt
@@ -1097,10 +1193,17 @@ typedef NVTYPE NV;
 #   define Perl_pow pow
 #   define Perl_floor floor
 #   define Perl_fmod fmod
+#   define Perl_modf(x,y) modf(x,y)
+#   define Perl_frexp(x,y) frexp(x,y)
+#   ifdef HAS_ISNAN
+#       define Perl_isnan(x) isnan(x)
+#   else
+#       define Perl_isnan(x) ((x)!=(x))
+#   endif
 #endif
 
 #if !defined(Perl_atof) && defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE)
-#   if !defined(Perl_atof) && defined(HAS_STRTOLD)
+#   if !defined(Perl_atof) && defined(HAS_STRTOLD) 
 #       define Perl_atof(s) strtold(s, (char**)NULL)
 #   endif
 #   if !defined(Perl_atof) && defined(HAS_ATOLF)
@@ -1352,12 +1455,7 @@ typedef struct ptr_tbl PTR_TBL_t;
 
 #include "handy.h"
 
-#ifndef NO_LARGE_FILES
-#   define USE_LARGE_FILES	/* If available. */
-#endif
-
 #if defined(USE_LARGE_FILES) && !defined(NO_64_BIT_RAWIO)
-#   define USE_64_BIT_RAWIO	/* explicit */
 #   if LSEEKSIZE == 8 && !defined(USE_64_BIT_RAWIO)
 #       define USE_64_BIT_RAWIO	/* implicit */
 #   endif
@@ -1375,7 +1473,6 @@ typedef struct ptr_tbl PTR_TBL_t;
 #endif
 
 #if defined(USE_LARGE_FILES) && !defined(NO_64_BIT_STDIO)
-#   define USE_64_BIT_STDIO	/* explicit */
 #   if FSEEKSIZE == 8 && !defined(USE_64_BIT_STDIO)
 #       define USE_64_BIT_STDIO /* implicit */
 #   endif
@@ -1578,7 +1675,7 @@ typedef pthread_key_t	perl_key;
 #ifdef VMS
 #   define STATUS_NATIVE	PL_statusvalue_vms
 #   define STATUS_NATIVE_EXPORT \
-	((I32)PL_statusvalue_vms == -1 ? 44 : PL_statusvalue_vms)
+	(((I32)PL_statusvalue_vms == -1 ? 44 : PL_statusvalue_vms) | (VMSISH_HUSHED ? 0x10000000 : 0))
 #   define STATUS_NATIVE_SET(n)						\
 	STMT_START {							\
 	    PL_statusvalue_vms = (n);					\
@@ -1656,10 +1753,7 @@ typedef pthread_key_t	perl_key;
 #  define PERL_WAIT_FOR_CHILDREN	NOOP
 #endif
 
-/* the traditional thread-unsafe notion of "current interpreter".
- * XXX todo: a thread-safe version that fetches it from TLS (akin to THR)
- * needs to be defined elsewhere (conditional on pthread_getspecific()
- * availability). */
+/* the traditional thread-unsafe notion of "current interpreter". */
 #ifndef PERL_SET_INTERP
 #  define PERL_SET_INTERP(i)		(PL_curinterp = (PerlInterpreter*)(i))
 #endif
@@ -1670,18 +1764,17 @@ typedef pthread_key_t	perl_key;
 
 #if defined(PERL_IMPLICIT_CONTEXT) && !defined(PERL_GET_THX)
 #  ifdef USE_THREADS
-#    define PERL_GET_THX		THR
+#    define PERL_GET_THX		((struct perl_thread *)PERL_GET_CONTEXT)
 #  else
 #  ifdef MULTIPLICITY
-#    define PERL_GET_THX		PERL_GET_INTERP
+#    define PERL_GET_THX		((PerlInterpreter *)PERL_GET_CONTEXT)
 #  else
 #  ifdef PERL_OBJECT
-#    define PERL_GET_THX		((CPerlObj*)PERL_GET_INTERP)
-#  else
-#    define PERL_GET_THX		((void*)0)
+#    define PERL_GET_THX		((CPerlObj *)PERL_GET_CONTEXT)
 #  endif
 #  endif
 #  endif
+#  define PERL_SET_THX(t)		PERL_SET_CONTEXT(t)
 #endif
 
 #ifndef SVf
@@ -1712,16 +1805,16 @@ typedef pthread_key_t	perl_key;
 #   endif
 #endif
 
-#if defined(CYGWIN)
+#if defined(__CYGWIN__)
 /* 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.
  */
 #  define USEMYBINMODE / **/
-#  define my_binmode(fp, iotype) \
-            (PerlLIO_setmode(PerlIO_fileno(fp), O_BINARY) != -1 ? TRUE : FALSE)
+#  define my_binmode(fp, iotype, mode) \
+            (PerlLIO_setmode(PerlIO_fileno(fp), mode) != -1 ? TRUE : FALSE)
 #endif
 
 #ifdef UNION_ANY_DEFINITION
@@ -1888,8 +1981,6 @@ struct ptr_tbl {
 #define U_V(what) (cast_uv((NV)(what)))
 #endif
 
-/* Mention NV_PRESERVES_UV so that Configure picks it up. */
-
 /* These do not care about the fractional part, only about the range. */
 #define NV_WITHIN_IV(nv) (I_V(nv) >= IV_MIN && I_V(nv) <= IV_MAX)
 #define NV_WITHIN_UV(nv) ((nv)>=0.0 && U_V(nv) >= UV_MIN && U_V(nv) <= UV_MAX)
@@ -2044,9 +2135,9 @@ char *crypt (const char*, const char*);
 #    ifndef getenv
 char *getenv (const char*);
 #    endif /* !getenv */
-#ifndef EPOC
+#    if !defined(EPOC) && !(defined(__hpux) && defined(_FILE_OFFSET_BITS) && _FILE_OFFSET_BITS == 64) && !defined(HAS_LSEEK_PROTO)
 Off_t lseek (int,Off_t,int);
-#endif
+#    endif
 #  endif /* !DONT_DECLARE_STD */
 char *getlogin (void);
 #endif /* !__cplusplus */
@@ -2467,8 +2558,8 @@ enum {		/* pass one of these to get_vtbl */
 #define HINT_INTEGER		0x00000001
 #define HINT_STRICT_REFS	0x00000002
 /* #define HINT_notused4	0x00000004 */
-#define HINT_UTF8		0x00000008
-#define HINT_BYTE		0x00000010
+#define HINT_BYTE		0x00000008
+/* #define HINT_notused10	0x00000010 */
 				/* Note: 20,40,80 used for NATIVE_HINTS */
 
 #define HINT_BLOCK_SCOPE	0x00000100
@@ -2487,6 +2578,7 @@ enum {		/* pass one of these to get_vtbl */
 #define HINT_RE_EVAL		0x00200000
 
 #define HINT_FILETEST_ACCESS	0x00400000
+#define HINT_UTF8		0x00800000
 
 /* Various states of an input record separator SV (rs, nrs) */
 #define RsSNARF(sv)   (! SvOK(sv))
@@ -2951,16 +3043,22 @@ typedef struct am_table_short AMTS;
 #   endif
 #endif /* _FASTMATH */
 
-#define PERLDB_ALL	0x3f		/* No _NONAME, _GOTO */
-#define PERLDBf_SUB	0x01		/* Debug sub enter/exit. */
-#define PERLDBf_LINE	0x02		/* Keep line #. */
-#define PERLDBf_NOOPT	0x04		/* Switch off optimizations. */
-#define PERLDBf_INTER	0x08		/* Preserve more data for
-					   later inspections.  */
-#define PERLDBf_SUBLINE	0x10		/* Keep subr source lines. */
-#define PERLDBf_SINGLE	0x20		/* Start with single-step on. */
-#define PERLDBf_NONAME	0x40		/* For _SUB: no name of the subr. */
-#define PERLDBf_GOTO	0x80		/* Report goto: call DB::goto. */
+#define PERLDB_ALL		(PERLDBf_SUB	| PERLDBf_LINE	|	\
+				 PERLDBf_NOOPT	| PERLDBf_INTER	|	\
+				 PERLDBf_SUBLINE| PERLDBf_SINGLE|	\
+				 PERLDBf_NAMEEVAL| PERLDBf_NAMEANON)
+					/* No _NONAME, _GOTO */
+#define PERLDBf_SUB		0x01	/* Debug sub enter/exit */
+#define PERLDBf_LINE		0x02	/* Keep line # */
+#define PERLDBf_NOOPT		0x04	/* Switch off optimizations */
+#define PERLDBf_INTER		0x08	/* Preserve more data for
+					   later inspections  */
+#define PERLDBf_SUBLINE		0x10	/* Keep subr source lines */
+#define PERLDBf_SINGLE		0x20	/* Start with single-step on */
+#define PERLDBf_NONAME		0x40	/* For _SUB: no name of the subr */
+#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 PERLDB_SUB	(PL_perldb && (PL_perldb & PERLDBf_SUB))
 #define PERLDB_LINE	(PL_perldb && (PL_perldb & PERLDBf_LINE))
@@ -2970,6 +3068,8 @@ typedef struct am_table_short AMTS;
 #define PERLDB_SINGLE	(PL_perldb && (PL_perldb & PERLDBf_SINGLE))
 #define PERLDB_SUB_NN	(PL_perldb && (PL_perldb & (PERLDBf_NONAME)))
 #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))
 
 
 #ifdef USE_LOCALE_NUMERIC
@@ -3005,29 +3105,46 @@ typedef struct am_table_short AMTS;
 
 #endif /* !USE_LOCALE_NUMERIC */
 
-#if !defined(Atol) && defined(USE_LONG_LONG) && defined(HAS_LONG_LONG)
-#   if !defined(Atol) && defined(HAS_STRTOLL)
-#       define Atol(s) strtoll(s, (char**)NULL, 10)
-#   endif
-#   if !defined(Atol) && defined(HAS_ATOLL)
-#       define Atol atoll
+#if !defined(Strtol) && defined(USE_64_BIT_INT) && defined(IV_IS_QUAD) && QUADKIND == QUAD_IS_LONG_LONG
+#    ifdef __hpux
+#        define strtoll __strtoll	/* secret handshake */
+#    endif
+#   if !defined(Strtol) && defined(HAS_STRTOLL)
+#       define Strtol	strtoll
 #   endif
-#endif
 /* is there atoq() anywhere? */
-#if !defined(Atol)
-#   define Atol atol /* we assume atol being available anywhere */
 #endif
-
-#if !defined(Strtoul) && defined(USE_LONG_LONG) && defined(HAS_LONG_LONG) \
-	&& defined(HAS_STRTOULL)
-#   define Strtoul strtoull
+#if !defined(Strtol) && defined(HAS_STRTOL)
+#   define Strtol	strtol
+#endif
+#ifndef Atol
+/* It would be more fashionable to use Strtol() to define atol()
+ * (as is done for Atoul(), see below) but for backward compatibility
+ * we just assume atol(). */
+#   if defined(USE_64_BIT_INT) && defined(IV_IS_QUAD) && QUADKIND == QUAD_IS_LONG_LONG && defined(HAS_ATOLL)
+#       define Atol	atoll
+#   else
+#       define Atol	atol
+#   endif
 #endif
+
+#if !defined(Strtoul) && defined(USE_64_BIT_INT) && defined(UV_IS_QUAD) && QUADKIND == QUAD_IS_LONG_LONG
+#    ifdef __hpux
+#        define strtoull __strtoull	/* secret handshake */
+#    endif
+#    if !defined(Strtoul) && defined(HAS_STRTOULL)
+#       define Strtoul	strtoull
+#    endif
+#    if !defined(Strtoul) && defined(HAS_STRTOUQ)
+#       define Strtoul	strtouq
+#    endif
 /* is there atouq() anywhere? */
-#if !defined(Strtoul) && defined(USE_64_BITS) && defined(HAS_STRTOUQ)
-#   define Strtoul strtouq
 #endif
-#if !defined(Strtoul)
-#   define Strtoul strtoul /* we assume strtoul being available anywhere */
+#if !defined(Strtoul) && defined(HAS_STRTOUL)
+#   define Strtoul	strtoul
+#endif
+#ifndef Atoul
+#   define Atoul(s)	Strtoul(s, (char **)NULL, 10)
 #endif
 
 #if !defined(PERLIO_IS_STDIO) && defined(HASATTRIBUTE)
@@ -3039,6 +3156,23 @@ typedef struct am_table_short AMTS;
 #define printf PerlIO_stdoutf
 #endif
 
+/* if these never got defined, they need defaults */
+#ifndef PERL_SET_CONTEXT
+#  define PERL_SET_CONTEXT(i)		PERL_SET_INTERP(i)
+#endif
+
+#ifndef PERL_GET_CONTEXT
+#  define PERL_GET_CONTEXT		PERL_GET_INTERP
+#endif
+
+#ifndef PERL_GET_THX
+#  define PERL_GET_THX			((void*)NULL)
+#endif
+
+#ifndef PERL_SET_THX
+#  define PERL_SET_THX(t)		NOOP
+#endif
+
 #ifndef PERL_SCRIPT_MODE
 #define PERL_SCRIPT_MODE "r"
 #endif
@@ -3110,11 +3244,39 @@ typedef struct am_table_short AMTS;
 #       define Semctl(id, num, cmd, semun) semctl(id, num, cmd, semun)
 #   else
 #       ifdef USE_SEMCTL_SEMID_DS
-#           define Semctl(id, num, cmd, semun) semctl(id, num, cmd, semun.buf)
+#           ifdef EXTRA_F_IN_SEMUN_BUF
+#               define Semctl(id, num, cmd, semun) semctl(id, num, cmd, semun.buff)
+#           else
+#               define Semctl(id, num, cmd, semun) semctl(id, num, cmd, semun.buf)
+#           endif
 #       endif
 #   endif
 #endif
 
+#ifdef I_FCNTL
+#  include <fcntl.h>
+#endif
+
+#ifdef I_SYS_FILE
+#  include <sys/file.h>
+#endif
+
+#ifndef O_RDONLY
+/* Assume UNIX defaults */
+#    define O_RDONLY	0000
+#    define O_WRONLY	0001
+#    define O_RDWR	0002
+#    define O_CREAT	0100
+#endif
+
+#ifndef O_BINARY
+#  define O_BINARY 0
+#endif
+
+#ifndef O_TEXT
+#  define O_TEXT 0
+#endif
+
 #ifdef IAMSUID
 
 #ifdef I_SYS_STATVFS
@@ -3162,4 +3324,27 @@ typedef struct am_table_short AMTS;
 #include "patchlevel.h"
 #undef PERL_PATCHLEVEL_H_IMPLICIT
 
+/* Mention
+   
+   NV_PRESERVES_UV
+
+   HAS_ICONV
+   I_ICONV
+
+   HAS_MKSTEMP
+   HAS_MKSTEMPS
+   HAS_MKDTEMP
+
+   HAS_GETCWD
+
+   HAS_MMAP
+   HAS_MPROTECT
+   HAS_MSYNC
+   HAS_MADVISE
+   HAS_MUNMAP
+   I_SYSMMAN
+   Mmap_t
+
+   so that Configure picks them up. */
+
 #endif /* Include guard */