#ifndef H_PERL
#define H_PERL 1
-/*#define PERL_IMPLICIT_CONTEXT*/
-
#ifdef PERL_FOR_X2P
/*
* This file is being used for x2p stuff.
#define USE_STDIO
#endif /* PERL_FOR_X2P */
+#define VOIDUSED 1
+#include "config.h"
+
+/* See L<perlguts/"The Perl API"> for detailed notes on
+ * PERL_IMPLICIT_CONTEXT and PERL_IMPLICIT_SYS */
+
+#ifdef USE_THREADS
+# ifndef PERL_IMPLICIT_CONTEXT
+# define PERL_IMPLICIT_CONTEXT
+# endif
+# ifndef PERL_IMPLICIT_SYS
+# ifdef WIN32
+# define PERL_IMPLICIT_SYS /* XXX not implemented everywhere yet */
+# endif
+# endif
+#endif
+
+#if defined(MULTIPLICITY)
+# ifndef PERL_IMPLICIT_CONTEXT
+# define PERL_IMPLICIT_CONTEXT
+# endif
+# ifndef PERL_IMPLICIT_SYS
+# ifdef WIN32
+# define PERL_IMPLICIT_SYS /* XXX not implemented everywhere yet */
+# endif
+# endif
+#endif
+
+#ifdef PERL_CAPI
+# undef PERL_OBJECT
+# ifndef PERL_IMPLICIT_CONTEXT
+# define PERL_IMPLICIT_CONTEXT
+# endif
+# ifndef PERL_IMPLICIT_SYS
+# define PERL_IMPLICIT_SYS
+# endif
+#endif
+
+#ifdef PERL_OBJECT
+# ifndef PERL_IMPLICIT_CONTEXT
+# define PERL_IMPLICIT_CONTEXT
+# endif
+# ifndef PERL_IMPLICIT_SYS
+# define PERL_IMPLICIT_SYS
+# endif
+#endif
+
#ifdef PERL_OBJECT
/* PERL_OBJECT explained - DickH and DougL @ ActiveState.com
| Perl Host |
+-----------+
^
- |
- v
+ |
+ v
+-----------+ +-----------+
| Perl Core |<->| Extension |
+-----------+ +-----------+ ...
class CPerlObj;
#define STATIC
-#define CPERLscope(x) CPerlObj::x
-#define CPERLproto CPerlObj *
-#define _CPERLproto ,CPERLproto
-#define CPERLarg CPerlObj *pPerl
-#define CPERLarg_ CPERLarg,
-#define _CPERLarg ,CPERLarg
-#define PERL_OBJECT_THIS this
-#define _PERL_OBJECT_THIS ,this
-#define PERL_OBJECT_THIS_ this,
-#define CALL_FPTR(fptr) (this->*fptr)
+#define CPERLscope(x) CPerlObj::x
+#define CALL_FPTR(fptr) (this->*fptr)
+
+#define pTHXo CPerlObj *pPerl
+#define pTHXo_ pTHXo,
+#define aTHXo this
+#define aTHXo_ this,
+#define PERL_OBJECT_THIS aTHXo
+#define PERL_OBJECT_THIS_ aTHXo_
+#define dTHXoa(a) pTHXo = a
+#define dTHXo dTHXoa(PERL_GET_THX)
+
+#define pTHXx void
+#define pTHXx_
+#define aTHXx
+#define aTHXx_
#else /* !PERL_OBJECT */
+#ifdef PERL_IMPLICIT_CONTEXT
+# ifdef USE_THREADS
+struct perl_thread;
+# define pTHX register struct perl_thread *thr
+# define aTHX thr
+# define dTHR dNOOP
+# else
+# ifndef MULTIPLICITY
+# define MULTIPLICITY
+# endif
+# define pTHX register PerlInterpreter *my_perl
+# define aTHX my_perl
+# endif
+# define dTHXa(a) pTHX = a
+# define dTHX dTHXa(PERL_GET_THX)
+# define pTHX_ pTHX,
+# define aTHX_ aTHX,
+#endif
+
#define STATIC static
#define CPERLscope(x) x
-#define CPERLproto
-#define _CPERLproto
#define CPERLarg void
#define CPERLarg_
#define _CPERLarg
#define CALLRUNOPS CALL_FPTR(PL_runops)
#define CALLREGCOMP CALL_FPTR(PL_regcompp)
#define CALLREGEXEC CALL_FPTR(PL_regexecp)
+#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)
-#define VOIDUSED 1
-#include "config.h"
+#define NOOP (void)0
+#define dNOOP extern int Perl___notused
-/* XXXXXX testing threads via implicit pointer */
-#ifdef USE_THREADS
-#define PERL_IMPLICIT_CONTEXT
+#ifndef pTHX
+# define pTHX void
+# define pTHX_
+# define aTHX
+# define aTHX_
+# define dTHXa(a) dNOOP
+# define dTHX dNOOP
+#endif
+
+#ifndef pTHXo
+# define pTHXo pTHX
+# define pTHXo_ pTHX_
+# define aTHXo aTHX
+# define aTHXo_ aTHX_
+# define dTHXo dTHX
+#endif
+
+#ifndef pTHXx
+# define pTHXx register PerlInterpreter *my_perl
+# define pTHXx_ pTHXx,
+# define aTHXx my_perl
+# define aTHXx_ aTHXx,
+# define dTHXx dTHX
#endif
#undef START_EXTERN_C
#else
# define START_EXTERN_C
# define END_EXTERN_C
-# define EXTERN_C
+# define EXTERN_C extern
#endif
#ifdef OP_IN_REGISTER
# endif
#endif
-#define NOOP (void)0
-#define dNOOP extern int Perl___notused
+#define WITH_THX(s) STMT_START { dTHX; s; } STMT_END
#define WITH_THR(s) STMT_START { dTHR; s; } STMT_END
/*
*/
/* define this once if either system, instead of cluttering up the src */
-#if defined(MSDOS) || defined(atarist) || defined(WIN32) || defined(CYGWIN32)
+#if defined(MSDOS) || defined(atarist) || defined(WIN32)
#define DOSISH 1
#endif
-#if defined(__STDC__) || defined(vax11c) || defined(_AIX) || defined(__stdc__) || defined(__cplusplus)
+#if defined(__STDC__) || defined(vax11c) || defined(_AIX) || defined(__stdc__) || defined(__cplusplus) || defined( EPOC)
# define STANDARD_C 1
#endif
-#if defined(__cplusplus) || defined(WIN32) || defined(__sgi) || defined(OS2) || defined(__DGUX)
+#if defined(__cplusplus) || defined(WIN32) || defined(__sgi) || defined(OS2) || defined(__DGUX) || defined( EPOC) || defined(__QNX__)
# define DONT_DECLARE_STD 1
#endif
/* HP-UX 10.X CMA (Common Multithreaded Architecure) insists that
pthread.h must be included before all other header files.
*/
-#if defined(USE_THREADS) && defined(PTHREAD_H_FIRST)
+#if defined(USE_THREADS) && defined(PTHREAD_H_FIRST) && defined(I_PTHREAD)
# include <pthread.h>
#endif
# include <stdlib.h>
#endif
-#if !defined(PERL_FOR_X2P)
+#if !defined(PERL_FOR_X2P) && !defined(PERL_OBJECT)
# include "embed.h"
#endif
#define MEM_SIZE Size_t
+#if defined(STANDARD_C) && defined(I_STDDEF)
+# include <stddef.h>
+# define STRUCT_OFFSET(s,m) offsetof(s,m)
+#else
+# define STRUCT_OFFSET(s,m) (Size_t)(&(((s *)0)->m))
+#endif
+
+#if defined(I_STRING) || defined(__cplusplus)
+# include <string.h>
+#else
+# include <strings.h>
+#endif
+
/* This comes after <stdlib.h> so we don't try to change the standard
* library prototypes; we'll use our own in proto.h instead. */
#ifdef MYMALLOC
# ifdef PERL_POLLUTE_MALLOC
+# ifndef PERL_EXTMALLOC_DEF
# define Perl_malloc malloc
# define Perl_calloc calloc
# define Perl_realloc realloc
# define Perl_mfree free
+# endif
# else
# define EMBEDMYMALLOC /* for compatibility */
# endif
# define safefree safesysfree
#endif /* MYMALLOC */
-#if defined(STANDARD_C) && defined(I_STDDEF)
-# include <stddef.h>
-# define STRUCT_OFFSET(s,m) offsetof(s,m)
-#else
-# define STRUCT_OFFSET(s,m) (Size_t)(&(((s *)0)->m))
-#endif
-
-#if defined(I_STRING) || defined(__cplusplus)
-# include <string.h>
-#else
-# include <strings.h>
-#endif
-
#if !defined(HAS_STRCHR) && defined(HAS_INDEX) && !defined(strchr)
#define strchr index
#define strrchr rindex
#ifdef USE_THREADS
# define ERRSV (thr->errsv)
-# define ERRHV (thr->errhv)
# define DEFSV THREADSV(0)
# define SAVE_DEFSV save_threadsv(0)
#else
# define ERRSV GvSV(PL_errgv)
-# define ERRHV GvHV(PL_errgv)
# define DEFSV GvSV(PL_defgv)
# define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv))
#endif /* USE_THREADS */
+#define ERRHV GvHV(PL_errgv) /* XXX unused, here for compatibility */
+
#ifndef errno
extern int errno; /* ANSI allows errno to be an lvalue expr.
* For example in multithreaded environments
#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 IVSIZE 8
+# define UVSIZE 8
+# define IV_IS_QUAD
+# define UV_IS_QUAD
#else
typedef long IV;
typedef unsigned long UV;
# 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 UV_MAX PERL_ULONG_MAX
# define UV_MIN PERL_ULONG_MIN
# endif
+# if LONGSIZE == 8
+# define IV_IS_QUAD
+# define UV_IS_QUAD
+# else
+# undef IV_IS_QUAD
+# undef UV_IS_QUAD
+# endif
+# define UVSIZE LONGSIZE
+# define IVSIZE LONGSIZE
+#endif
+#define IV_DIG (BIT_DIGITS(IVSIZE * 8))
+#define UV_DIG (BIT_DIGITS(UVSIZE * 8))
+
+/*
+ * The macros INT2PTR and NUM2PTR are (despite their names)
+ * bi-directional: they will convert int/float to or from pointers.
+ * However the conversion to int/float are named explicitly:
+ * PTR2IV, PTR2UV, PTR2NV.
+ *
+ * For int conversions we do not need two casts if pointers are
+ * the same size as IV and UV. Otherwise we need an explicit
+ * cast (PTRV) to avoid compiler warnings.
+ */
+#if (IVSIZE == PTRSIZE) && (UVSIZE == PTRSIZE)
+# define PTRV UV
+# define INT2PTR(any,d) (any)(d)
+#else
+# if PTRSIZE == LONGSIZE
+# define PTRV unsigned long
+# else
+# define PTRV unsigned
+# endif
+# define INT2PTR(any,d) (any)(PTRV)(d)
+#endif
+#define NUM2PTR(any,d) (any)(PTRV)(d)
+#define PTR2IV(p) INT2PTR(IV,p)
+#define PTR2UV(p) INT2PTR(UV,p)
+#define PTR2NV(p) NUM2PTR(NV,p)
+
+#ifdef USE_LONG_DOUBLE
+# if defined(HAS_LONG_DOUBLE) && (LONG_DOUBLESIZE > DOUBLESIZE)
+# define LDoub_t long double
+# else
+# undef USE_LONG_DOUBLE /* Ouch! */
+# endif
+#endif
+
+#ifdef OVR_DBL_DIG
+/* Use an overridden DBL_DIG */
+# ifdef DBL_DIG
+# undef DBL_DIG
+# endif
+# define DBL_DIG OVR_DBL_DIG
+#else
+/* The following is all to get DBL_DIG, in order to pick a nice
+ default value for printing floating point numbers in Gconvert.
+ (see config.h)
+*/
+#ifdef I_LIMITS
+#include <limits.h>
+#endif
+#ifdef I_FLOAT
+#include <float.h>
+#endif
+#ifndef HAS_DBL_DIG
+#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 */
+# ifdef LDBL_DIG
+# undef LDBL_DIG
+# endif
+# define LDBL_DIG OVR_LDBL_DIG
+#else
+/* The following is all to get LDBL_DIG, in order to pick a nice
+ default value for printing floating point numbers in Gconvert.
+ (see config.h)
+*/
+#ifdef I_LIMITS
+#include <limits.h>
+#endif
+#ifdef I_FLOAT
+#include <float.h>
+#endif
+#ifndef HAS_LDBL_DIG
+#if LONG_DOUBLESIZE == 10
+#define LDBL_DIG 18 /* assume IEEE */
+#else
+#if LONG_DOUBLESIZE == 16
+#define LDBL_DIG 33 /* assume IEEE */
+#else
+#if LONG_DOUBLESIZE == DOUBLESIZE
+#define LDBL_DIG DBL_DIG /* bummer */
+#endif
+#endif
+#endif
+#endif
+#endif
+
+#ifdef USE_LONG_DOUBLE
+# define HAS_LDOUB
+ typedef LDoub_t NV;
+# define NVSIZE LONG_DOUBLESIZE
+# define NV_DIG LDBL_DIG
+# define Perl_modf modfl
+# define Perl_frexp frexpl
+# define Perl_cos cosl
+# define Perl_sin sinl
+# define Perl_sqrt sqrtl
+# define Perl_exp expl
+# define Perl_log logl
+# define Perl_atan2 atan2l
+# define Perl_pow powl
+# define Perl_floor floorl
+# define Perl_fmod fmodl
+#else
+ typedef double NV;
+# define NVSIZE DOUBLESIZE
+# define NV_DIG DBL_DIG
+# define Perl_modf modf
+# define Perl_frexp frexp
+# define Perl_cos cos
+# define Perl_sin sin
+# define Perl_sqrt sqrt
+# define Perl_exp exp
+# define Perl_log log
+# define Perl_atan2 atan2
+# define Perl_pow pow
+# define Perl_floor floor
+# define Perl_fmod fmod
+#endif
+
+#if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) && defined(HAS_ATOLF)
+# define Perl_atof atolf
+#else
+# define Perl_atof atof
#endif
/* Previously these definitions used hardcoded figures.
typedef struct binop BINOP;
typedef struct listop LISTOP;
typedef struct logop LOGOP;
-typedef struct condop CONDOP;
typedef struct pmop PMOP;
typedef struct svop SVOP;
typedef struct gvop GVOP;
typedef struct Outrec Outrec;
typedef struct interpreter PerlInterpreter;
-#ifndef __BORLANDC__
-typedef struct ff FF; /* XXX not defined anywhere, should go? */
-#endif
typedef struct sv SV;
typedef struct av AV;
typedef struct hv HV;
#include "handy.h"
-/* Some day when we have more 64-bit experience under our belts we may
- * be able to merge some of the USE_64_BIT_{FILES,OFFSETS,STDIO,DBM}. At
- * the moment (Oct 1998), though, keep them separate. --jhi
- */
-#ifdef USE_64_BITS
-# ifdef USE_64_BIT_FILES
-# ifndef USE_64_BIT_OFFSETS
-# define USE_64_BIT_OFFSETS
-# endif
-# ifndef USE_64_BIT_STDIO
-# define USE_64_BIT_STDIO
-# endif
-# ifndef USE_64_BIT_DBM
-# define USE_64_BIT_DBM
-# endif
+#if defined(USE_LARGE_FILES)
+# define USE_64_BIT_RAWIO /* Explicit */
+# define USE_64_BIT_STDIO
+#endif
+
+#if LSEEKSIZE == 8 && !defined(USE_64_BIT_RAWIO)
+# define USE_64_BIT_RAWIO /* 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
+#define USE_FOPEN64
+#define USE_FSEEK64
+#define USE_FTELL64
+#define USE_FSETPOS64
+#define USE_FGETPOS64
+#define USE_TMPFILE64
+#define USE_FREOPEN64
+#endif
+
+#ifdef USE_64_BIT_RAWIO
+# ifdef HAS_OFF64_T
+# undef Off_t
+# define Off_t off64_t
+# undef LSEEKSIZE
+# define LSEEKSIZE 8
# endif
-/* Mention LSEEKSIZE here to get it included in %Config. */
-# ifdef USE_64_BIT_OFFSETS
-# ifdef HAS_FSTAT64
-# define fstat fstat64
-# endif
-# ifdef HAS_FTRUNCATE64
-# define ftruncate ftruncate64
-# endif
-# ifdef HAS_LSEEK64
-# define lseek lseek64
-# ifdef HAS_OFF64_T
-# undef Off_t
-# define Off_t off64_t
-# endif
-# endif
-# ifdef HAS_LSTAT64
-# define lstat lstat64
-# endif
- /* Some systems have open64() in libc but use that only
- * for true LP64 mode, in mixed mode (ILP32LL64, for example)
- * they use the vanilla open(). Such systems should undefine
- * d_open64 in their hints files. --jhi */
-# if defined(HAS_OPEN64)
-# define open open64
-# endif
-# ifdef HAS_OPENDIR64
-# define opendir opendir64
-# endif
-# ifdef HAS_READDIR64
-# define readdir readdir64
-# ifdef HAS_STRUCT_DIRENT64
-# define dirent dirent64
-# endif
-# endif
-# ifdef HAS_SEEKDIR64
-# define seekdir seekdir64
-# endif
-# ifdef HAS_STAT64
-# define stat stat64 /* Affects also struct stat, hopefully okay. */
-# endif
-# ifdef HAS_TELLDIR64
-# define telldir telldir64
-# endif
-# ifdef HAS_TRUNCATE64
-# define truncate truncate64
-# endif
- /* flock is not #defined here to be flock64 because it seems
- that a system may have struct flock64 but still use flock()
- and not flock64(). The actual flocking code in pp_sys.c
- must be changed. Also lockf and lockf64 must be dealt
- with in pp_sys.c. --jhi */
-# endif
-# ifdef USE_64_BIT_STDIO
-# ifdef HAS_FGETPOS64
-# define fgetpos fgetpos64
-# endif
-# ifdef HAS_FOPEN64
-# define fopen fopen64
-# endif
-# ifdef HAS_FREOPEN64
-# define freopen freopen64
-# endif
-# ifdef HAS_FSEEK64
-# define fseek fseek64
-# endif
-# ifdef HAS_FSEEKO64
-# define fseeko fseeko64
-# endif
-# ifdef HAS_FSETPOS64
-# define fsetpos fsetpos64
-# endif
-# ifdef HAS_FTELL64
-# define ftell ftell64
-# endif
-# ifdef HAS_FTELLO64
-# define ftello ftello64
-# endif
-# ifdef HAS_TMPFILE64
-# define tmpfile tmpfile64
-# endif
+/* Most 64-bit environments have defines like _LARGEFILE_SOURCE that
+ * will trigger defines like the ones below. Some 64-bit environments,
+ * however, do not. Therefore we have to explicitly mix and match. */
+# if defined(USE_OPEN64)
+# define open open64
# endif
-# ifdef USE_64_BIT_DBM
-# ifdef HAS_DBMINIT64
-# define dbminit dbminit64
-# endif
-# ifdef HAS_DBMCLOSE64
-# define dbmclose dbmclose64
-# endif
-# ifdef HAS_FETCH64
-# define fetch fetch64
-# endif
-# ifdef HAS_DELETE64
-# define delete delete64
-# endif
-# ifdef HAS_STORE64
-# define store store64
-# endif
-# ifdef HAS_FIRSTKEY64
-# define firstkey firstkey64
-# endif
-# ifdef HAS_NEXTKEY64
-# define nextkey nextkey64
-# endif
+# if defined(USE_LSEEK64)
+# define lseek lseek64
+# endif
+# if defined(USE_LLSEEK)
+# define lseek llseek
+# endif
+# if defined(USE_STAT64)
+# define stat stat64
+# endif
+# if defined(USE_FSTAT64)
+# define fstat fstat64
+# endif
+# if defined(USE_LSTAT64)
+# define lstat lstat64
+# endif
+# if defined(USE_FLOCK64)
+# define flock flock64
+# endif
+# if defined(USE_LOCKF64)
+# define lockf lockf64
+# endif
+# if defined(USE_FCNTL64)
+# define fcntl fcntl64
+# endif
+# if defined(USE_TRUNCATE64)
+# define truncate truncate64
+# endif
+# if defined(USE_FTRUNCATE64)
+# define ftruncate ftruncate64
# endif
#endif
+#ifdef USE_64_BIT_STDIO
+# ifdef HAS_FPOS64_T
+# undef Fpos_t
+# define Fpos_t fpos64_t
+# endif
+/* Most 64-bit environments have defines like _LARGEFILE_SOURCE that
+ * will trigger defines like the ones below. Some 64-bit environments,
+ * however, do not. */
+# if defined(USE_FOPEN64)
+# define fopen fopen64
+# endif
+# if defined(USE_FSEEK64)
+# define fseek fseek64
+# endif
+# if defined(USE_FTELL64)
+# define ftell ftell64
+# endif
+# if defined(USE_FSETPOS64)
+# define fsetpos fsetpos64
+# endif
+# if defined(USE_FGETPOS64)
+# define fgetpos fgetpos64
+# endif
+# if defined(USE_TMPFILE64)
+# define tmpfile tmpfile64
+# endif
+# if defined(USE_FREOPEN64)
+# define freopen freopen64
+# endif
+#endif
+
+#if defined(OS2)
+# include "iperlsys.h"
+#endif
+
#if defined(__OPEN_VM)
# include "vmesa/vmesaish.h"
#endif
# if defined(__VOS__)
# include "vosish.h"
# else
-# include "unixish.h"
+# if defined(EPOC)
+# include "epocish.h"
+# else
+# include "unixish.h"
+# endif
# endif
# endif
# endif
# endif
#endif
+#ifndef PERL_SYS_INIT3
+# define PERL_SYS_INIT3(argvp,argcp,envp) PERL_SYS_INIT(argvp,argcp)
+#endif
+
#ifndef MAXPATHLEN
# ifdef PATH_MAX
# ifdef _POSIX_PATH_MAX
# endif
#endif
-#ifndef FUNC_NAME_TO_PTR
-#define FUNC_NAME_TO_PTR(name) name
-#endif
-
/*
* USE_THREADS needs to be after unixish.h as <pthread.h> includes
* <sys/signal.h> which defines NSIG - which will stop inclusion of <signal.h>
typedef condition_t perl_cond;
typedef void * perl_key;
# else /* Posix threads */
-# include <pthread.h>
+# ifdef I_PTHREAD
+# include <pthread.h>
+# endif
typedef pthread_t perl_os_thread;
typedef pthread_mutex_t perl_mutex;
typedef pthread_cond_t perl_cond;
# endif /* WIN32 */
# endif /* FAKE_THREADS */
#endif /* USE_THREADS */
-
+
+#ifdef WIN32
+#include "win32.h"
+#endif
+
#ifdef VMS
# define STATUS_NATIVE PL_statusvalue_vms
# define STATUS_NATIVE_EXPORT \
# define STATUS_ALL_FAILURE (PL_statusvalue = 1)
#endif
+#ifndef MEMBER_TO_FPTR
+#define MEMBER_TO_FPTR(name) name
+#endif
+
/* This defines a way to flush all output buffers. This may be a
* performance issue, so we allow people to disable it.
- * XXX the default needs a Configure test, as it may not work everywhere.
*/
#ifndef PERL_FLUSHALL_FOR_CHILD
# if defined(FFLUSH_NULL) || defined(USE_SFIO)
# ifdef FFLUSH_ALL
# define PERL_FLUSHALL_FOR_CHILD my_fflush_all()
# else
-# define PERL_FLUSHALL_FOR_CHILD (void)0
+# define PERL_FLUSHALL_FOR_CHILD NOOP
# endif
# 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
+
+#ifndef PERL_GET_INTERP
+# 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
+
/* 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.
# endif
#endif
-#if defined(CYGWIN32)
+#if defined(CYGWIN)
/* USEMYBINMODE
* This symbol, if defined, indicates that the program should
* use the routine my_binmode(FILE *fp, char iotype) to insure
*/
# define USEMYBINMODE / **/
# define my_binmode(fp, iotype) \
- (PerlLIO_setmode(PerlIO_fileno(fp), O_BINARY) != -1 ? TRUE : NULL)
-#endif
-
-#ifdef PERL_IMPLICIT_CONTEXT
-# ifdef USE_THREADS
-struct perl_thread;
-# define pTHX struct perl_thread *thr
-# define aTHX thr
-# define dTHXa(a) pTHX = (struct perl_thread *)a
-# define dTHX dTHXa(SvPVX(PL_thrsv))
-# define dTHR dNOOP
-# else
-# define MULTIPLICITY
-# define pTHX PerlInterpreter *my_perl
-# define aTHX my_perl
-# define dTHXa(a) pTHX = (PerlInterpreter *)a
-# define dTHX dTHXa(PL_curinterp)
-# endif
-# define pTHX_ pTHX,
-# define _pTHX ,pTHX
-# define aTHX_ aTHX,
-# define _aTHX ,aTHX
-#endif
-
-#ifndef pTHX
-# define pTHX void
-# define pTHX_
-# define _pTHX
-# define aTHX
-# define aTHX_
-# define _aTHX
-# define dTHXa(a) dNOOP
-# define dTHX dNOOP
-#endif
-
-#define WITH_THX(s) STMT_START { dTHX; s; } STMT_END
-
-#ifndef STATIC
-# define STATIC static
+ (PerlLIO_setmode(PerlIO_fileno(fp), O_BINARY) != -1 ? TRUE : FALSE)
#endif
#ifdef UNION_ANY_DEFINITION
I32 any_i32;
IV any_iv;
long any_long;
- void (CPERLscope(*any_dptr)) (pTHX_ void*);
+ void (*any_dptr) (void*);
+ void (*any_dxptr) (pTHXo_ void*);
};
#endif
#define ARGSproto
#endif /* USE_THREADS */
-#ifdef PERL_OBJECT
-typedef I32 (*filter_t) (CPerlObj*, int, SV *, int);
-#else
-typedef I32 (*filter_t) (pTHX_ int, SV *, int);
-#endif
+typedef I32 (*filter_t) (pTHXo_ int, SV *, int);
#define FILTER_READ(idx, sv, len) filter_read(idx, sv, len)
#define FILTER_DATA(idx) (AvARRAY(PL_rsfp_filters)[idx])
#define FILTER_ISREADER(idx) (idx >= AvFILLp(PL_rsfp_filters))
-#ifdef WIN32
-#include "win32.h"
+#if !defined(OS2)
+# include "iperlsys.h"
#endif
-
-#include "iperlsys.h"
#include "regexp.h"
#include "sv.h"
#include "util.h"
#include "form.h"
#include "gv.h"
#include "cv.h"
-#ifndef PERL_OBJECT
-#include "opcode.h"
-#endif
+#include "opnames.h"
#include "op.h"
#include "cop.h"
#include "av.h"
#include "hv.h"
#include "mg.h"
#include "scope.h"
-#include "warning.h"
+#include "warnings.h"
#include "utf8.h"
/* Current curly descriptor */
typedef struct magic_state MGS; /* struct magic_state defined in mg.c */
-/* Length of a variant. */
-
-typedef struct {
- I32 len_min;
- I32 len_delta;
- I32 pos_min;
- I32 pos_delta;
- SV *last_found;
- I32 last_end; /* min value, <0 unless valid. */
- I32 last_start_min;
- I32 last_start_max;
- SV **longest; /* Either &l_fixed, or &l_float. */
- SV *longest_fixed;
- I32 offset_fixed;
- SV *longest_float;
- I32 offset_float_min;
- I32 offset_float_max;
- I32 flags;
-} scan_data_t;
+struct scan_data_t; /* Used in S_* functions in regcomp.c */
typedef I32 CHECKPOINT;
#define U_I(what) ((unsigned int)(what))
#define U_L(what) ((U32)(what))
#else
-#define U_S(what) ((U16)cast_ulong((double)(what)))
-#define U_I(what) ((unsigned int)cast_ulong((double)(what)))
-#define U_L(what) (cast_ulong((double)(what)))
+#define U_S(what) ((U16)cast_ulong((NV)(what)))
+#define U_I(what) ((unsigned int)cast_ulong((NV)(what)))
+#define U_L(what) (cast_ulong((NV)(what)))
#endif
#ifdef CASTI32
#define I_V(what) ((IV)(what))
#define U_V(what) ((UV)(what))
#else
-#define I_32(what) (cast_i32((double)(what)))
-#define I_V(what) (cast_iv((double)(what)))
-#define U_V(what) (cast_uv((double)(what)))
+#define I_32(what) (cast_i32((NV)(what)))
+#define I_V(what) (cast_iv((NV)(what)))
+#define U_V(what) (cast_uv((NV)(what)))
+#endif
+
+/* 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)
+
+/* Believe. */
+#define IV_FITS_IN_NV
+/* Doubt. */
+#if defined(USE_LONG_DOUBLE) && \
+ defined(LDBL_MANT_DIG) && IV_DIG >= LDBL_MANT_DIG
+# undef IV_FITS_IN_NV
+#else
+# 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
+
+#ifdef IV_IS_QUAD
+# define UVuf PERL_PRIu64
+# define IVdf PERL_PRId64
+# define UVof PERL_PRIo64
+# define UVxf PERL_PRIx64
+#else
+# if LONGSIZE == 4
+# define UVuf "lu"
+# define IVdf "ld"
+# define UVof "lo"
+# define UVxf "lx"
+# else
+ /* Any good ideas? */
+# endif
#endif
/* Used with UV/IV arguments: */
#endif
#ifndef Perl_debug_log
-#define Perl_debug_log PerlIO_stderr()
+# define Perl_debug_log PerlIO_stderr()
+#endif
+
+#ifndef Perl_error_log
+# define Perl_error_log (PL_stderrgv \
+ ? IoOFP(GvIOp(PL_stderrgv)) \
+ : PerlIO_stderr())
#endif
#ifdef DEBUGGING
# if defined(PERL_OBJECT)
# define DEBUG_m(a) if (PL_debug & 128) a
# else
-# define DEBUG_m(a) if (PL_curinterp && 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 */
# ifndef getenv
char *getenv (const char*);
# endif /* !getenv */
+#ifndef EPOC
Off_t lseek (int,Off_t,int);
+#endif
# endif /* !DONT_DECLARE_STD */
char *getlogin (void);
#endif /* !__cplusplus */
#endif
-/*
- * These need prototyping here because <proto.h> isn't
- * included until after runops is initialised.
- */
-
-#ifndef PERL_OBJECT
-typedef int (*runops_proc_t) (pTHX);
-int Perl_runops_standard (pTHX);
-#ifdef DEBUGGING
-int Perl_runops_debug (pTHX);
-#endif
-#endif
+typedef int (CPERLscope(*runops_proc_t)) (pTHX);
+typedef OP* (CPERLscope(*PPADDR_t)[]) (pTHX);
/* _ (for $_) must be first in the following list (DEFSV requires it) */
#define THREADSV_NAMES "_123456789&`'+/.,\\\";^-%=|~:\001\005!@"
# if !defined(DONT_DECLARE_STD) || \
(defined(__svr4__) && defined(__GNUC__) && defined(sun)) || \
defined(__sgi) || \
- defined(__DGUX)
+ defined(__DGUX) || defined(EPOC)
extern char ** environ; /* environment variables supplied via exec */
# endif
# endif
#endif
+START_EXTERN_C
+
/* handy constants */
EXTCONST char PL_warn_uninit[]
INIT("Use of uninitialized value");
#endif
#endif
+END_EXTERN_C
+
/*****************************************************************************/
/* This lexer/parser stuff is currently global since yacc is hard to reenter */
/*****************************************************************************/
XREF,
XSTATE,
XBLOCK,
+ XATTRBLOCK,
+ XATTRTERM,
XTERMBLOCK
} expectation;
#define HINT_STRICT_REFS 0x00000002
/* #define HINT_notused4 0x00000004 */
#define HINT_UTF8 0x00000008
-/* #define HINT_notused10 0x00000010 */
+#define HINT_BYTE 0x00000010
/* Note: 20,40,80 used for NATIVE_HINTS */
#define HINT_BLOCK_SCOPE 0x00000100
/* Various states of an input record separator SV (rs, nrs) */
#define RsSNARF(sv) (! SvOK(sv))
-#define RsSIMPLE(sv) (SvOK(sv) && SvCUR(sv))
-#define RsPARA(sv) (SvOK(sv) && ! SvCUR(sv))
+#define RsSIMPLE(sv) (SvOK(sv) && (! SvPOK(sv) || SvCUR(sv)))
+#define RsPARA(sv) (SvPOK(sv) && ! SvCUR(sv))
#define RsRECORD(sv) (SvROK(sv) && (SvIV(SvRV(sv)) > 0))
/* Enable variables which are pointers to functions */
-#ifdef PERL_OBJECT
-typedef regexp*(CPerlObj::*regcomp_t) (char* exp, char* xend, PMOP* pm);
-typedef I32 (CPerlObj::*regexec_t) (regexp* prog, char* stringarg,
- char* strend, char* strbeg,
- I32 minend, SV* screamer, void* data,
- U32 flags);
-#else
-typedef regexp*(*regcomp_t) (pTHX_ char* exp, char* xend, PMOP* pm);
-typedef I32 (*regexec_t) (pTHX_ regexp* prog, char* stringarg, char* strend, char*
- strbeg, I32 minend, SV* screamer, void* data,
- U32 flags);
+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,
+ SV* screamer, void* data, U32 flags);
+typedef char* (CPERLscope(*re_intuit_start_t)) (pTHX_ regexp *prog, SV *sv,
+ char *strpos, char *strend,
+ U32 flags,
+ struct re_scream_pos_data_s *d);
+typedef SV* (CPERLscope(*re_intuit_string_t)) (pTHX_ regexp *prog);
+typedef void (CPERLscope(*regfree_t)) (pTHX_ struct regexp* r);
+#ifdef USE_PURE_BISON
+int Perl_yylex(pTHX_ YYSTYPE *lvalp, int *lcharp);
#endif
+typedef void (*DESTRUCTORFUNC_NOCONTEXT_t) (void*);
+typedef void (*DESTRUCTORFUNC_t) (pTHXo_ void*);
+typedef void (*SVFUNC_t) (pTHXo_ SV*);
+typedef I32 (*SVCOMPARE_t) (pTHXo_ SV*, SV*);
+typedef void (*XSINIT_t) (pTHXo);
+typedef void (*ATEXIT_t) (pTHXo_ void*);
+typedef void (*XSUBADDR_t) (pTHXo_ CV *);
+
/* Set up PERLVAR macros for populating structs */
#define PERLVAR(var,type) type var;
+#define PERLVARA(var,n,type) type var[n];
#define PERLVARI(var,type,init) type var;
#define PERLVARIC(var,type,init) type var;
/* Interpreter exitlist entry */
typedef struct exitlistentry {
-#ifdef PERL_OBJECT
- void (*fn) (CPerlObj*, void*);
-#else
- void (*fn) (pTHX_ void*);
-#endif
+ void (*fn) (pTHXo_ void*);
void *ptr;
} PerlExitListEntry;
#ifdef PERL_OBJECT
-extern "C" CPerlObj* perl_alloc (IPerlMem*, IPerlEnv*, IPerlStdIO*, IPerlLIO*, IPerlDir*, IPerlSock*, IPerlProc*);
-
-#ifdef PERL_OBJECT
-typedef int (CPerlObj::*runops_proc_t) (void);
-#endif /* PERL_OBJECT */
+#undef perl_alloc
+#define perl_alloc Perl_alloc
+CPerlObj* Perl_alloc (IPerlMem*, IPerlEnv*, IPerlStdIO*, IPerlLIO*, IPerlDir*, IPerlSock*, IPerlProc*);
#undef EXT
#define EXT
CPerlObj(IPerlMem*, IPerlEnv*, IPerlStdIO*, IPerlLIO*, IPerlDir*, IPerlSock*, IPerlProc*);
void Init(void);
void* operator new(size_t nSize, IPerlMem *pvtbl);
+ static void operator delete(void* pPerl, IPerlMem *pvtbl);
#endif /* PERL_OBJECT */
#ifdef PERL_GLOBAL_STRUCT
EXT struct perl_vars PL_Vars;
EXT struct perl_vars *PL_VarsPtr INIT(&PL_Vars);
#else /* PERL_CORE */
-#if !defined(__GNUC__) || !(defined(WIN32) || defined(CYGWIN32))
+#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"
};
/* Done with PERLVAR macros for now ... */
#undef PERLVAR
+#undef PERLVARA
#undef PERLVARI
#undef PERLVARIC
# define VIRTUAL virtual PERL_CALLCONV
#else
# define VIRTUAL PERL_CALLCONV
-START_EXTERN_C
+/*START_EXTERN_C*/
#endif
#ifndef NEXT30_NO_ATTRIBUTE
# endif
#endif
-#ifdef USE_PURE_BISON
-int Perl_yylex(pTHX_ YYSTYPE *lvalp, int *lcharp);
+#ifdef PERL_OBJECT
+#define PERL_DECL_PROT
+#define perl_alloc Perl_alloc
#endif
-typedef void (*DESTRUCTORFUNC_t) (pTHX_ void*);
-typedef void (*SVFUNC_t) (pTHX_ SV*);
-typedef I32 (*SVCOMPARE_t) (pTHX_ SV*, SV*);
-typedef void (*XSINIT_t) (pTHX);
-typedef void (*ATEXIT_t) (pTHX_ void*);
-typedef void (*XSUBADDR_t) (pTHX_ CV *);
-
#include "proto.h"
+#undef PERL_CKDEF
+#undef PERL_PPDEF
+#define PERL_CKDEF(s) OP *s (pTHX_ OP *o);
+#define PERL_PPDEF(s) OP *s (pTHX);
+#ifdef PERL_OBJECT
+public:
+#endif
+
#include "pp_proto.h"
+#ifdef PERL_OBJECT
+VIRTUAL int CPerlObj::do_aspawn (void *vreally, void **vmark, void **vsp);
+#undef PERL_DECL_PROT
+#else
+/*END_EXTERN_C*/
+#endif
+
#ifndef PERL_OBJECT
-END_EXTERN_C
+/* this has structure inits, so it cannot be included before here */
+# include "opcode.h"
#endif
/* The following must follow proto.h as #defines mess up syntax */
*/
#define PERLVAR(var,type) EXT type PL_##var;
+#define PERLVARA(var,n,type) EXT type PL_##var[n];
#define PERLVARI(var,type,init) EXT type PL_##var INIT(init);
#define PERLVARIC(var,type,init) EXTCONST type PL_##var INIT(init);
-#ifndef PERL_GLOBAL_STRUCT
-#include "perlvars.h"
-#endif
-
#ifndef MULTIPLICITY
# include "intrpvar.h"
* be defined to maintain binary compatibility with PERL_OBJECT
* for 5.005
*/
-PERLVAR(object_compatibility[30], char)
+PERLVARA(object_compatibility,30, char)
};
+
# include "embed.h"
# if defined(WIN32) && !defined(WIN32IO_IS_STDIO)
# define errno CPerlObj::ErrorNo()
#endif /* PERL_OBJECT */
+#ifndef PERL_GLOBAL_STRUCT
+START_EXTERN_C
+
+# include "perlvars.h"
+
+END_EXTERN_C
+#endif
+
#undef PERLVAR
+#undef PERLVARA
#undef PERLVARI
#undef PERLVARIC
+START_EXTERN_C
+
#ifdef DOINIT
EXT MGVTBL PL_vtbl_sv = {Perl_magic_get,
EXTCONST char * PL_AMG_names[NofAMmeth];
#endif /* def INITAMAGIC */
+END_EXTERN_C
+
struct am_table {
long was_ok_sub;
long was_ok_am;
set_numeric_local(); \
} STMT_END
+#define IS_NUMERIC_RADIX(c) \
+ ((PL_hints & HINT_LOCALE) && \
+ PL_numeric_radix && (c) == PL_numeric_radix)
+
+#define RESTORE_NUMERIC_LOCAL() if ((PL_hints & HINT_LOCALE) && PL_numeric_standard) SET_NUMERIC_LOCAL()
+#define RESTORE_NUMERIC_STANDARD() if ((PL_hints & HINT_LOCALE) && PL_numeric_local) SET_NUMERIC_STANDARD()
+#define Atof my_atof
+
#else /* !USE_LOCALE_NUMERIC */
-#define SET_NUMERIC_STANDARD() /**/
-#define SET_NUMERIC_LOCAL() /**/
+#define SET_NUMERIC_STANDARD() /**/
+#define SET_NUMERIC_LOCAL() /**/
+#define IS_NUMERIC_RADIX(c) (0)
+#define RESTORE_NUMERIC_LOCAL() /**/
+#define RESTORE_NUMERIC_STANDARD() /**/
+#define Atof Perl_atof
#endif /* !USE_LOCALE_NUMERIC */
+#if defined(USE_LONG_LONG) && defined(HAS_LONG_LONG) && defined(HAS_ATOLL)
+#define Atol atoll
+#else
+#define Atol atol
+#endif
+
+#if defined(USE_LONG_LONG) && defined(HAS_LONG_LONG) && defined(HAS_STRTOULL)
+#define Strtoul strtoull
+#else
+#define Strtoul strtoul
+#endif
+
#if !defined(PERLIO_IS_STDIO) && defined(HASATTRIBUTE)
/*
* Now we have __attribute__ out of the way
# include <sys/sem.h>
# ifndef HAS_UNION_SEMUN /* Provide the union semun. */
union semun {
- int val;
- struct semid_ds *buf;
- unsigned short *array;
+ int val;
+ struct semid_ds *buf;
+ unsigned short *array;
};
# endif
# ifdef USE_SEMCTL_SEMUN
+# ifdef IRIX32_SEMUN_BROKEN_BY_GCC
+ union gccbug_semun {
+ int val;
+ struct semid_ds *buf;
+ unsigned short *array;
+ char __dummy[5];
+ };
+# define semun gccbug_semun
+# endif
# define Semctl(id, num, cmd, semun) semctl(id, num, cmd, semun)
# else
# ifdef USE_SEMCTL_SEMID_DS