/* See L<perlguts/"The Perl API"> for detailed notes on
* PERL_IMPLICIT_CONTEXT and PERL_IMPLICIT_SYS */
-/* XXXXXX testing threads via implicit pointer */
#ifdef USE_THREADS
# ifndef PERL_IMPLICIT_CONTEXT
# define PERL_IMPLICIT_CONTEXT
# endif
#endif
-/* XXXXXX testing multiplicity via implicit pointer */
#if defined(MULTIPLICITY)
# ifndef PERL_IMPLICIT_CONTEXT
# define PERL_IMPLICIT_CONTEXT
#define pTHXo CPerlObj *pPerl
#define pTHXo_ pTHXo,
-#define _pTHXo ,pTHXo
#define aTHXo this
#define aTHXo_ this,
-#define _aTHXo ,this
#define PERL_OBJECT_THIS aTHXo
#define PERL_OBJECT_THIS_ aTHXo_
-#define _PERL_OBJECT_THIS _aTHXo
-#define dTHXoa(a) pTHXo = (CPerlObj *)a
-#define dTHXo dTHXoa(PERL_GET_INTERP)
+#define dTHXoa(a) pTHXo = a
+#define dTHXo dTHXoa(PERL_GET_THX)
#define pTHXx void
#define pTHXx_
-#define _pTHXx
#define aTHXx
#define aTHXx_
-#define _aTHXx
#else /* !PERL_OBJECT */
struct perl_thread;
# define pTHX register struct perl_thread *thr
# define aTHX thr
-# define dTHXa(a) pTHX = (struct perl_thread *)a
-# define dTHX dTHXa(THR)
# define dTHR dNOOP
# else
# ifndef MULTIPLICITY
# endif
# define pTHX register PerlInterpreter *my_perl
# define aTHX my_perl
-# define dTHXa(a) pTHX = (PerlInterpreter *)a
-# define dTHX dTHXa(PERL_GET_INTERP)
# endif
+# define dTHXa(a) pTHX = a
+# define dTHX dTHXa(PERL_GET_THX)
# define pTHX_ pTHX,
-# define _pTHX ,pTHX
# define aTHX_ aTHX,
-# define _aTHX ,aTHX
#endif
#define STATIC static
#ifndef pTHX
# define pTHX void
# define pTHX_
-# define _pTHX
# define aTHX
# define aTHX_
-# define _aTHX
# define dTHXa(a) dNOOP
# define dTHX dNOOP
#endif
#ifndef pTHXo
# define pTHXo pTHX
# define pTHXo_ pTHX_
-# define _pTHXo _pTHX
# define aTHXo aTHX
# define aTHXo_ aTHX_
-# define _aTHXo _aTHX
# define dTHXo dTHX
#endif
#ifndef pTHXx
# define pTHXx register PerlInterpreter *my_perl
# define pTHXx_ pTHXx,
-# define _pTHXx ,pTHXx
# define aTHXx my_perl
# define aTHXx_ aTHXx,
-# define _aTHXx ,aTHXx
# define dTHXx dTHX
#endif
#include <inttypes.h>
#endif
-/* XXX QUAD stuff is not currently supported on most systems.
- Specifically, perl internals don't support long long. Among
- the many problems is that some compilers support long long,
- but the underlying library functions (such as sprintf) don't.
- Some things do work (such as quad pack/unpack on convex);
- also some systems use long long for the fpos_t typedef. That
- seems to work too.
-
+/*
The IV type is supposed to be long enough to hold any integral
value or a pointer.
--Andy Dougherty August 1996
*/
-/* Much more 64-bit probing added. Now we should get Quad_t
- in most systems: int64_t, long long, long, int, will do.
+/* We should be able to get Quad_t in most systems:
+ all of int64_t, long long, long, int, will work.
Beware of LP32 systems (ILP32, ILP32LL64). Such systems have been
used to sizeof(long) == sizeof(foo*). This is a bad assumption
Summary: a long long system needs to add -DUSE_LONG_LONG to $ccflags
to get quads -- and if its pointers are still 32 bits, this will break
binary compatibility. Casting an IV (a long long) to a pointer will
- truncate half of the IV away.
+ truncate half of the IV away. Most systems can just use
+ Configure -Duse64bits to get the -DUSE_LONG_LONG added either by
+ their hints files, or directly by Configure if they are using gcc.
- --jhi September 1998 */
+ --jhi September 1999 */
#if INTSIZE == 4 && LONGSIZE == 4 && PTRSIZE == 4
# define PERL_ILP32
# define IV_MAX INT64_MAX
# define IV_MIN INT64_MIN
# define UV_MAX UINT64_MAX
+# ifndef UINT64_MIN
+# define UINT64_MIN 0
+# endif
# define UV_MIN UINT64_MIN
# else
# define IV_MAX PERL_QUAD_MAX
# define UV_MAX PERL_UQUAD_MAX
# define UV_MIN PERL_UQUAD_MIN
# endif
-# define IVSIZF 8
+# define IVSIZE 8
# define UVSIZE 8
# define IV_IS_QUAD
# define UV_IS_QUAD
# if defined(INT32_MAX) && LONGSIZE == 4
# define IV_MAX INT32_MAX
# define IV_MIN INT32_MIN
-# define UV_MAX UINT32_MAX
+# ifndef UINT32_MAX_BROKEN /* e.g. HP-UX with gcc messes this up */
+# define UV_MAX UINT32_MAX
+# else
+# define UV_MAX 4294967295U
+# endif
+# ifndef UINT32_MIN
+# define UINT32_MIN 0
+# endif
# define UV_MIN UINT32_MIN
# else
# define IV_MAX PERL_LONG_MAX
# define UVSIZE LONGSIZE
# define IVSIZE LONGSIZE
#endif
-#define IV_DIG (BIT_DIGITS(IVSIZE * 8) + 1)
-#define UV_DIG (BIT_DIGITS(IVSIZE * 8) + 1)
+#define IV_DIG (BIT_DIGITS(IVSIZE * 8))
+#define UV_DIG (BIT_DIGITS(UVSIZE * 8))
+#if (IVSIZE > PTRSIZE) || (UVSIZE > PTRSIZE)
+# if PTRSIZE == LONGSIZE
+# define PTRV unsigned long
+# else
+# define PTRV unsigned
+# endif
+# define PTR_CAST (PTRV)
+#else
+# define PTRV UV
+# define PTR_CAST
+#endif
+
#ifdef USE_LONG_DOUBLE
# if defined(HAS_LONG_DOUBLE) && (LONG_DOUBLESIZE > DOUBLESIZE)
# define LDoub_t long double
#define DBL_DIG 15 /* A guess that works lots of places */
#endif
#endif
+#ifdef I_FLOAT
+#include <float.h>
+#endif
+#ifndef HAS_DBL_DIG
+#define DBL_DIG 15 /* A guess that works lots of places */
+#endif
#ifdef OVR_LDBL_DIG
/* Use an overridden LDBL_DIG */
#endif
#if defined(USE_64_BIT_FILES) || defined(USE_LARGE_FILES)
-# define USE_64_BIT_OFFSETS
+# define USE_64_BIT_OFFSETS /* Explicit */
# define USE_64_BIT_STDIO
#endif
+#if LSEEKSIZE == 8 && !defined(USE_64_BIT_OFFSETS)
+# define USE_64_BIT_OFFSETS /* Implicit */
+#endif
+
+/* Do we need FSEEKSIZE? */
+
/* I couldn't find any -Ddefine or -flags in IRIX 6.5 that would
* have done the necessary symbol renaming using cpp. --jhi */
#ifdef __sgi
# endif
#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). */
#ifndef PERL_SET_INTERP
# define PERL_SET_INTERP(i) (PL_curinterp = (PerlInterpreter*)(i))
#endif
# define PERL_GET_INTERP (PL_curinterp)
#endif
+#if defined(PERL_IMPLICIT_CONTEXT) && !defined(PERL_GET_THX)
+# ifdef USE_THREADS
+# define PERL_GET_THX THR
+# else
+# ifdef MULTIPLICITY
+# define PERL_GET_THX PERL_GET_INTERP
+# else
+# ifdef PERL_OBJECT
+# define PERL_GET_THX ((CPerlObj*)PERL_GET_INTERP)
+# else
+# define PERL_GET_THX ((void*)0)
+# endif
+# endif
+# endif
+#endif
+
+#if defined(PERL_IMPLICIT_CONTEXT) && !defined(PERL_GET_THX)
+# ifdef USE_THREADS
+# define PERL_GET_THX THR
+# else
+# ifdef MULTIPLICITY
+# define PERL_GET_THX PERL_GET_INTERP
+# else
+# ifdef PERL_OBJECT
+# define PERL_GET_THX ((CPerlObj*)PERL_GET_INTERP)
+# else
+# define PERL_GET_THX ((void*)0)
+# endif
+# endif
+# endif
+#endif
+
/* Some unistd.h's give a prototype for pause() even though
HAS_PAUSE ends up undefined. This causes the #define
below to be rejected by the compmiler. Sigh.
#include "hv.h"
#include "mg.h"
#include "scope.h"
-#include "warning.h"
+#include "warnings.h"
#include "utf8.h"
/* Current curly descriptor */
/* 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)
+#define NV_WITHIN_UV(nv) ((nv)>=0.0 && U_V(nv) >= UV_MIN && U_V(nv) <= UV_MAX)
+/* Believe. */
#define IV_FITS_IN_NV
-/* Is this strictly correct? */
-#if IVSIZE >= NVSIZE
+/* Doubt. */
+#if defined(USE_LONG_DOUBLE) && \
+ defined(LDBL_MANT_DIG) && IV_DIG >= LDBL_MANT_DIG
# undef IV_FITS_IN_NV
#else
- /* Greater-than-or-EQUAL because L?DBL_DIG doesn't necessarily
- * mean that all the powers of two that are L?DBL_DIG digits long
- * can be represented by the (long)? doubles sized L?DBL_DIG digits. */
-# if IV_DIG >= NV_DIG
+# if defined(DBL_MANT_DIG) && IV_DIG >= DBL_MANT_DIG
# undef IV_FITS_IN_NV
+# else
+# if IV_DIG >= NV_DIG
+# undef IV_FITS_IN_NV
+# else
+# if IVSIZE >= NVSIZE
+# undef IV_FITS_IN_NV
+# endif
+# endif
# endif
#endif
-/* Often there are DBL_MANT_DIG and LDBL_MANT_DIG
- * that would give more precise results. */
/* Used with UV/IV arguments: */
/* XXXX: need to speed it up */
# if defined(PERL_OBJECT)
# define DEBUG_m(a) if (PL_debug & 128) a
# else
-# define DEBUG_m(a) if (PERL_GET_INTERP && PL_debug & 128) a
+# define DEBUG_m(a) \
+ STMT_START { \
+ if (PERL_GET_INTERP) { dTHX; if (PL_debug & 128) { a; } } \
+ } STMT_END
# endif
#define DEBUG_f(a) if (PL_debug & 256) a
#define DEBUG_r(a) if (PL_debug & 512) a
/* Fix these up for __STDC__ */
#ifndef DONT_DECLARE_STD
char *mktemp (char*);
+#ifndef atof
double atof (const char*);
#endif
+#endif
#ifndef STANDARD_C
/* All of these are in stdlib.h or time.h for ANSI C */
XREF,
XSTATE,
XBLOCK,
+ XATTRBLOCK,
+ XATTRTERM,
XTERMBLOCK
} expectation;
EXT struct perl_vars PL_Vars;
EXT struct perl_vars *PL_VarsPtr INIT(&PL_Vars);
#else /* PERL_CORE */
-#if !defined(__GNUC__) || !(defined(WIN32) || defined(CYGWIN))
+#if !defined(__GNUC__) || !defined(WIN32)
EXT
#endif /* WIN32 */
struct perl_vars *PL_VarsPtr;
*/
struct interpreter {
-#include "thrdvar.h"
+#ifndef USE_THREADS
+# include "thrdvar.h"
+#endif
#include "intrpvar.h"
};
projects / p5sagit/p5-mst-13.2.git / blobdiff