*/
#ifndef H_PERL
#define H_PERL 1
-#define OVERLOAD
#ifdef PERL_FOR_X2P
/*
* Above symbol is defined via -D in 'x2p/Makefile.SH'
* Decouple x2p stuff from some of perls more extreme eccentricities.
*/
-#undef EMBED
-#undef NO_EMBED
-#define NO_EMBED
#undef MULTIPLICITY
#undef USE_STDIO
#define USE_STDIO
variables or functions needed are made member functions
3. all writable static variables are made member variables
4. all global variables and functions are defined as:
- #define var CPerlObj::Perl_var
+ #define var CPerlObj::PL_var
#define func CPerlObj::Perl_func
- * these are in objpp.h
+ * these are in embed.h
This necessitated renaming some local variables and functions that
had the same name as a global variable or function. This was
probably a _good_ thing anyway.
1. Access to global variables and perl functions is through a
pointer to the PERL_OBJECT. This pointer type is CPerlObj*. This is
made transparent to extension developers by the following macros:
- #define var pPerl->Perl_var
+ #define var pPerl->PL_var
#define func pPerl->Perl_func
- * these are done in ObjXSub.h
+ * these are done in objXSUB.h
This requires that the extension be compiled as C++, which means
that the code must be ANSI C and not K&R C. For K&R extensions,
please see the C API notes located in Win32/GenCAPI.pl. This script
-creates a PerlCAPI.lib that provides a K & R compatible C interface
+creates a perlCAPI.lib that provides a K & R compatible C interface
to the PERL_OBJECT.
2. Local variables and functions cannot have the same name as perl's
variables or functions since the macros will redefine these. Look for
#define PERL_OBJECT_THIS this
#define _PERL_OBJECT_THIS ,this
#define PERL_OBJECT_THIS_ this,
-#define CALLRUNOPS (this->*runops)
+#define CALL_FPTR(fptr) (this->*fptr)
#else /* !PERL_OBJECT */
#define PERL_OBJECT_THIS
#define _PERL_OBJECT_THIS
#define PERL_OBJECT_THIS_
-#define CALLRUNOPS runops
+#define CALL_FPTR(fptr) (*fptr)
#endif /* PERL_OBJECT */
+#define CALLRUNOPS CALL_FPTR(PL_runops)
+#define CALLREGCOMP CALL_FPTR(PL_regcompp)
+#define CALLREGEXEC CALL_FPTR(PL_regexecp)
+#define CALLPROTECT CALL_FPTR(PL_protect)
+
#define VOIDUSED 1
#include "config.h"
-#include "embed.h"
+#if !defined(PERL_FOR_X2P)
+# include "embed.h"
+#endif
#undef START_EXTERN_C
#undef END_EXTERN_C
# ifdef __GNUC__
# define stringify_immed(s) #s
# define stringify(s) stringify_immed(s)
-#ifdef EMBED
register struct op *Perl_op asm(stringify(OP_IN_REGISTER));
-#else
-register struct op *op asm(stringify(OP_IN_REGISTER));
-#endif
# endif
#endif
# define LIBERAL 1
#endif
+#if 'A' == 65 && 'I' == 73 && 'J' == 74 && 'Z' == 90
+#define ASCIIish
+#else
+#undef ASCIIish
+#endif
+
/*
* The following contortions are brought to you on behalf of all the
* standards, semi-standards, de facto standards, not-so-de-facto standards
*/
/* 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(CYGWIN32)
#define DOSISH 1
#endif
# define VOL
#endif
-#define TAINT (tainted = TRUE)
-#define TAINT_NOT (tainted = FALSE)
-#define TAINT_IF(c) if (c) { tainted = TRUE; }
-#define TAINT_ENV() if (tainting) { taint_env(); }
-#define TAINT_PROPER(s) if (tainting) { taint_proper(no_security, s); }
+#define TAINT (PL_tainted = TRUE)
+#define TAINT_NOT (PL_tainted = FALSE)
+#define TAINT_IF(c) if (c) { PL_tainted = TRUE; }
+#define TAINT_ENV() if (PL_tainting) { taint_env(); }
+#define TAINT_PROPER(s) if (PL_tainting) { taint_proper(Nullch, s); }
/* XXX All process group stuff is handled in pp_sys.c. Should these
defines move there? If so, I could simplify this a lot. --AD 9/96.
# endif
#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)
+# include <pthread.h>
+#endif
+
#ifndef _TYPES_ /* If types.h defines this it's easy. */
# ifndef major /* Does everyone's types.h define this? */
# include <sys/types.h>
#ifdef USE_NEXT_CTYPE
-#if NX_CURRENT_COMPILER_RELEASE >= 400
-#include <objc/NXCType.h>
-#else /* NX_CURRENT_COMPILER_RELEASE < 400 */
-#include <appkit/NXCType.h>
-#endif /* NX_CURRENT_COMPILER_RELEASE >= 400 */
+#if NX_CURRENT_COMPILER_RELEASE >= 500
+# include <bsd/ctypes.h>
+#else
+# if NX_CURRENT_COMPILER_RELEASE >= 400
+# include <objc/NXCType.h>
+# else /* NX_CURRENT_COMPILER_RELEASE < 400 */
+# include <appkit/NXCType.h>
+# endif /* NX_CURRENT_COMPILER_RELEASE >= 400 */
+#endif /* NX_CURRENT_COMPILER_RELEASE >= 500 */
#else /* !USE_NEXT_CTYPE */
#include <ctype.h>
* library prototypes; we'll use our own in proto.h instead. */
#ifdef MYMALLOC
-
-# ifdef HIDEMYMALLOC
-# define malloc Mymalloc
-# define calloc Mycalloc
-# define realloc Myrealloc
-# define free Myfree
-Malloc_t Mymalloc _((MEM_SIZE nbytes));
-Malloc_t Mycalloc _((MEM_SIZE elements, MEM_SIZE size));
-Malloc_t Myrealloc _((Malloc_t where, MEM_SIZE nbytes));
-Free_t Myfree _((Malloc_t where));
-# endif
-# ifdef EMBEDMYMALLOC
-# define malloc Perl_malloc
-# define calloc Perl_calloc
-# define realloc Perl_realloc
-/* VMS' external symbols are case-insensitive, and there's already a */
-/* perl_free in perl.h */
-#ifdef VMS
-# define free Perl_myfree
-#else
-# define free Perl_free
-#endif
+# ifdef PERL_POLLUTE_MALLOC
+# define Perl_malloc malloc
+# define Perl_calloc calloc
+# define Perl_realloc realloc
+# define Perl_mfree free
+# else
+# define EMBEDMYMALLOC /* for compatibility */
+# endif
Malloc_t Perl_malloc _((MEM_SIZE nbytes));
Malloc_t Perl_calloc _((MEM_SIZE elements, MEM_SIZE size));
Malloc_t Perl_realloc _((Malloc_t where, MEM_SIZE nbytes));
-#ifdef VMS
-Free_t Perl_myfree _((Malloc_t where));
-#else
-Free_t Perl_free _((Malloc_t where));
-#endif
-# endif
-
-# undef safemalloc
-# undef safecalloc
-# undef saferealloc
-# undef safefree
-# define safemalloc malloc
-# define safecalloc calloc
-# define saferealloc realloc
-# define safefree free
-
+/* 'mfree' rather than 'free', since there is already a 'perl_free'
+ * that causes clashes with case-insensitive linkers */
+Free_t Perl_mfree _((Malloc_t where));
+
+# define safemalloc Perl_malloc
+# define safecalloc Perl_calloc
+# define saferealloc Perl_realloc
+# define safefree Perl_mfree
+#else /* MYMALLOC */
+# define safemalloc safesysmalloc
+# define safecalloc safesyscalloc
+# define saferealloc safesysrealloc
+# define safefree safesysfree
#endif /* MYMALLOC */
#if defined(STANDARD_C) && defined(I_STDDEF)
# endif
#endif
+#ifndef memchr
+# ifndef HAS_MEMCHR
+# define memchr(s,c,n) ninstr((char*)(s), ((char*)(s)) + n, &(c), &(c) + 1)
+# endif
+#endif
+
#ifndef HAS_BCMP
# ifndef bcmp
# define bcmp(s1,s2,l) memcmp(s1,s2,l)
# include <netinet/in.h>
#endif
+#ifdef I_ARPA_INET
+# include <arpa/inet.h>
+#endif
+
#if defined(SF_APPEND) && defined(USE_SFIO) && defined(I_SFIO)
/* <sfio.h> defines SF_APPEND and <sys/stat.h> might define SF_APPEND
* (the neo-BSD seem to do this). */
set_vaxc_errno(vmserrcode); \
} STMT_END
#else
-# define SETERRNO(errcode,vmserrcode) errno = (errcode)
+# define SETERRNO(errcode,vmserrcode) (errno = (errcode))
#endif
#ifdef USE_THREADS
# define DEFSV THREADSV(0)
# define SAVE_DEFSV save_threadsv(0)
#else
-# define ERRSV GvSV(errgv)
-# define ERRHV GvHV(errgv)
-# define DEFSV GvSV(defgv)
-# define SAVE_DEFSV SAVESPTR(GvSV(defgv))
+# 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 */
#ifndef errno
- extern int errno; /* ANSI allows errno to be an lvalue expr */
+ extern int errno; /* ANSI allows errno to be an lvalue expr.
+ * For example in multithreaded environments
+ * something like this might happen:
+ * extern int *_errno(void);
+ * #define errno (*_errno()) */
#endif
#ifdef HAS_STRERROR
/* Configure already sets Direntry_t */
#if defined(I_DIRENT)
# include <dirent.h>
-# if defined(NeXT) && defined(I_SYS_DIR) /* NeXT needs dirent + sys/dir.h */
+ /* NeXT needs dirent + sys/dir.h */
+# if defined(I_SYS_DIR) && (defined(NeXT) || defined(__NeXT__))
# include <sys/dir.h>
# endif
#else
#undef UV
#endif
+#ifdef I_INTTYPES
+#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,
--Andy Dougherty August 1996
*/
-#ifdef cray
-# define Quad_t int
-#else
-# ifdef convex
-# define Quad_t long long
-# else
-# if LONGSIZE == 8
-# define Quad_t long
-# endif
+/* Much more 64-bit probing added. Now we should get Quad_t
+ in most systems: int64_t, long long, long, int, will do.
+
+ Beware of LP32 systems (ILP32, ILP32LL64). Such systems have been
+ used to sizeof(long) == sizeof(foo*). This is a bad assumption
+ because then IV/UV have been 32 bits, too. Which, in turn means
+ that even if the system has quads (e.g. long long), IV cannot be a
+ quad. Introducing a 64-bit IV (because of long long existing)
+ will introduce binary incompatibility.
+
+ 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.
+
+ --jhi September 1998 */
+
+#if INTSIZE == 4 && LONGSIZE == 4 && PTRSIZE == 4
+# define PERL_ILP32
+# if defined(HAS_LONG_LONG) && LONGLONGSIZE == 8
+# define PERL_ILP32LL64
# endif
#endif
-/* XXX Experimental set-up for long long. Just add -DUSE_LONG_LONG
- to your ccflags. --Andy Dougherty 4/1998
-*/
-#ifdef USE_LONG_LONG
-# if defined(HAS_LONG_LONG) && LONGLONGSIZE == 8
-# define Quad_t long long
-# endif
+#if LONGSIZE == 8 && PTRSIZE == 8
+# define PERL_LP64
+# if INTSIZE == 8
+# define PERL_ILP64
+# endif
+#endif
+
+#ifndef Quad_t
+# if LONGSIZE == 8
+# define Quad_t long
+# define Uquad_t unsigned long
+# define PERL_QUAD_IS_LONG
+# endif
+#endif
+
+#ifndef Quad_t
+# if INTSIZE == 8
+# define Quad_t int
+# define Uquad_t unsigned int
+# define PERL_QUAD_IS_INT
+# endif
+#endif
+
+#ifndef Quad_t
+# ifdef USE_LONG_LONG /* See above note about LP32. --jhi */
+# if defined(HAS_LONG_LONG) && LONGLONGSIZE == 8
+# define Quad_t long long
+# define Uquad_t unsigned long long
+# define PERL_QUAD_IS_LONG_LONG
+# endif
+# endif
+#endif
+
+#ifndef Quad_t
+# ifdef HAS_INT64_T
+# define Quad_t int64_t
+# define Uquad_t uint64_t
+# define PERL_QUAD_IS_INT64_T
+# endif
#endif
#ifdef Quad_t
# define HAS_QUAD
- typedef Quad_t IV;
- typedef unsigned Quad_t UV;
-# define IV_MAX PERL_QUAD_MAX
-# define IV_MIN PERL_QUAD_MIN
-# define UV_MAX PERL_UQUAD_MAX
-# define UV_MIN PERL_UQUAD_MIN
+# ifndef Uquad_t
+ /* Note that if your Quad_t is a typedef (not a #define) you *MUST*
+ * have defined by now Uquad_t yourself because 'unsigned type'
+ * is illegal. */
+# define Uquad_t unsigned Quad_t
+# endif
+#endif
+
+#if defined(USE_64_BITS) && defined(HAS_QUAD)
+# ifdef PERL_QUAD_IS_LONG /* LP64 */
+ typedef long IV;
+ typedef unsigned long UV;
+# else
+# ifdef PERL_QUAD_IS_INT /* ILP64 */
+ typedef int IV;
+ typedef unsigned int UV;
+# else
+# ifdef PERL_QUAD_IS_LONG_LONG /* LL64 */
+ typedef long long IV;
+ typedef unsigned long long UV;
+# else
+# ifdef PERL_QUAD_IS_INT64_T /* C9X */
+ typedef int64_t IV;
+ typedef uint64_t UV;
+# endif
+# endif
+# endif
+# endif
+# if defined(PERL_QUAD_IS_INT64_T) && defined(INT64_MAX)
+# define IV_MAX INT64_MAX
+# define IV_MIN INT64_MIN
+# define UV_MAX UINT64_MAX
+# define UV_MIN UINT64_MIN
+# else
+# define IV_MAX PERL_QUAD_MAX
+# define IV_MIN PERL_QUAD_MIN
+# define UV_MAX PERL_UQUAD_MAX
+# define UV_MIN PERL_UQUAD_MIN
+# endif
#else
- typedef long IV;
- typedef unsigned long UV;
-# define IV_MAX PERL_LONG_MAX
-# define IV_MIN PERL_LONG_MIN
-# define UV_MAX PERL_ULONG_MAX
-# define UV_MIN PERL_ULONG_MIN
+ 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
+# define UV_MIN UINT32_MIN
+# else
+# define IV_MAX PERL_LONG_MAX
+# define IV_MIN PERL_LONG_MIN
+# define UV_MAX PERL_ULONG_MAX
+# define UV_MIN PERL_ULONG_MIN
+# endif
#endif
/* Previously these definitions used hardcoded figures.
#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
+# 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
+# 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
+# endif
+#endif
+
#ifdef PERL_OBJECT
typedef I32 (*filter_t) _((CPerlObj*, int, SV *, int));
#else
#endif
#define FILTER_READ(idx, sv, len) filter_read(idx, sv, len)
-#define FILTER_DATA(idx) (AvARRAY(rsfp_filters)[idx])
-#define FILTER_ISREADER(idx) (idx >= AvFILLp(rsfp_filters))
+#define FILTER_DATA(idx) (AvARRAY(PL_rsfp_filters)[idx])
+#define FILTER_ISREADER(idx) (idx >= AvFILLp(PL_rsfp_filters))
+
+#if defined(__OPEN_VM)
+# include "vmesa/vmesaish.h"
+#endif
#ifdef DOSISH
# if defined(OS2)
# if defined(PLAN9)
# include "./plan9/plan9ish.h"
# else
-# include "unixish.h"
+# if defined(MPE)
+# include "mpeix/mpeixish.h"
+# else
+# if defined(__VOS__)
+# include "vosish.h"
+# else
+# include "unixish.h"
+# endif
+# endif
# endif
# endif
#endif
+#ifndef MAXPATHLEN
+# ifdef PATH_MAX
+# ifdef _POSIX_PATH_MAX
+# if PATH_MAX > _POSIX_PATH_MAX
+/* MAXPATHLEN is supposed to include the final null character,
+ * as opposed to PATH_MAX and _POSIX_PATH_MAX. */
+# define MAXPATHLEN (PATH_MAX+1)
+# else
+# define MAXPATHLEN (_POSIX_PATH_MAX+1)
+# endif
+# else
+# define MAXPATHLEN (PATH_MAX+1)
+# endif
+# else
+# ifdef _POSIX_PATH_MAX
+# define MAXPATHLEN (_POSIX_PATH_MAX+1)
+# else
+# define MAXPATHLEN 1024 /* Err on the large side. */
+# endif
+# endif
+#endif
+
#ifndef FUNC_NAME_TO_PTR
#define FUNC_NAME_TO_PTR(name) name
#endif
*/
#ifdef USE_THREADS
+ /* pending resolution of licensing issues, we avoid the erstwhile
+ * atomic.h everywhere */
+# define EMULATE_ATOMIC_REFCOUNTS
+
# ifdef FAKE_THREADS
# include "fakethr.h"
# else
# ifdef OS2
# include "os2thread.h"
# else
-# include <pthread.h>
-typedef pthread_t perl_os_thread;
-typedef pthread_mutex_t perl_mutex;
-typedef pthread_cond_t perl_cond;
-typedef pthread_key_t perl_key;
+# ifdef I_MACH_CTHREADS
+# include <mach/cthreads.h>
+# if (defined(NeXT) || defined(__NeXT__)) && defined(PERL_POLLUTE_MALLOC)
+# define MUTEX_INIT_CALLS_MALLOC
+# endif
+typedef cthread_t perl_os_thread;
+typedef mutex_t perl_mutex;
+typedef condition_t perl_cond;
+typedef void * perl_key;
+# else /* Posix threads */
+# include <pthread.h>
+typedef pthread_t perl_os_thread;
+typedef pthread_mutex_t perl_mutex;
+typedef pthread_cond_t perl_cond;
+typedef pthread_key_t perl_key;
+# endif /* I_MACH_CTHREADS */
# endif /* OS2 */
# endif /* WIN32 */
# endif /* FAKE_THREADS */
#endif /* USE_THREADS */
-
-
#ifdef VMS
-# define STATUS_NATIVE statusvalue_vms
+# define STATUS_NATIVE PL_statusvalue_vms
# define STATUS_NATIVE_EXPORT \
- ((I32)statusvalue_vms == -1 ? 44 : statusvalue_vms)
+ ((I32)PL_statusvalue_vms == -1 ? 44 : PL_statusvalue_vms)
# define STATUS_NATIVE_SET(n) \
STMT_START { \
- statusvalue_vms = (n); \
- if ((I32)statusvalue_vms == -1) \
- statusvalue = -1; \
- else if (statusvalue_vms & STS$M_SUCCESS) \
- statusvalue = 0; \
- else if ((statusvalue_vms & STS$M_SEVERITY) == 0) \
- statusvalue = 1 << 8; \
+ PL_statusvalue_vms = (n); \
+ if ((I32)PL_statusvalue_vms == -1) \
+ PL_statusvalue = -1; \
+ else if (PL_statusvalue_vms & STS$M_SUCCESS) \
+ PL_statusvalue = 0; \
+ else if ((PL_statusvalue_vms & STS$M_SEVERITY) == 0) \
+ PL_statusvalue = 1 << 8; \
else \
- statusvalue = (statusvalue_vms & STS$M_SEVERITY) << 8; \
+ PL_statusvalue = (PL_statusvalue_vms & STS$M_SEVERITY) << 8; \
} STMT_END
-# define STATUS_POSIX statusvalue
+# define STATUS_POSIX PL_statusvalue
# ifdef VMSISH_STATUS
# define STATUS_CURRENT (VMSISH_STATUS ? STATUS_NATIVE : STATUS_POSIX)
# else
# endif
# define STATUS_POSIX_SET(n) \
STMT_START { \
- statusvalue = (n); \
- if (statusvalue != -1) { \
- statusvalue &= 0xFFFF; \
- statusvalue_vms = statusvalue ? 44 : 1; \
+ PL_statusvalue = (n); \
+ if (PL_statusvalue != -1) { \
+ PL_statusvalue &= 0xFFFF; \
+ PL_statusvalue_vms = PL_statusvalue ? 44 : 1; \
} \
- else statusvalue_vms = -1; \
+ else PL_statusvalue_vms = -1; \
} STMT_END
-# define STATUS_ALL_SUCCESS (statusvalue = 0, statusvalue_vms = 1)
-# define STATUS_ALL_FAILURE (statusvalue = 1, statusvalue_vms = 44)
+# define STATUS_ALL_SUCCESS (PL_statusvalue = 0, PL_statusvalue_vms = 1)
+# define STATUS_ALL_FAILURE (PL_statusvalue = 1, PL_statusvalue_vms = 44)
#else
# define STATUS_NATIVE STATUS_POSIX
# define STATUS_NATIVE_EXPORT STATUS_POSIX
# define STATUS_NATIVE_SET STATUS_POSIX_SET
-# define STATUS_POSIX statusvalue
+# define STATUS_POSIX PL_statusvalue
# define STATUS_POSIX_SET(n) \
STMT_START { \
- statusvalue = (n); \
- if (statusvalue != -1) \
- statusvalue &= 0xFFFF; \
+ PL_statusvalue = (n); \
+ if (PL_statusvalue != -1) \
+ PL_statusvalue &= 0xFFFF; \
} STMT_END
# define STATUS_CURRENT STATUS_POSIX
-# define STATUS_ALL_SUCCESS (statusvalue = 0)
-# define STATUS_ALL_FAILURE (statusvalue = 1)
+# define STATUS_ALL_SUCCESS (PL_statusvalue = 0)
+# define STATUS_ALL_FAILURE (PL_statusvalue = 1)
+#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)
+# define PERL_FLUSHALL_FOR_CHILD PerlIO_flush((PerlIO*)NULL)
+# else
+# ifdef FFLUSH_ALL
+# define PERL_FLUSHALL_FOR_CHILD my_fflush_all()
+# else
+# define PERL_FLUSHALL_FOR_CHILD (void)0
+# endif
+# endif
#endif
/* Some unistd.h's give a prototype for pause() even though
#define ARGSproto void
#endif /* USE_THREADS */
-/* Work around some cygwin32 problems with importing global symbols */
-#if defined(CYGWIN32) && defined(DLLIMPORT)
-# include "cw32imp.h"
+#if defined(CYGWIN32)
+/* USEMYBINMODE
+ * This symbol, if defined, indicates that the program should
+ * use the routine my_binmode(FILE *fp, char iotype) 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 : NULL)
#endif
#include "regexp.h"
#include "form.h"
#include "gv.h"
#include "cv.h"
+#ifndef PERL_OBJECT
#include "opcode.h"
+#endif
#include "op.h"
#include "cop.h"
#include "av.h"
#include "hv.h"
#include "mg.h"
#include "scope.h"
-#include "bytecode.h"
-#include "byterun.h"
+#include "warning.h"
+#include "utf8.h"
/* Current curly descriptor */
typedef struct curcur CURCUR;
I32 super_state; /* lexer state to save */
I32 sub_inwhat; /* "lex_inwhat" to use */
OP *sub_op; /* "lex_op" to use */
+ char *super_bufptr; /* PL_bufptr that was */
+ char *super_bufend; /* PL_bufend that was */
};
-#ifdef PERL_OBJECT
-struct magic_state {
- SV* mgs_sv;
- U32 mgs_flags;
-};
-typedef struct magic_state MGS;
+typedef struct magic_state MGS; /* struct magic_state defined in mg.c */
+#ifdef PERL_OBJECT
typedef struct {
I32 len_min;
I32 len_delta;
typedef I32 CHECKPOINT;
#endif /* PERL_OBJECT */
-/* work around some libPW problems */
-#ifdef DOINIT
-EXT char Error[1];
-#endif
-
#if defined(iAPX286) || defined(M_I286) || defined(I80286)
# define I286
#endif
# define HAS_VTOHS
# define HAS_HTOVL
# define HAS_HTOVS
-# if BYTEORDER == 0x4321
+# if BYTEORDER == 0x4321 || BYTEORDER == 0x87654321
# define vtohl(x) ((((x)&0xFF)<<24) \
+(((x)>>24)&0xFF) \
+(((x)&0x0000FF00)<<8) \
#define U_I(what) ((unsigned int)(what))
#define U_L(what) ((U32)(what))
#else
-EXTERN_C U32 cast_ulong _((double));
#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 I_V(what) ((IV)(what))
#define U_V(what) ((UV)(what))
#else
-START_EXTERN_C
-I32 cast_i32 _((double));
-IV cast_iv _((double));
-UV cast_uv _((double));
-END_EXTERN_C
#define I_32(what) (cast_i32((double)(what)))
#define I_V(what) (cast_iv((double)(what)))
#define U_V(what) (cast_uv((double)(what)))
#endif
+/* Used with UV/IV arguments: */
+ /* XXXX: need to speed it up */
+#define CLUMP_2UV(iv) ((iv) < 0 ? 0 : (UV)(iv))
+#define CLUMP_2IV(uv) ((uv) > (UV)IV_MAX ? IV_MAX : (IV)(uv))
+
struct Outrec {
I32 o_lines;
char *o_str;
Gid_t getegid _((void));
#endif
-#ifdef DEBUGGING
#ifndef Perl_debug_log
#define Perl_debug_log PerlIO_stderr()
#endif
+
+#ifdef DEBUGGING
+#undef YYDEBUG
#define YYDEBUG 1
#define DEB(a) a
-#define DEBUG(a) if (debug) a
-#define DEBUG_p(a) if (debug & 1) a
-#define DEBUG_s(a) if (debug & 2) a
-#define DEBUG_l(a) if (debug & 4) a
-#define DEBUG_t(a) if (debug & 8) a
-#define DEBUG_o(a) if (debug & 16) a
-#define DEBUG_c(a) if (debug & 32) a
-#define DEBUG_P(a) if (debug & 64) a
-#define DEBUG_m(a) if (curinterp && debug & 128) a
-#define DEBUG_f(a) if (debug & 256) a
-#define DEBUG_r(a) if (debug & 512) a
-#define DEBUG_x(a) if (debug & 1024) a
-#define DEBUG_u(a) if (debug & 2048) a
-#define DEBUG_L(a) if (debug & 4096) a
-#define DEBUG_H(a) if (debug & 8192) a
-#define DEBUG_X(a) if (debug & 16384) a
-#define DEBUG_D(a) if (debug & 32768) a
+#define DEBUG(a) if (PL_debug) a
+#define DEBUG_p(a) if (PL_debug & 1) a
+#define DEBUG_s(a) if (PL_debug & 2) a
+#define DEBUG_l(a) if (PL_debug & 4) a
+#define DEBUG_t(a) if (PL_debug & 8) a
+#define DEBUG_o(a) if (PL_debug & 16) a
+#define DEBUG_c(a) if (PL_debug & 32) a
+#define DEBUG_P(a) if (PL_debug & 64) a
+# ifdef PERL_OBJECT
+# define DEBUG_m(a) if (PL_debug & 128) a
+# else
+# define DEBUG_m(a) if (PL_curinterp && PL_debug & 128) a
+# endif
+#define DEBUG_f(a) if (PL_debug & 256) a
+#define DEBUG_r(a) if (PL_debug & 512) a
+#define DEBUG_x(a) if (PL_debug & 1024) a
+#define DEBUG_u(a) if (PL_debug & 2048) a
+#define DEBUG_L(a) if (PL_debug & 4096) a
+#define DEBUG_H(a) if (PL_debug & 8192) a
+#define DEBUG_X(a) if (PL_debug & 16384) a
+#define DEBUG_D(a) if (PL_debug & 32768) a
+# ifdef USE_THREADS
+# define DEBUG_S(a) if (PL_debug & (1<<16)) a
+# else
+# define DEBUG_S(a)
+# endif
#else
#define DEB(a)
#define DEBUG(a)
#define DEBUG_r(a)
#define DEBUG_x(a)
#define DEBUG_u(a)
-#define DEBUG_L(a)
+#define DEBUG_S(a)
#define DEBUG_H(a)
#define DEBUG_X(a)
#define DEBUG_D(a)
+#define DEBUG_S(a)
#endif
#define YYMAXDEPTH 300
/* All of these are in stdlib.h or time.h for ANSI C */
Time_t time();
struct tm *gmtime(), *localtime();
+#if defined(OEMVS) || defined(__OPEN_VM)
+char *(strchr)(), *(strrchr)();
+char *(strcpy)(), *(strcat)();
+#else
char *strchr(), *strrchr();
char *strcpy(), *strcat();
+#endif
#endif /* ! STANDARD_C */
#endif
#ifndef __cplusplus
-# ifdef __NeXT__ /* or whatever catches all NeXTs */
+# if defined(NeXT) || defined(__NeXT__) /* or whatever catches all NeXTs */
char *crypt (); /* Maybe more hosts will need the unprototyped version */
# else
# if !defined(WIN32) || !defined(HAVE_DES_FCRYPT)
char *crypt _((const char*, const char*));
# endif /* !WIN32 && !HAVE_CRYPT_SOURCE */
-# endif /* !__NeXT__ */
+# endif /* !NeXT && !__NeXT__ */
# ifndef DONT_DECLARE_STD
# ifndef getenv
char *getenv _((const char*));
#define UNLINK unlnk
I32 unlnk _((char*));
#else
-#define UNLINK unlink
+#define UNLINK PerlLIO_unlink
#endif
#ifndef HAS_SETREUID
# define PAD_SV(po) pad_sv(po)
# define RUNOPS_DEFAULT runops_debug
#else
-# define PAD_SV(po) curpad[po]
+# define PAD_SV(po) PL_curpad[po]
# define RUNOPS_DEFAULT runops_standard
#endif
#ifdef MYMALLOC
-# define MALLOC_INIT MUTEX_INIT(&malloc_mutex)
-# define MALLOC_TERM MUTEX_DESTROY(&malloc_mutex)
+# ifdef MUTEX_INIT_CALLS_MALLOC
+# define MALLOC_INIT \
+ STMT_START { \
+ PL_malloc_mutex = NULL; \
+ MUTEX_INIT(&PL_malloc_mutex); \
+ } STMT_END
+# define MALLOC_TERM \
+ STMT_START { \
+ perl_mutex tmp = PL_malloc_mutex; \
+ PL_malloc_mutex = NULL; \
+ MUTEX_DESTROY(&tmp); \
+ } STMT_END
+# else
+# define MALLOC_INIT MUTEX_INIT(&PL_malloc_mutex)
+# define MALLOC_TERM MUTEX_DESTROY(&PL_malloc_mutex)
+# endif
#else
# define MALLOC_INIT
# define MALLOC_TERM
*/
#ifndef PERL_OBJECT
-typedef int runops_proc_t _((void));
+typedef int (*runops_proc_t) _((void));
int runops_standard _((void));
#ifdef DEBUGGING
int runops_debug _((void));
#endif
-#endif /* PERL_OBJECT */
+#endif
/* _ (for $_) must be first in the following list (DEFSV requires it) */
#define THREADSV_NAMES "_123456789&`'+/.,\\\";^-%=|~:\001\005!@"
-/* VMS doesn't use environ array and NeXT has problems with crt0.o globals */
-#if !defined(VMS) && !(defined(NeXT) && defined(__DYNAMIC__))
-#if !defined(DONT_DECLARE_STD) \
- || (defined(__svr4__) && defined(__GNUC__) && defined(sun)) \
- || defined(__sgi) || defined(__DGUX)
-extern char ** environ; /* environment variables supplied via exec */
-#endif
-#else
-# if defined(NeXT) && defined(__DYNAMIC__)
-
-# include <mach-o/dyld.h>
+/* NeXT has problems with crt0.o globals */
+#if defined(__DYNAMIC__) && \
+ (defined(NeXT) || defined(__NeXT__) || defined(__APPLE__))
+# if defined(NeXT) || defined(__NeXT)
+# include <mach-o/dyld.h>
+# define environ (*environ_pointer)
EXT char *** environ_pointer;
-# define environ (*environ_pointer)
+# else
+# if defined(__APPLE__)
+# include <crt_externs.h> /* for the env array */
+# define environ (*_NSGetEnviron())
+# endif
# endif
-#endif /* environ processing */
-
-
-/* for tmp use in stupid debuggers */
-EXT int * di;
-EXT short * ds;
-EXT char * dc;
+#else
+ /* VMS and some other platforms don't use the environ array */
+# if !defined(VMS)
+# if !defined(DONT_DECLARE_STD) || \
+ (defined(__svr4__) && defined(__GNUC__) && defined(sun)) || \
+ defined(__sgi) || \
+ defined(__DGUX)
+extern char ** environ; /* environment variables supplied via exec */
+# endif
+# endif
+#endif
/* handy constants */
-EXTCONST char warn_uninit[]
+EXTCONST char PL_warn_uninit[]
INIT("Use of uninitialized value");
-EXTCONST char warn_nosemi[]
+EXTCONST char PL_warn_nosemi[]
INIT("Semicolon seems to be missing");
-EXTCONST char warn_reserved[]
+EXTCONST char PL_warn_reserved[]
INIT("Unquoted string \"%s\" may clash with future reserved word");
-EXTCONST char warn_nl[]
+EXTCONST char PL_warn_nl[]
INIT("Unsuccessful %s on filename containing newline");
-EXTCONST char no_wrongref[]
+EXTCONST char PL_no_wrongref[]
INIT("Can't use %s ref as %s ref");
-EXTCONST char no_symref[]
+EXTCONST char PL_no_symref[]
INIT("Can't use string (\"%.32s\") as %s ref while \"strict refs\" in use");
-EXTCONST char no_usym[]
+EXTCONST char PL_no_usym[]
INIT("Can't use an undefined value as %s reference");
-EXTCONST char no_aelem[]
+EXTCONST char PL_no_aelem[]
INIT("Modification of non-creatable array value attempted, subscript %d");
-EXTCONST char no_helem[]
+EXTCONST char PL_no_helem[]
INIT("Modification of non-creatable hash value attempted, subscript \"%s\"");
-EXTCONST char no_modify[]
+EXTCONST char PL_no_modify[]
INIT("Modification of a read-only value attempted");
-EXTCONST char no_mem[]
+EXTCONST char PL_no_mem[]
INIT("Out of memory!\n");
-EXTCONST char no_security[]
+EXTCONST char PL_no_security[]
INIT("Insecure dependency in %s%s");
-EXTCONST char no_sock_func[]
+EXTCONST char PL_no_sock_func[]
INIT("Unsupported socket function \"%s\" called");
-EXTCONST char no_dir_func[]
+EXTCONST char PL_no_dir_func[]
INIT("Unsupported directory function \"%s\" called");
-EXTCONST char no_func[]
+EXTCONST char PL_no_func[]
INIT("The %s function is unimplemented");
-EXTCONST char no_myglob[]
+EXTCONST char PL_no_myglob[]
INIT("\"my\" variable %s can't be in a package");
+EXTCONST char PL_uuemap[65]
+ INIT("`!\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_");
+
+
#ifdef DOINIT
-EXT char *sig_name[] = { SIG_NAME };
-EXT int sig_num[] = { SIG_NUM };
-EXT SV * psig_ptr[sizeof(sig_num)/sizeof(*sig_num)];
-EXT SV * psig_name[sizeof(sig_num)/sizeof(*sig_num)];
+EXT char *PL_sig_name[] = { SIG_NAME };
+EXT int PL_sig_num[] = { SIG_NUM };
+EXT SV * PL_psig_ptr[sizeof(PL_sig_num)/sizeof(*PL_sig_num)];
+EXT SV * PL_psig_name[sizeof(PL_sig_num)/sizeof(*PL_sig_num)];
#else
-EXT char *sig_name[];
-EXT int sig_num[];
-EXT SV * psig_ptr[];
-EXT SV * psig_name[];
+EXT char *PL_sig_name[];
+EXT int PL_sig_num[];
+EXT SV * PL_psig_ptr[];
+EXT SV * PL_psig_name[];
#endif
/* fast case folding tables */
#ifdef DOINIT
-EXTCONST unsigned char fold[] = {
+#ifdef EBCDIC
+EXT unsigned char PL_fold[] = { /* fast EBCDIC case folding table */
+ 0, 1, 2, 3, 4, 5, 6, 7,
+ 8, 9, 10, 11, 12, 13, 14, 15,
+ 16, 17, 18, 19, 20, 21, 22, 23,
+ 24, 25, 26, 27, 28, 29, 30, 31,
+ 32, 33, 34, 35, 36, 37, 38, 39,
+ 40, 41, 42, 43, 44, 45, 46, 47,
+ 48, 49, 50, 51, 52, 53, 54, 55,
+ 56, 57, 58, 59, 60, 61, 62, 63,
+ 64, 65, 66, 67, 68, 69, 70, 71,
+ 72, 73, 74, 75, 76, 77, 78, 79,
+ 80, 81, 82, 83, 84, 85, 86, 87,
+ 88, 89, 90, 91, 92, 93, 94, 95,
+ 96, 97, 98, 99, 100, 101, 102, 103,
+ 104, 105, 106, 107, 108, 109, 110, 111,
+ 112, 113, 114, 115, 116, 117, 118, 119,
+ 120, 121, 122, 123, 124, 125, 126, 127,
+ 128, 'A', 'B', 'C', 'D', 'E', 'F', 'G',
+ 'H', 'I', 138, 139, 140, 141, 142, 143,
+ 144, 'J', 'K', 'L', 'M', 'N', 'O', 'P',
+ 'Q', 'R', 154, 155, 156, 157, 158, 159,
+ 160, 161, 'S', 'T', 'U', 'V', 'W', 'X',
+ 'Y', 'Z', 170, 171, 172, 173, 174, 175,
+ 176, 177, 178, 179, 180, 181, 182, 183,
+ 184, 185, 186, 187, 188, 189, 190, 191,
+ 192, 'a', 'b', 'c', 'd', 'e', 'f', 'g',
+ 'h', 'i', 202, 203, 204, 205, 206, 207,
+ 208, 'j', 'k', 'l', 'm', 'n', 'o', 'p',
+ 'q', 'r', 218, 219, 220, 221, 222, 223,
+ 224, 225, 's', 't', 'u', 'v', 'w', 'x',
+ 'y', 'z', 234, 235, 236, 237, 238, 239,
+ 240, 241, 242, 243, 244, 245, 246, 247,
+ 248, 249, 250, 251, 252, 253, 254, 255
+};
+#else /* ascii rather than ebcdic */
+EXTCONST unsigned char PL_fold[] = {
0, 1, 2, 3, 4, 5, 6, 7,
8, 9, 10, 11, 12, 13, 14, 15,
16, 17, 18, 19, 20, 21, 22, 23,
240, 241, 242, 243, 244, 245, 246, 247,
248, 249, 250, 251, 252, 253, 254, 255
};
+#endif /* !EBCDIC */
#else
-EXTCONST unsigned char fold[];
+EXTCONST unsigned char PL_fold[];
#endif
#ifdef DOINIT
-EXT unsigned char fold_locale[] = {
+EXT unsigned char PL_fold_locale[] = {
0, 1, 2, 3, 4, 5, 6, 7,
8, 9, 10, 11, 12, 13, 14, 15,
16, 17, 18, 19, 20, 21, 22, 23,
248, 249, 250, 251, 252, 253, 254, 255
};
#else
-EXT unsigned char fold_locale[];
+EXT unsigned char PL_fold_locale[];
#endif
#ifdef DOINIT
-EXTCONST unsigned char freq[] = { /* letter frequencies for mixed English/C */
+#ifdef EBCDIC
+EXT unsigned char PL_freq[] = {/* EBCDIC frequencies for mixed English/C */
+ 1, 2, 84, 151, 154, 155, 156, 157,
+ 165, 246, 250, 3, 158, 7, 18, 29,
+ 40, 51, 62, 73, 85, 96, 107, 118,
+ 129, 140, 147, 148, 149, 150, 152, 153,
+ 255, 6, 8, 9, 10, 11, 12, 13,
+ 14, 15, 24, 25, 26, 27, 28, 226,
+ 29, 30, 31, 32, 33, 43, 44, 45,
+ 46, 47, 48, 49, 50, 76, 77, 78,
+ 79, 80, 81, 82, 83, 84, 85, 86,
+ 87, 94, 95, 234, 181, 233, 187, 190,
+ 180, 96, 97, 98, 99, 100, 101, 102,
+ 104, 112, 182, 174, 236, 232, 229, 103,
+ 228, 226, 114, 115, 116, 117, 118, 119,
+ 120, 121, 122, 235, 176, 230, 194, 162,
+ 130, 131, 132, 133, 134, 135, 136, 137,
+ 138, 139, 201, 205, 163, 217, 220, 224,
+ 5, 248, 227, 244, 242, 255, 241, 231,
+ 240, 253, 16, 197, 19, 20, 21, 187,
+ 23, 169, 210, 245, 237, 249, 247, 239,
+ 168, 252, 34, 196, 36, 37, 38, 39,
+ 41, 42, 251, 254, 238, 223, 221, 213,
+ 225, 177, 52, 53, 54, 55, 56, 57,
+ 58, 59, 60, 61, 63, 64, 65, 66,
+ 67, 68, 69, 70, 71, 72, 74, 75,
+ 205, 208, 186, 202, 200, 218, 198, 179,
+ 178, 214, 88, 89, 90, 91, 92, 93,
+ 217, 166, 170, 207, 199, 209, 206, 204,
+ 160, 212, 105, 106, 108, 109, 110, 111,
+ 203, 113, 216, 215, 192, 175, 193, 243,
+ 172, 161, 123, 124, 125, 126, 127, 128,
+ 222, 219, 211, 195, 188, 193, 185, 184,
+ 191, 183, 141, 142, 143, 144, 145, 146
+};
+#else /* ascii rather than ebcdic */
+EXTCONST unsigned char PL_freq[] = { /* letter frequencies for mixed English/C */
1, 2, 84, 151, 154, 155, 156, 157,
165, 246, 250, 3, 158, 7, 18, 29,
40, 51, 62, 73, 85, 96, 107, 118,
130, 131, 132, 133, 134, 135, 136, 137,
138, 139, 141, 142, 143, 144, 145, 146
};
+#endif
#else
-EXTCONST unsigned char freq[];
+EXTCONST unsigned char PL_freq[];
#endif
#ifdef DEBUGGING
#ifdef DOINIT
-EXTCONST char* block_type[] = {
+EXTCONST char* PL_block_type[] = {
"NULL",
"SUB",
"EVAL",
"BLOCK",
};
#else
-EXTCONST char* block_type[];
+EXTCONST char* PL_block_type[];
#endif
#endif
XTERMBLOCK
} expectation;
+enum { /* pass one of these to get_vtbl */
+ want_vtbl_sv,
+ want_vtbl_env,
+ want_vtbl_envelem,
+ want_vtbl_sig,
+ want_vtbl_sigelem,
+ want_vtbl_pack,
+ want_vtbl_packelem,
+ want_vtbl_dbline,
+ want_vtbl_isa,
+ want_vtbl_isaelem,
+ want_vtbl_arylen,
+ want_vtbl_glob,
+ want_vtbl_mglob,
+ want_vtbl_nkeys,
+ want_vtbl_taint,
+ want_vtbl_substr,
+ want_vtbl_vec,
+ want_vtbl_pos,
+ want_vtbl_bm,
+ want_vtbl_fm,
+ want_vtbl_uvar,
+ want_vtbl_defelem,
+ want_vtbl_regexp,
+ want_vtbl_collxfrm,
+ want_vtbl_amagic,
+ want_vtbl_amagicelem,
+#ifdef USE_THREADS
+ want_vtbl_mutex,
+#endif
+ want_vtbl_regdata,
+ want_vtbl_regdatum,
+ want_vtbl_backref
+};
/* Note: the lowest 8 bits are reserved for
stuffing into op->op_private */
#define HINT_INTEGER 0x00000001
#define HINT_STRICT_REFS 0x00000002
+/* #define HINT_notused4 0x00000004 */
+#define HINT_UTF8 0x00000008
+/* #define HINT_notused10 0x00000010 */
+ /* Note: 20,40,80 used for NATIVE_HINTS */
#define HINT_BLOCK_SCOPE 0x00000100
#define HINT_STRICT_SUBS 0x00000200
#define HINT_STRICT_VARS 0x00000400
#define HINT_LOCALE 0x00000800
+#define HINT_NEW_INTEGER 0x00001000
+#define HINT_NEW_FLOAT 0x00002000
+#define HINT_NEW_BINARY 0x00004000
+#define HINT_NEW_STRING 0x00008000
+#define HINT_NEW_RE 0x00010000
+#define HINT_LOCALIZE_HH 0x00020000 /* %^H needs to be copied */
+
+#define HINT_RE_TAINT 0x00100000
+#define HINT_RE_EVAL 0x00200000
+
+#define HINT_FILETEST_ACCESS 0x00400000
+
/* 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 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) _((char* exp, char* xend, PMOP* pm));
+typedef I32 (*regexec_t) _((regexp* prog, char* stringarg, char* strend, char*
+ strbeg, I32 minend, SV* screamer, void* data,
+ U32 flags));
+
+#endif
+
/* Set up PERLVAR macros for populating structs */
#define PERLVAR(var,type) type var;
#define PERLVARI(var,type,init) type var;
#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 EXT
#define EXT
#undef EXTCONST
};
#ifdef PERL_CORE
-EXT struct perl_vars Perl_Vars;
-EXT struct perl_vars *Perl_VarsPtr INIT(&Perl_Vars);
-#else
-#if !defined(__GNUC__) || !defined(WIN32)
+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))
EXT
-#endif
-struct perl_vars *Perl_VarsPtr;
-#define Perl_Vars (*((Perl_VarsPtr) ? Perl_VarsPtr : (Perl_VarsPtr = Perl_GetVars())))
-#endif
+#endif /* WIN32 */
+struct perl_vars *PL_VarsPtr;
+#define PL_Vars (*((PL_VarsPtr) ? PL_VarsPtr : (PL_VarsPtr = Perl_GetVars())))
+#endif /* PERL_CORE */
#endif /* PERL_GLOBAL_STRUCT */
#ifdef MULTIPLICITY
*/
struct interpreter {
-#ifndef USE_THREADS
#include "thrdvar.h"
-#endif
#include "intrpvar.h"
};
#include "pp.h"
#include "proto.h"
-#ifdef EMBED
-#define Perl_sv_setptrobj(rv,ptr,name) Perl_sv_setref_iv(rv,name,(IV)ptr)
-#define Perl_sv_setptrref(rv,ptr) Perl_sv_setref_iv(rv,Nullch,(IV)ptr)
-#else
-#define sv_setptrobj(rv,ptr,name) sv_setref_iv(rv,name,(IV)ptr)
-#define sv_setptrref(rv,ptr) sv_setref_iv(rv,Nullch,(IV)ptr)
-#endif
-
/* The following must follow proto.h as #defines mess up syntax */
-#include "embedvar.h"
+#if !defined(PERL_FOR_X2P)
+# include "embedvar.h"
+#endif
/* Now include all the 'global' variables
* If we don't have threads or multiple interpreters
* these include variables that would have been their struct-s
*/
-
-#define PERLVAR(var,type) EXT type var;
-#define PERLVARI(var,type,init) EXT type var INIT(init);
-#define PERLVARIC(var,type,init) EXTCONST type var INIT(init);
+
+#define PERLVAR(var,type) EXT type PL_##var;
+#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"
#ifndef MULTIPLICITY
-#ifndef USE_THREADS
-#include "thrdvar.h"
-#endif
+# include "intrpvar.h"
+# ifndef USE_THREADS
+# include "thrdvar.h"
+# endif
-#include "intrpvar.h"
#endif
#ifdef PERL_OBJECT
+/*
+ * The following is a buffer where new variables must
+ * be defined to maintain binary compatibility with PERL_OBJECT
+ * for 5.005
+ */
+PERLVAR(object_compatibility[30], char)
};
-#include "objpp.h"
-#ifdef DOINIT
-#include "INTERN.h"
-#else
-#include "EXTERN.h"
-#endif
-#endif /* PERL_OBJECT */
+# include "embed.h"
+# if defined(WIN32) && !defined(WIN32IO_IS_STDIO)
+# define errno CPerlObj::ErrorNo()
+# endif
+# ifdef DOINIT
+# include "INTERN.h"
+# else
+# include "EXTERN.h"
+# endif
+
+/* this has structure inits, so it cannot be included before here */
+# include "opcode.h"
+
+#endif /* PERL_OBJECT */
#undef PERLVAR
#undef PERLVARI
#undef PERLVARIC
-#if defined(HASATTRIBUTE) && defined(WIN32)
+#if defined(HASATTRIBUTE) && defined(WIN32) && !defined(CYGWIN32)
/*
* This provides a layer of functions and macros to ensure extensions will
* get to use the same RTL functions as the core.
#ifdef DOINIT
-EXT MGVTBL vtbl_sv = {magic_get,
+EXT MGVTBL PL_vtbl_sv = {magic_get,
magic_set,
magic_len,
0, 0};
-EXT MGVTBL vtbl_env = {0, magic_set_all_env,
+EXT MGVTBL PL_vtbl_env = {0, magic_set_all_env,
0, magic_clear_all_env,
0};
-EXT MGVTBL vtbl_envelem = {0, magic_setenv,
+EXT MGVTBL PL_vtbl_envelem = {0, magic_setenv,
0, magic_clearenv,
0};
-EXT MGVTBL vtbl_sig = {0, 0, 0, 0, 0};
-EXT MGVTBL vtbl_sigelem = {magic_getsig,
+EXT MGVTBL PL_vtbl_sig = {0, 0, 0, 0, 0};
+EXT MGVTBL PL_vtbl_sigelem = {magic_getsig,
magic_setsig,
0, magic_clearsig,
0};
-EXT MGVTBL vtbl_pack = {0, 0, magic_sizepack, magic_wipepack,
+EXT MGVTBL PL_vtbl_pack = {0, 0, magic_sizepack, magic_wipepack,
0};
-EXT MGVTBL vtbl_packelem = {magic_getpack,
+EXT MGVTBL PL_vtbl_packelem = {magic_getpack,
magic_setpack,
0, magic_clearpack,
0};
-EXT MGVTBL vtbl_dbline = {0, magic_setdbline,
+EXT MGVTBL PL_vtbl_dbline = {0, magic_setdbline,
0, 0, 0};
-EXT MGVTBL vtbl_isa = {0, magic_setisa,
+EXT MGVTBL PL_vtbl_isa = {0, magic_setisa,
0, magic_setisa,
0};
-EXT MGVTBL vtbl_isaelem = {0, magic_setisa,
+EXT MGVTBL PL_vtbl_isaelem = {0, magic_setisa,
0, 0, 0};
-EXT MGVTBL vtbl_arylen = {magic_getarylen,
+EXT MGVTBL PL_vtbl_arylen = {magic_getarylen,
magic_setarylen,
0, 0, 0};
-EXT MGVTBL vtbl_glob = {magic_getglob,
+EXT MGVTBL PL_vtbl_glob = {magic_getglob,
magic_setglob,
0, 0, 0};
-EXT MGVTBL vtbl_mglob = {0, magic_setmglob,
+EXT MGVTBL PL_vtbl_mglob = {0, magic_setmglob,
0, 0, 0};
-EXT MGVTBL vtbl_nkeys = {magic_getnkeys,
+EXT MGVTBL PL_vtbl_nkeys = {magic_getnkeys,
magic_setnkeys,
0, 0, 0};
-EXT MGVTBL vtbl_taint = {magic_gettaint,magic_settaint,
+EXT MGVTBL PL_vtbl_taint = {magic_gettaint,magic_settaint,
0, 0, 0};
-EXT MGVTBL vtbl_substr = {magic_getsubstr, magic_setsubstr,
+EXT MGVTBL PL_vtbl_substr = {magic_getsubstr, magic_setsubstr,
0, 0, 0};
-EXT MGVTBL vtbl_vec = {magic_getvec,
+EXT MGVTBL PL_vtbl_vec = {magic_getvec,
magic_setvec,
0, 0, 0};
-EXT MGVTBL vtbl_pos = {magic_getpos,
+EXT MGVTBL PL_vtbl_pos = {magic_getpos,
magic_setpos,
0, 0, 0};
-EXT MGVTBL vtbl_bm = {0, magic_setbm,
+EXT MGVTBL PL_vtbl_bm = {0, magic_setbm,
0, 0, 0};
-EXT MGVTBL vtbl_fm = {0, magic_setfm,
+EXT MGVTBL PL_vtbl_fm = {0, magic_setfm,
0, 0, 0};
-EXT MGVTBL vtbl_uvar = {magic_getuvar,
+EXT MGVTBL PL_vtbl_uvar = {magic_getuvar,
magic_setuvar,
0, 0, 0};
#ifdef USE_THREADS
-EXT MGVTBL vtbl_mutex = {0, 0, 0, 0, magic_mutexfree};
+EXT MGVTBL PL_vtbl_mutex = {0, 0, 0, 0, magic_mutexfree};
#endif /* USE_THREADS */
-EXT MGVTBL vtbl_defelem = {magic_getdefelem,magic_setdefelem,
- 0, 0, magic_freedefelem};
+EXT MGVTBL PL_vtbl_defelem = {magic_getdefelem,magic_setdefelem,
+ 0, 0, 0};
-EXT MGVTBL vtbl_regexp = {0,0,0,0, magic_freeregexp};
+EXT MGVTBL PL_vtbl_regexp = {0,0,0,0, magic_freeregexp};
+EXT MGVTBL PL_vtbl_regdata = {0, 0, magic_regdata_cnt, 0, 0};
+EXT MGVTBL PL_vtbl_regdatum = {magic_regdatum_get, 0, 0, 0, 0};
#ifdef USE_LOCALE_COLLATE
-EXT MGVTBL vtbl_collxfrm = {0,
+EXT MGVTBL PL_vtbl_collxfrm = {0,
magic_setcollxfrm,
0, 0, 0};
#endif
-#ifdef OVERLOAD
-EXT MGVTBL vtbl_amagic = {0, magic_setamagic,
+EXT MGVTBL PL_vtbl_amagic = {0, magic_setamagic,
0, 0, magic_setamagic};
-EXT MGVTBL vtbl_amagicelem = {0, magic_setamagic,
+EXT MGVTBL PL_vtbl_amagicelem = {0, magic_setamagic,
0, 0, magic_setamagic};
-#endif /* OVERLOAD */
+
+EXT MGVTBL PL_vtbl_backref = {0, 0,
+ 0, 0, magic_killbackrefs};
#else /* !DOINIT */
-EXT MGVTBL vtbl_sv;
-EXT MGVTBL vtbl_env;
-EXT MGVTBL vtbl_envelem;
-EXT MGVTBL vtbl_sig;
-EXT MGVTBL vtbl_sigelem;
-EXT MGVTBL vtbl_pack;
-EXT MGVTBL vtbl_packelem;
-EXT MGVTBL vtbl_dbline;
-EXT MGVTBL vtbl_isa;
-EXT MGVTBL vtbl_isaelem;
-EXT MGVTBL vtbl_arylen;
-EXT MGVTBL vtbl_glob;
-EXT MGVTBL vtbl_mglob;
-EXT MGVTBL vtbl_nkeys;
-EXT MGVTBL vtbl_taint;
-EXT MGVTBL vtbl_substr;
-EXT MGVTBL vtbl_vec;
-EXT MGVTBL vtbl_pos;
-EXT MGVTBL vtbl_bm;
-EXT MGVTBL vtbl_fm;
-EXT MGVTBL vtbl_uvar;
+EXT MGVTBL PL_vtbl_sv;
+EXT MGVTBL PL_vtbl_env;
+EXT MGVTBL PL_vtbl_envelem;
+EXT MGVTBL PL_vtbl_sig;
+EXT MGVTBL PL_vtbl_sigelem;
+EXT MGVTBL PL_vtbl_pack;
+EXT MGVTBL PL_vtbl_packelem;
+EXT MGVTBL PL_vtbl_dbline;
+EXT MGVTBL PL_vtbl_isa;
+EXT MGVTBL PL_vtbl_isaelem;
+EXT MGVTBL PL_vtbl_arylen;
+EXT MGVTBL PL_vtbl_glob;
+EXT MGVTBL PL_vtbl_mglob;
+EXT MGVTBL PL_vtbl_nkeys;
+EXT MGVTBL PL_vtbl_taint;
+EXT MGVTBL PL_vtbl_substr;
+EXT MGVTBL PL_vtbl_vec;
+EXT MGVTBL PL_vtbl_pos;
+EXT MGVTBL PL_vtbl_bm;
+EXT MGVTBL PL_vtbl_fm;
+EXT MGVTBL PL_vtbl_uvar;
#ifdef USE_THREADS
-EXT MGVTBL vtbl_mutex;
+EXT MGVTBL PL_vtbl_mutex;
#endif /* USE_THREADS */
-EXT MGVTBL vtbl_defelem;
-EXT MGVTBL vtbl_regexp;
+EXT MGVTBL PL_vtbl_defelem;
+EXT MGVTBL PL_vtbl_regexp;
+EXT MGVTBL PL_vtbl_regdata;
+EXT MGVTBL PL_vtbl_regdatum;
#ifdef USE_LOCALE_COLLATE
-EXT MGVTBL vtbl_collxfrm;
+EXT MGVTBL PL_vtbl_collxfrm;
#endif
-#ifdef OVERLOAD
-EXT MGVTBL vtbl_amagic;
-EXT MGVTBL vtbl_amagicelem;
-#endif /* OVERLOAD */
+EXT MGVTBL PL_vtbl_amagic;
+EXT MGVTBL PL_vtbl_amagicelem;
+
+EXT MGVTBL PL_vtbl_backref;
#endif /* !DOINIT */
-#ifdef OVERLOAD
+enum {
+ fallback_amg, abs_amg,
+ bool__amg, nomethod_amg,
+ string_amg, numer_amg,
+ add_amg, add_ass_amg,
+ subtr_amg, subtr_ass_amg,
+ mult_amg, mult_ass_amg,
+ div_amg, div_ass_amg,
+ modulo_amg, modulo_ass_amg,
+ pow_amg, pow_ass_amg,
+ lshift_amg, lshift_ass_amg,
+ rshift_amg, rshift_ass_amg,
+ band_amg, band_ass_amg,
+ bor_amg, bor_ass_amg,
+ bxor_amg, bxor_ass_amg,
+ lt_amg, le_amg,
+ gt_amg, ge_amg,
+ eq_amg, ne_amg,
+ ncmp_amg, scmp_amg,
+ slt_amg, sle_amg,
+ sgt_amg, sge_amg,
+ seq_amg, sne_amg,
+ not_amg, compl_amg,
+ inc_amg, dec_amg,
+ atan2_amg, cos_amg,
+ sin_amg, exp_amg,
+ log_amg, sqrt_amg,
+ repeat_amg, repeat_ass_amg,
+ concat_amg, concat_ass_amg,
+ copy_amg, neg_amg,
+ to_sv_amg, to_av_amg,
+ to_hv_amg, to_gv_amg,
+ to_cv_amg, iter_amg,
+ max_amg_code
+ /* Do not leave a trailing comma here. C9X allows it, C89 doesn't. */
+};
+
+#define NofAMmeth max_amg_code
-#define NofAMmeth 58
#ifdef DOINIT
-EXTCONST char * AMG_names[NofAMmeth] = {
+EXTCONST char * PL_AMG_names[NofAMmeth] = {
"fallback", "abs", /* "fallback" should be the first. */
"bool", "nomethod",
"\"\"", "0+",
"log", "sqrt",
"x", "x=",
".", ".=",
- "=", "neg"
+ "=", "neg",
+ "${}", "@{}",
+ "%{}", "*{}",
+ "&{}", "<>",
};
#else
-EXTCONST char * AMG_names[NofAMmeth];
+EXTCONST char * PL_AMG_names[NofAMmeth];
#endif /* def INITAMAGIC */
struct am_table {
#define AMT_AMAGIC_on(amt) ((amt)->flags |= AMTf_AMAGIC)
#define AMT_AMAGIC_off(amt) ((amt)->flags &= ~AMTf_AMAGIC)
-enum {
- fallback_amg, abs_amg,
- bool__amg, nomethod_amg,
- string_amg, numer_amg,
- add_amg, add_ass_amg,
- subtr_amg, subtr_ass_amg,
- mult_amg, mult_ass_amg,
- div_amg, div_ass_amg,
- modulo_amg, modulo_ass_amg,
- pow_amg, pow_ass_amg,
- lshift_amg, lshift_ass_amg,
- rshift_amg, rshift_ass_amg,
- band_amg, band_ass_amg,
- bor_amg, bor_ass_amg,
- bxor_amg, bxor_ass_amg,
- lt_amg, le_amg,
- gt_amg, ge_amg,
- eq_amg, ne_amg,
- ncmp_amg, scmp_amg,
- slt_amg, sle_amg,
- sgt_amg, sge_amg,
- seq_amg, sne_amg,
- not_amg, compl_amg,
- inc_amg, dec_amg,
- atan2_amg, cos_amg,
- sin_amg, exp_amg,
- log_amg, sqrt_amg,
- repeat_amg, repeat_ass_amg,
- concat_amg, concat_ass_amg,
- copy_amg, neg_amg
-};
/*
* some compilers like to redefine cos et alia as faster
# endif
#endif /* _FASTMATH */
-#endif /* OVERLOAD */
-
#define PERLDB_ALL 0x3f /* No _NONAME, _GOTO */
#define PERLDBf_SUB 0x01 /* Debug sub enter/exit. */
#define PERLDBf_LINE 0x02 /* Keep line #. */
#define PERLDBf_NONAME 0x40 /* For _SUB: no name of the subr. */
#define PERLDBf_GOTO 0x80 /* Report goto: call DB::goto. */
-#define PERLDB_SUB (perldb && (perldb & PERLDBf_SUB))
-#define PERLDB_LINE (perldb && (perldb & PERLDBf_LINE))
-#define PERLDB_NOOPT (perldb && (perldb & PERLDBf_NOOPT))
-#define PERLDB_INTER (perldb && (perldb & PERLDBf_INTER))
-#define PERLDB_SUBLINE (perldb && (perldb & PERLDBf_SUBLINE))
-#define PERLDB_SINGLE (perldb && (perldb & PERLDBf_SINGLE))
-#define PERLDB_SUB_NN (perldb && (perldb & (PERLDBf_NONAME)))
-#define PERLDB_GOTO (perldb && (perldb & PERLDBf_GOTO))
+#define PERLDB_SUB (PL_perldb && (PL_perldb & PERLDBf_SUB))
+#define PERLDB_LINE (PL_perldb && (PL_perldb & PERLDBf_LINE))
+#define PERLDB_NOOPT (PL_perldb && (PL_perldb & PERLDBf_NOOPT))
+#define PERLDB_INTER (PL_perldb && (PL_perldb & PERLDBf_INTER))
+#define PERLDB_SUBLINE (PL_perldb && (PL_perldb & PERLDBf_SUBLINE))
+#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))
#ifdef USE_LOCALE_NUMERIC
#define SET_NUMERIC_STANDARD() \
STMT_START { \
- if (! numeric_standard) \
+ if (! PL_numeric_standard) \
perl_set_numeric_standard(); \
} STMT_END
#define SET_NUMERIC_LOCAL() \
STMT_START { \
- if (! numeric_local) \
+ if (! PL_numeric_local) \
perl_set_numeric_local(); \
} STMT_END
*/
#define offer_nice_chunk(chunk, chunk_size) do { \
LOCK_SV_MUTEX; \
- if (!nice_chunk) { \
- nice_chunk = (char*)(chunk); \
- nice_chunk_size = (chunk_size); \
+ if (!PL_nice_chunk) { \
+ PL_nice_chunk = (char*)(chunk); \
+ PL_nice_chunk_size = (chunk_size); \
} \
else { \
Safefree(chunk); \
# define Semctl(id, num, cmd, semun) semctl(id, num, cmd, semun.buf)
# endif
# endif
-# ifndef Semctl /* Place our bets on the semun horse. */
-# define Semctl(id, num, cmd, semun) semctl(id, num, cmd, semun)
-# endif
#endif
+/* Mention
+
+ INSTALL_USR_BIN_PERL
+
+ I_SYS_MMAN
+ HAS_MMAP
+ HAS_MUNMAP
+ HAS_MPROTECT
+ HAS_MSYNC
+ HAS_MADVISE
+ Mmap_t
+
+ here so that Configure picks them up. */
+
+#ifdef IAMSUID
+
+#ifdef I_SYS_STATVFS
+# include <sys/statvfs.h> /* for f?statvfs() */
+#endif
+#ifdef I_SYS_MOUNT
+# include <sys/mount.h> /* for *BSD f?statfs() */
+#endif
+#ifdef I_MNTENT
+# include <mntent.h> /* for getmntent() */
+#endif
+
+#endif /* IAMSUID */
+
+/* and finally... */
+#define PERL_PATCHLEVEL_H_IMPLICIT
+#include "patchlevel.h"
+#undef PERL_PATCHLEVEL_H_IMPLICIT
+
#endif /* Include guard */