Introduce more floating point classifying APIs;
[p5sagit/p5-mst-13.2.git] / perl.h
diff --git a/perl.h b/perl.h
index 4ceefc4..cba24be 100644 (file)
--- a/perl.h
+++ b/perl.h
@@ -225,8 +225,20 @@ struct perl_thread;
 #  define CALLPROTECT CALL_FPTR(PL_protect)
 #endif
 
+#ifdef HASATTRIBUTE
+#  define PERL_UNUSED_DECL __attribute__((unused))
+#else
+#  define PERL_UNUSED_DECL
+#endif
+
+/* gcc -Wall:
+ * for silencing unused variables that are actually used most of the time,
+ * but we cannot quite get rid of, such `ax' in PPCODE+noargs xsubs
+ */
+#define PERL_UNUSED_VAR(var) if (0) var = var
+
 #define NOOP (void)0
-#define dNOOP extern int Perl___notused __attribute__ ((unused))
+#define dNOOP extern int Perl___notused PERL_UNUSED_DECL
 
 #ifndef pTHX
 #  define pTHX         void
@@ -258,6 +270,15 @@ struct perl_thread;
 #  define dTHXx                dTHX
 #endif
 
+/* Under PERL_IMPLICIT_SYS (used in Windows for fork emulation)
+ * PerlIO_foo() expands to PL_StdIO->pFOO(PL_StdIO, ...).
+ * dTHXs is therefore needed for all functions using PerlIO_foo(). */
+#ifdef PERL_IMPLICIT_SYS
+#  define dTHXs                dTHX
+#else
+#  define dTHXs                dNOOP
+#endif
+
 #undef START_EXTERN_C
 #undef END_EXTERN_C
 #undef EXTERN_C
@@ -339,15 +360,15 @@ register struct op *Perl_op asm(stringify(OP_IN_REGISTER));
  */
 
 /* define this once if either system, instead of cluttering up the src */
-#if defined(MSDOS) || defined(atarist) || defined(WIN32)
+#if defined(MSDOS) || defined(atarist) || defined(WIN32) || defined(NETWARE)
 #define DOSISH 1
 #endif
 
-#if defined(__STDC__) || defined(vax11c) || defined(_AIX) || defined(__stdc__) || defined(__cplusplus) || defined( EPOC)
+#if defined(__STDC__) || defined(vax11c) || defined(_AIX) || defined(__stdc__) || defined(__cplusplus) || defined( EPOC) || defined(NETWARE)
 # define STANDARD_C 1
 #endif
 
-#if defined(__cplusplus) || defined(WIN32) || defined(__sgi) || defined(OS2) || defined(__DGUX) || defined( EPOC) || defined(__QNX__)
+#if defined(__cplusplus) || defined(WIN32) || defined(__sgi) || defined(OS2) || defined(__DGUX) || defined( EPOC) || defined(__QNX__) || defined(NETWARE)
 # define DONT_DECLARE_STD 1
 #endif
 
@@ -731,7 +752,7 @@ typedef struct perl_mstats perl_mstats_t;
 #  define _SOCKADDR_LEN
 #endif
 
-#if defined(HAS_SOCKET) && !defined(VMS) /* VMS handles sockets via vmsish.h */
+#if defined(HAS_SOCKET) && !defined(VMS) && !defined(WIN32) /* VMS/WIN32 handle sockets via vmsish.h/win32.h */
 # include <sys/socket.h>
 # if defined(USE_SOCKS) && defined(I_SOCKS)
 #   if !defined(INCLUDE_PROTOTYPES)
@@ -756,6 +777,9 @@ typedef struct perl_mstats perl_mstats_t;
 #   endif
 # endif
 # ifdef I_NETDB
+#  ifdef NETWARE
+#   include<stdio.h>
+#  endif
 #  include <netdb.h>
 # endif
 # ifndef ENOTSOCK
@@ -1042,6 +1066,10 @@ int sockatmark(int);
 #undef UV
 #endif
 
+#ifdef SPRINTF_E_BUG
+#  define sprintf UTS_sprintf_wrap
+#endif
+
 /* Configure gets this right but the UTS compiler gets it wrong.
    -- Hal Morris <hom00@utsglobal.com> */
 #ifdef UTS
@@ -1107,23 +1135,9 @@ typedef UVTYPE UV;
 #  endif
 #endif
 
-/*
-  I've tracked down a weird bug in Perl5.6.1 to the UTS compiler's
-  mishandling of MY_UV_MAX in util.c.  It is defined as
-    #ifndef MY_UV_MAX
-    #  define MY_UV_MAX ((UV)IV_MAX * (UV)2 + (UV)1)
-    #endif
-  The compiler handles {double floating point value} >= MY_UV_MAX as if
-  MY_UV_MAX were the signed integer -1.  In fact it will do the same
-  thing with (UV)(0xffffffff), in place of MY_UV_MAX, though 0xffffffff
-  *without* the typecast to UV works fine.
-
-  hom00@utsglobal.com (Hal Morris) 2001-05-02
-
-  */
-
-#ifdef UTS
-#  define MY_UV_MAX 0xffffffff 
+#if defined(uts) || defined(UTS)
+#      undef UV_MAX
+#      define UV_MAX (4294967295u)
 #endif
 
 #define IV_DIG (BIT_DIGITS(IVSIZE * 8))
@@ -1285,13 +1299,14 @@ typedef NVTYPE NV;
 #   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))
+#   ifndef Perl_isinf
+#       ifdef HAS_ISNANL
+#           define Perl_isnan(x) isnanl(x)
+#       endif
+#   endif
+#   ifndef Perl_isinf
+#       ifdef HAS_FINITEL
+#           define Perl_isinf(x) !(finitel(x)||Perl_isnan(x))
 #       endif
 #   endif
 #else
@@ -1318,10 +1333,139 @@ typedef NVTYPE NV;
 #   define Perl_fmod fmod
 #   define Perl_modf(x,y) modf(x,y)
 #   define Perl_frexp(x,y) frexp(x,y)
+#endif
+
+/* rumor has it that Win32 has _fpclass() */
+
+#if !defined(Perl_fp_class) && (defined(HAS_FPCLASS)||defined(HAS_FPCLASSL))
+#    ifdef I_IEEFP
+#        include <ieeefp.h>
+#    endif
+#    ifdef I_FP
+#        include <fp.h>
+#    endif
+#    if defined(USE_LONG_DOUBLE) && defined(HAS_FPCLASSL)
+#        define Perl_fp_class()                fpclassl(x)
+#    else
+#        define Perl_fp_class()                fpclass(x)
+#    endif
+#    define Perl_fp_class_snan(x)      (Perl_fp_class(x)==FP_CLASS_SNAN)
+#    define Perl_fp_class_qnan(x)      (Perl_fp_class(x)==FP_CLASS_QNAN)
+#    define Perl_fp_class_nan(x)       (Perl_fp_class(x)==FP_CLASS_SNAN||Perl_fp_class(x)==FP_CLASS_QNAN)
+#    define Perl_fp_class_ninf(x)      (Perl_fp_class(x)==FP_CLASS_NINF)
+#    define Perl_fp_class_pinf(x)      (Perl_fp_class(x)==FP_CLASS_PINF)
+#    define Perl_fp_class_inf(x)       (Perl_fp_class(x)==FP_CLASS_NINF||Perl_fp_class(x)==FP_CLASS_PINF)
+#    define Perl_fp_class_nnorm(x)     (Perl_fp_class(x)==FP_CLASS_NNORM)
+#    define Perl_fp_class_pnorm(x)     (Perl_fp_class(x)==FP_CLASS_PNORM)
+#    define Perl_fp_class_norm(x)      (Perl_fp_class(x)==FP_CLASS_NNORM||Perl_fp_class(x)==FP_CLASS_PNORM)
+#    define Perl_fp_class_ndenorm(x)   (Perl_fp_class(x)==FP_CLASS_NDENORM)
+#    define Perl_fp_class_pdenorm(x)   (Perl_fp_class(x)==FP_CLASS_PDENORM)
+#    define Perl_fp_class_denorm(x)    (Perl_fp_class(x)==FP_CLASS_NDENORM||Perl_fp_class(x)==FP_CLASS_PDENORM)
+#    define Perl_fp_class_nzero(x)     (Perl_fp_class(x)==FP_CLASS_NZERO)
+#    define Perl_fp_class_pzero(x)     (Perl_fp_class(x)==FP_CLASS_PZERO)
+#    define Perl_fp_class_zero(x)      (Perl_fp_class(x)==FP_CLASS_NZERO||Perl_fp_class(x)==FP_CLASS_PZERO)
+#endif
+
+#if !defined(Perl_fp_class) && defined(HAS_FP_CLASS)
+#    include <math.h>
+#    if !defined(FP_SNAN) && defined(I_FP_CLASS)
+#        include <fp_class.h>
+#    endif
+#    define Perl_fp_class(x)           fp_class(x)
+#    define Perl_fp_class_snan(x)      (fp_class(x)==FP_SNAN)
+#    define Perl_fp_class_qnan(x)      (fp_class(x)==FP_QNAN)
+#    define Perl_fp_class_nan(x)       (fp_class(x)==FP_SNAN||fp_class(x)==FP_QNAN)
+#    define Perl_fp_class_ninf(x)      (fp_class(x)==FP_NEG_INF)
+#    define Perl_fp_class_pinf(x)      (fp_class(x)==FP_POS_INF)
+#    define Perl_fp_class_inf(x)       (fp_class(x)==FP_NEG_INF||fp_class(x)==FP_POS_INF)
+#    define Perl_fp_class_nnorm(x)     (fp_class(x)==FP_NEG_NORM)
+#    define Perl_fp_class_pnorm(x)     (fp_class(x)==FP_POS_NORM)
+#    define Perl_fp_class_norm(x)      (fp_class(x)==FP_NEG_NORM||fp_class(x)==FP_POS_NORM)
+#    define Perl_fp_class_ndenorm(x)   (fp_class(x)==FP_NEG_DENORM)
+#    define Perl_fp_class_pdenorm(x)   (fp_class(x)==FP_POS_DENORM)
+#    define Perl_fp_class_denorm(x)    (fp_class(x)==FP_NEG_DENORM||fp_class(x)==FP_POS_DENORM)
+#    define Perl_fp_class_nzero(x)     (fp_class(x)==FP_NEG_ZERO)
+#    define Perl_fp_class_pzero(x)     (fp_class(x)==FP_POS_ZERO)
+#    define Perl_fp_class_zero(x)      (fp_class(x)==FP_NEG_ZERO||fp_class(x)==FP_POS_ZERO)
+#endif
+
+#if !defined(Perl_fp_class) && defined(HAS_FPCLASSIFY)
+#    include <math.h>
+#    define Perl_fp_class(x)           fpclassify(x)
+#    define Perl_fp_class_nan(x)       (fp_classify(x)==FP_SNAN|FP|_fp_classify(x)==QNAN)
+#    define Perl_fp_class_inf(x)       (fp_classify(x)==FP_INFINITE)
+#    define Perl_fp_class_norm(x)      (fp_classify(x)==FP_NORMAL)
+#    define Perl_fp_class_denorm(x)    (fp_classify(x)==FP_SUBNORMAL)
+#    define Perl_fp_class_zero(x)      (fp_classify(x)==FP_ZERO)
+#endif
+
+#if !defined(Perl_fp_class) && defined(HAS_CLASS)
+#    include <math.h>
+#    ifndef _cplusplus
+#        define Perl_fp_class(x)       class(x)
+#    else
+#        define Perl_fp_class(x)       _class(x)
+#    endif
+#    define Perl_fp_class_snan(x)      (Perl_fp_class(x)==FP_NANS)
+#    define Perl_fp_class_qnan(x)      (Perl_fp_class(x)==FP_NANQ)
+#    define Perl_fp_class_nan(x)       (Perl_fp_class(x)==FP_SNAN||Perl_fp_class(x)==FP_QNAN)
+#    define Perl_fp_class_ninf(x)      (Perl_fp_class(x)==FP_MINUS_INF)
+#    define Perl_fp_class_pinf(x)      (Perl_fp_class(x)==FP_PLUS_INF)
+#    define Perl_fp_class_inf(x)       (Perl_fp_class(x)==FP_MINUS_INF||Perl_fp_class(x)==FP_PLUS_INF)
+#    define Perl_fp_class_nnorm(x)     (Perl_fp_class(x)==FP_MINUS_NORM)
+#    define Perl_fp_class_pnorm(x)     (Perl_fp_class(x)==FP_PLUS_NORM)
+#    define Perl_fp_class_norm(x)      (Perl_fp_class(x)==FP_MINUS_NORM||Perl_fp_class(x)==FP_PLUS_NORM)
+#    define Perl_fp_class_ndenorm(x)   (Perl_fp_class(x)==FP_MINUS_DENORM)
+#    define Perl_fp_class_pdenorm(x)   (Perl_fp_class(x)==FP_PLUS_DENORM)
+#    define Perl_fp_class_denorm(x)    (Perl_fp_class(x)==FP_MINUS_DENORM||Perl_fp_class(x)==FP_PLUS_DENORM)
+#    define Perl_fp_class_nzero(x)     (Perl_fp_class(x)==FP_MINUS_ZERO)
+#    define Perl_fp_class_pzero(x)     (Perl_fp_class(x)==FP_PLUS_ZERO)
+#    define Perl_fp_class_zero(x)      (Perl_fp_class(x)==FP_MINUS_ZERO||Perl_fp_class(x)==FP_PLUS_ZERO)
+#endif
+
+/* rumor has it that Win32 has _isnan() */
+
+#ifndef Perl_isnan
 #   ifdef HAS_ISNAN
-#       define Perl_isnan(x) isnan(x)
+#       define Perl_isnan(x) isnan((NV)x)
+#   else
+#       ifdef Perl_fp_class_nan
+#           define Perl_isnan(x) Perl_fp_class_nan(x)
+#       else
+#           ifdef HAS_UNORDERED
+#               define Perl_isnan(x) unordered((x), 0.0)
+#           else
+#               define Perl_isnan(x) ((x)!=(x))
+#           endif
+#       endif
+#   endif
+#endif
+
+#ifndef Perl_isinf
+#   ifdef HAS_ISINF
+#       define Perl_isinf(x) isinf((NV)x)
 #   else
-#       define Perl_isnan(x) ((x)!=(x))
+#       ifdef Perl_fp_class_inf
+#           define Perl_isinf(x) Perl_fp_class_inf(x)
+#       else
+#           define Perl_isinf(x) ((x)==NV_INF)
+#       endif
+#   endif
+#endif
+
+#ifndef Perl_isfinite
+#   ifdef HAS_FINITE
+#       define Perl_isfinite(x) finite((NV)x)
+#   else
+#       ifdef HAS_ISFINITE
+#           define Perl_isfinite(x) isfinite(x)
+#       else
+#           ifdef Perl_fp_class_finite
+#               define Perl_isfinite(x) Perl_fp_class_finite(x)
+#           else
+#               define Perl_isfinite(x) !(Perl_is_inf(x)||Perl_is_nan(x))
+#           endif
+#       endif
 #   endif
 #endif
 
@@ -1534,8 +1678,11 @@ typedef struct pvop PVOP;
 typedef struct loop LOOP;
 
 typedef struct interpreter PerlInterpreter;
-#ifdef UTS
-#   define STRUCT_SV perl_sv /* Amdahl's <ksync.h> has struct sv */
+
+/* Amdahl's <ksync.h> has struct sv */
+/* SGI's <sys/sema.h> has struct sv */
+#if defined(UTS) || defined(__sgi)
+#   define STRUCT_SV perl_sv
 #else
 #   define STRUCT_SV sv
 #endif
@@ -1728,6 +1875,24 @@ typedef struct ptr_tbl PTR_TBL_t;
 #   define NEED_ENVIRON_DUP_FOR_MODIFY
 #endif
 
+/*
+ * initialise to avoid floating-point exceptions from overflow, etc
+ */
+#ifndef PERL_FPU_INIT
+#  ifdef HAS_FPSETMASK
+#    if HAS_FLOATINGPOINT_H
+#      include <floatingpoint.h>
+#    endif
+#    define PERL_FPU_INIT fpsetmask(0);
+#  else
+#    if defined(SIGFPE) && defined(SIG_IGN)
+#      define PERL_FPU_INIT signal(SIGFPE, SIG_IGN);
+#    else
+#      define PERL_FPU_INIT
+#    endif
+#  endif
+#endif
+
 #ifndef PERL_SYS_INIT3
 #  define PERL_SYS_INIT3(argvp,argcp,envp) PERL_SYS_INIT(argvp,argcp)
 #endif
@@ -1767,6 +1932,9 @@ typedef struct ptr_tbl PTR_TBL_t;
     * atomic.h everywhere */
 #  define EMULATE_ATOMIC_REFCOUNTS
 #  endif
+#  ifdef NETWARE
+#   include <nw5thread.h>
+#  else
 #  ifdef FAKE_THREADS
 #    include "fakethr.h"
 #  else
@@ -1797,12 +1965,17 @@ typedef pthread_key_t   perl_key;
 #      endif /* OS2 */
 #    endif /* WIN32 */
 #  endif /* FAKE_THREADS */
+#endif /* NETWARE */
 #endif /* USE_THREADS || USE_ITHREADS */
 
 #ifdef WIN32
 #  include "win32.h"
 #endif
 
+#ifdef NETWARE
+#  include "netware.h"
+#endif
+
 #ifdef VMS
 #   define STATUS_NATIVE       PL_statusvalue_vms
 #   define STATUS_NATIVE_EXPORT \
@@ -2171,11 +2344,13 @@ struct ptr_tbl {
 #endif
 
 #ifndef __cplusplus
+#ifndef UNDER_CE
 Uid_t getuid (void);
 Uid_t geteuid (void);
 Gid_t getgid (void);
 Gid_t getegid (void);
 #endif
+#endif
 
 #ifndef Perl_debug_log
 #  define Perl_debug_log       PerlIO_stderr()
@@ -2455,6 +2630,55 @@ START_EXTERN_C
 END_EXTERN_C
 #endif
 
+#if !defined(NV_INF) && defined(USE_LONG_DOUBLE) && defined(LDBL_INFINITY)
+#  define NV_INF LDBL_INFINITY
+#endif
+#if !defined(NV_INF) && defined(DBL_INFINITY)
+#  define NV_INF (NV)DBL_INFINITY
+#endif
+#if !defined(NV_INF) && defined(INFINITY)
+#  define NV_INF (NV)INFINITY
+#endif
+#if !defined(NV_INF) && defined(INF)
+#  define NV_INF (NV)INF
+#endif
+#if !defined(NV_INF) && defined(USE_LONG_DOUBLE) && defined(HUGE_VALL)
+#  define NV_INF (NV)HUGE_VALL
+#endif
+#if !defined(NV_INF) && defined(HUGE_VAL)
+#  define NV_INF (NV)HUGE_VAL
+#endif
+
+#if !defined(NV_NAN) && defined(USE_LONG_DOUBLE)
+#   if !defined(NV_NAN) && defined(LDBL_NAN)
+#       define NV_NAN LDBL_NAN
+#   endif
+#   if !defined(NV_NAN) && defined(LDBL_QNAN)
+#       define NV_NAN LDBL_QNAN
+#   endif
+#   if !defined(NV_NAN) && defined(LDBL_SNAN)
+#       define NV_NAN LDBL_SNAN
+#   endif
+#endif
+#if !defined(NV_NAN) && defined(DBL_NAN)
+#  define NV_NAN (NV)DBL_NAN
+#endif
+#if !defined(NV_NAN) && defined(DBL_QNAN)
+#  define NV_NAN (NV)DBL_QNAN
+#endif
+#if !defined(NV_NAN) && defined(DBL_SNAN)
+#  define NV_NAN (NV)DBL_SNAN
+#endif
+#if !defined(NV_NAN) && defined(QNAN)
+#  define NV_NAN (NV)QNAN
+#endif
+#if !defined(NV_NAN) && defined(SNAN)
+#  define NV_NAN (NV)SNAN
+#endif
+#if !defined(NV_NAN) && defined(NAN)
+#  define NV_NAN (NV)NAN
+#endif
+
 #ifndef __cplusplus
 #  if defined(NeXT) || defined(__NeXT__) /* or whatever catches all NeXTs */
 char *crypt ();       /* Maybe more hosts will need the unprototyped version */
@@ -2924,7 +3148,6 @@ enum {            /* pass one of these to get_vtbl */
 
 #define HINT_FILETEST_ACCESS   0x00400000
 #define HINT_UTF8              0x00800000
-#define HINT_UTF8_DISTINCT     0x01000000
 
 /* Various states of an input record separator SV (rs, nrs) */
 #define RsSNARF(sv)   (! SvOK(sv))
@@ -2933,6 +3156,7 @@ enum {            /* pass one of these to get_vtbl */
 #define RsRECORD(sv)  (SvROK(sv) && (SvIV(SvRV(sv)) > 0))
 
 /* Enable variables which are pointers to functions */
+typedef void (CPERLscope(*peep_t))(pTHX_ OP* o);
 typedef regexp*(CPERLscope(*regcomp_t)) (pTHX_ char* exp, char* xend, PMOP* pm);
 typedef I32 (CPERLscope(*regexec_t)) (pTHX_ regexp* prog, char* stringarg,
                                      char* strend, char* strbeg, I32 minend,
@@ -3476,6 +3700,7 @@ typedef struct am_table_short AMTS;
 #define RESTORE_NUMERIC_LOCAL()                /**/
 #define RESTORE_NUMERIC_STANDARD()     /**/
 #define Atof                           Perl_atof
+#define IN_LOCALE_RUNTIME              0
 
 #endif /* !USE_LOCALE_NUMERIC */
 
@@ -3575,7 +3800,9 @@ typedef struct am_table_short AMTS;
 
 #ifndef PERL_MICRO
 #   ifndef PERL_OLD_SIGNALS
-#       define PERL_ASYNC_CHECK() if (PL_sig_pending) despatch_signals()
+#              ifndef PERL_ASYNC_CHECK
+#                      define PERL_ASYNC_CHECK() if (PL_sig_pending) despatch_signals()
+#              endif
 #   endif
 #endif
 
@@ -3726,6 +3953,25 @@ int flock(int fd, int op);
 #define EXEC_ARGV_CAST(x) x
 #endif
 
+#define IS_NUMBER_IN_UV                      0x01 /* number within UV range (maybe not
+                                             int).  value returned in pointed-
+                                             to UV */
+#define IS_NUMBER_GREATER_THAN_UV_MAX 0x02 /* pointed to UV undefined */
+#define IS_NUMBER_NOT_INT            0x04 /* saw . or E notation */
+#define IS_NUMBER_NEG                0x08 /* leading minus sign */
+#define IS_NUMBER_INFINITY           0x10 /* this is big */
+#define IS_NUMBER_NAN                 0x20 /* this is not */
+
+#define GROK_NUMERIC_RADIX(sp, send) grok_numeric_radix(sp, send)
+
+/* to let user control profiling */
+#ifdef PERL_GPROF_CONTROL
+extern void moncontrol(int);
+#define PERL_GPROF_MONCONTROL(x) moncontrol(x)
+#else
+#define PERL_GPROF_MONCONTROL(x)
+#endif
+
 /* and finally... */
 #define PERL_PATCHLEVEL_H_IMPLICIT
 #include "patchlevel.h"
@@ -3770,6 +4016,14 @@ int flock(int fd, int op);
    HAS_STRUCT_MSGHDR
    HAS_STRUCT_CMSGHDR
 
+   USE_REENTRANT_API
+
+   HAS_NL_LANGINFO
+
    so that Configure picks them up. */
 
+#ifdef UNDER_CE
+#include "wince.h"
+#endif
+
 #endif /* Include guard */