/* perl.h
*
- * Copyright (c) 1987-2002, Larry Wall
+ * Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999,
+ * 2000, 2001, 2002, 2003, by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
/* Use the reentrant APIs like localtime_r and getpwent_r */
/* Win32 has naturally threadsafe libraries, no need to use any _r variants. */
-#if defined(USE_ITHREADS) && !defined(USE_REENTRANT_API) && !defined(NETWARE) && !defined(WIN32) && !defined(__APPLE__)
+#if defined(USE_ITHREADS) && !defined(USE_REENTRANT_API) && !defined(NETWARE) && !defined(WIN32) && !defined(DARWIN)
# define USE_REENTRANT_API
#endif
/* <--- here ends the logic shared by perl.h and makedef.pl */
+/*
+ * DARWIN for MacOSX (__APPLE__ exists but is not officially sanctioned)
+ * (The -DDARWIN comes from the hints/darwin.sh.)
+ * __bsdi__ for BSD/OS
+ */
+#if defined(__FreeBSD__) || defined(__NetBSD__) || defined(__OpenBSD__) || defined(DARWIN) || defined(__bsdi__) || defined(BSD41) || defined(BSD42) || defined(BSD43) || defined(BSD44)
+# ifndef BSDish
+# define BSDish
+# endif
+#endif
+
#ifdef PERL_IMPLICIT_CONTEXT
# ifndef MULTIPLICITY
# define MULTIPLICITY
# else
# define EMBEDMYMALLOC /* for compatibility */
# endif
-START_EXTERN_C
-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);
-/* '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);
-END_EXTERN_C
-
-typedef struct perl_mstats perl_mstats_t;
# define safemalloc Perl_malloc
# define safecalloc Perl_calloc
# define saferealloc Perl_realloc
# define safefree Perl_mfree
+# define CHECK_MALLOC_TOO_LATE_FOR_(code) STMT_START { \
+ if (!PL_tainting && MallocCfg_ptr[MallocCfg_cfg_env_read]) \
+ code; \
+ } STMT_END
+# define CHECK_MALLOC_TOO_LATE_FOR(ch) \
+ CHECK_MALLOC_TOO_LATE_FOR_(MALLOC_TOO_LATE_FOR(ch))
+# define panic_write2(s) write(2, s, strlen(s))
+# define CHECK_MALLOC_TAINT(newval) \
+ CHECK_MALLOC_TOO_LATE_FOR_( \
+ if (newval) { \
+ panic_write2("panic: tainting with $ENV{PERL_MALLOC_OPT}\n");\
+ exit(1); })
+# define MALLOC_CHECK_TAINT(argc,argv,env) STMT_START { \
+ if (doing_taint(argc,argv,env)) { \
+ MallocCfg_ptr[MallocCfg_skip_cfg_env] = 1; \
+ }} STMT_END;
#else /* MYMALLOC */
# define safemalloc safesysmalloc
# define safecalloc safesyscalloc
# define saferealloc safesysrealloc
# define safefree safesysfree
+# define CHECK_MALLOC_TOO_LATE_FOR(ch) ((void)0)
+# define CHECK_MALLOC_TAINT(newval) ((void)0)
+# define MALLOC_CHECK_TAINT(argc,argv,env)
#endif /* MYMALLOC */
+#define TOO_LATE_FOR_(ch,s) Perl_croak(aTHX_ "Too late for \"-%c\" option%s", (char)(ch), s)
+#define TOO_LATE_FOR(ch) TOO_LATE_FOR_(ch, "")
+#define MALLOC_TOO_LATE_FOR(ch) TOO_LATE_FOR_(ch, " with $ENV{PERL_MALLOC_OPT}")
+#define MALLOC_CHECK_TAINT2(argc,argv) MALLOC_CHECK_TAINT(argc,argv,NULL)
+
#if !defined(HAS_STRCHR) && defined(HAS_INDEX) && !defined(strchr)
#define strchr index
#define strrchr rindex
# define WIN32SCK_IS_STDSCK /* don't pull in custom wsock layer */
#endif
-/* In Tru64 use the 4.4BSD struct msghdr, not the 4.3 one */
-#if defined(__osf__) && defined(__alpha) && !defined(_SOCKADDR_LEN)
-# define _SOCKADDR_LEN
+/* In Tru64 use the 4.4BSD struct msghdr, not the 4.3 one.
+ * This is important for using IPv6.
+ * For OSF/1 3.2, however, defining _SOCKADDR_LEN would be
+ * a bad idea since it breaks send() and recv(). */
+#if defined(__osf__) && defined(__alpha) && !defined(_SOCKADDR_LEN) && !defined(DEC_OSF1_3_X)
+# define _SOCKADDR_LEN
#endif
#if defined(HAS_SOCKET) && !defined(VMS) && !defined(WIN32) /* VMS/WIN32 handle sockets via vmsish.h/win32.h */
long double modfl(long double, long double *);
# endif
# else
-# define Perl_modf(x,y) ((long double)modf((double)(x),(double*)(y)))
+# if defined(HAS_AINTL) && defined(HAS_COPYSIGNL)
+ extern long double Perl_my_modfl(long double x, long double *ip);
+# define Perl_modf(x,y) Perl_my_modfl(x,y)
+# endif
# endif
# ifdef HAS_FREXPL
# define Perl_frexp(x,y) frexpl(x,y)
# else
-# define Perl_frexp(x,y) ((long double)frexp((double)(x),y))
+# if defined(HAS_ILOGBL) && defined(HAS_SCALBNL)
+ extern long double Perl_my_frexpl(long double x, int *e);
+# define Perl_frexp(x,y) Perl_my_frexpl(x,y)
+# endif
# endif
# ifndef Perl_isnan
# ifdef HAS_ISNANL
#endif
-struct perl_mstats {
- UV *nfree;
- UV *ntotal;
- IV topbucket, topbucket_ev, topbucket_odd, totfree, total, total_chain;
- IV total_sbrk, sbrks, sbrk_good, sbrk_slack, start_slack, sbrked_remains;
- IV minbucket;
- /* Level 1 info */
- UV *bucket_mem_size;
- UV *bucket_available_size;
- UV nbuckets;
-};
+#ifdef MYMALLOC
+# include "malloc_ctl.h"
+#endif
+
struct RExC_state_t;
typedef MEM_SIZE STRLEN;
# define PERL_FPU_INIT fpsetmask(0);
# else
# if defined(SIGFPE) && defined(SIG_IGN)
-# define PERL_FPU_INIT signal(SIGFPE, SIG_IGN);
+# define PERL_FPU_INIT PL_sigfpe_saved = signal(SIGFPE, SIG_IGN);
+# define PERL_FPU_PRE_EXEC { Sigsave_t xfpe; rsignal_save(SIGFPE, PL_sigfpe_saved, &xfpe);
+# define PERL_FPU_POST_EXEC rsignal_restore(SIGFPE, &xfpe); }
# else
# define PERL_FPU_INIT
# endif
# endif
#endif
+#ifndef PERL_FPU_PRE_EXEC
+# define PERL_FPU_PRE_EXEC {
+# define PERL_FPU_POST_EXEC }
+#endif
#ifndef PERL_SYS_INIT3
# define PERL_SYS_INIT3(argvp,argcp,envp) PERL_SYS_INIT(argvp,argcp)
#ifndef SVf
# ifdef CHECK_FORMAT
# define SVf "p"
+# ifndef SVf256
+# define SVf256 SVf
+# endif
# else
# define SVf "_"
# endif
#endif
+#ifndef SVf256
+# define SVf256 ".256"SVf
+#endif
+
#ifndef UVf
# ifdef CHECK_FORMAT
# define UVf UVuf
# endif
#endif
+#ifndef __attribute__format__
+# ifdef CHECK_FORMAT
+# define __attribute__format__(x,y,z) __attribute__((__format__(x,y,z)))
+# else
+# define __attribute__format__(x,y,z)
+# 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 compiler. Sigh.
* that a file is in "binary" mode -- that is, that no translation
* of bytes occurs on read or write operations.
*/
-# define USEMYBINMODE / **/
+# define USEMYBINMODE /**/
+# include <io.h> /* for setmode() prototype */
# define my_binmode(fp, iotype, mode) \
- (PerlLIO_setmode(PerlIO_fileno(fp), mode) != -1 ? TRUE : FALSE)
+ (PerlLIO_setmode(fileno(fp), mode) != -1 ? TRUE : FALSE)
+#endif
+
+#ifdef __CYGWIN__
+void init_os_extras(void);
#endif
#ifdef UNION_ANY_DEFINITION
I32 any_i32;
IV any_iv;
long any_long;
+ bool any_bool;
void (*any_dptr) (void*);
void (*any_dxptr) (pTHX_ void*);
};
#if !defined(OS2) && !defined(MACOS_TRADITIONAL)
# include "iperlsys.h"
#endif
+
+/* [perl #22371] Algorimic Complexity Attack on Perl 5.6.1, 5.8.0.
+ * Note that the USE_HASH_SEED and USE_HASH_SEED_EXPLICIT are *NOT*
+ * defined by Configure, despite their names being similar to the
+ * other defines like USE_ITHREADS. Configure in fact knows nothing
+ * about the randomised hashes. Therefore to enable/disable the hash
+ * randomisation defines use the Configure -Accflags=... instead. */
+#if !defined(NO_HASH_SEED) && !defined(USE_HASH_SEED) && !defined(USE_HASH_SEED_EXPLICIT)
+# define USE_HASH_SEED
+#endif
+
#include "regexp.h"
#include "sv.h"
#include "util.h"
#endif /* DEBUGGING */
+#define DEBUG_SCOPE(where) \
+ DEBUG_l(WITH_THR(Perl_deb(aTHX_ "%s scope %ld at %s:%d\n", \
+ where, PL_scopestack_ix, __FILE__, __LINE__)));
+
+
+
+
/* These constants should be used in preference to raw characters
* when using magic. Note that some perl guts still assume
* certain character properties of these constants, namely that
#define PERL_MAGIC_uvar_elem 'u' /* Reserved for use by extensions */
#define PERL_MAGIC_vec 'v' /* vec() lvalue */
#define PERL_MAGIC_vstring 'V' /* SV was vstring literal */
+#define PERL_MAGIC_utf8 'w' /* Cached UTF-8 information */
#define PERL_MAGIC_substr 'x' /* substr() lvalue */
#define PERL_MAGIC_defelem 'y' /* Shadow "foreach" iterator variable /
smart parameter vivification */
/* NeXT has problems with crt0.o globals */
#if defined(__DYNAMIC__) && \
- (defined(NeXT) || defined(__NeXT__) || defined(__APPLE__))
+ (defined(NeXT) || defined(__NeXT__) || defined(DARWIN))
# if defined(NeXT) || defined(__NeXT)
# include <mach-o/dyld.h>
# define environ (*environ_pointer)
EXT char *** environ_pointer;
# else
-# if defined(__APPLE__) && defined(PERL_CORE)
+# if defined(DARWIN) && defined(PERL_CORE)
# include <crt_externs.h> /* for the env array */
# define environ (*_NSGetEnviron())
# endif
INIT("The %s function is unimplemented");
EXTCONST char PL_no_myglob[]
INIT("\"my\" variable %s can't be in a package");
+EXTCONST char PL_no_localize_ref[]
+ INIT("Can't localize through a reference");
EXTCONST char PL_uuemap[65]
INIT("`!\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_");
XATTRTERM,
XTERMBLOCK,
XTERMORDORDOR /* evil hack */
+ /* update exp_name[] in toke.c if adding to this enum */
} expectation;
enum { /* pass one of these to get_vtbl */
want_vtbl_amagicelem,
want_vtbl_regdata,
want_vtbl_regdatum,
- want_vtbl_backref
+ want_vtbl_backref,
+ want_vtbl_utf8
};
/* Note: the lowest 8 bits are reserved for
#define HINT_FILETEST_ACCESS 0x00400000 /* filetest pragma */
#define HINT_UTF8 0x00800000 /* utf8 pragma */
+/* assertions pragma */
+#define HINT_ASSERTING 0x01000000
+#define HINT_ASSERTIONSSEEN 0x02000000
+
/* The following are stored in $sort::hints, not in PL_hints */
#define HINT_SORT_SORT_BITS 0x000000FF /* allow 256 different ones */
#define HINT_SORT_QUICKSORT 0x00000001
#undef PERLVARI
#undef PERLVARIC
+/* Types used by pack/unpack */
+typedef enum {
+ e_no_len, /* no length */
+ e_number, /* number, [] */
+ e_star /* asterisk */
+} howlen_t;
+
+typedef struct {
+ char* patptr; /* current template char */
+ char* patend; /* one after last char */
+ char* grpbeg; /* 1st char of ()-group */
+ char* grpend; /* end of ()-group */
+ I32 code; /* template code (!) */
+ I32 length; /* length/repeat count */
+ howlen_t howlen; /* how length is given */
+ int level; /* () nesting level */
+ U32 flags; /* /=4, comma=2, pack=1 */
+} tempsym_t;
+
#include "thread.h"
#include "pp.h"
MEMBER_TO_FPTR(Perl_magic_setdefelem),
0, 0, 0};
-EXT MGVTBL PL_vtbl_regexp = {0,0,0,0, MEMBER_TO_FPTR(Perl_magic_freeregexp)};
+EXT MGVTBL PL_vtbl_regexp = {0, MEMBER_TO_FPTR(Perl_magic_setregexp),0,0, MEMBER_TO_FPTR(Perl_magic_freeregexp)};
EXT MGVTBL PL_vtbl_regdata = {0, 0, MEMBER_TO_FPTR(Perl_magic_regdata_cnt), 0, 0};
EXT MGVTBL PL_vtbl_regdatum = {MEMBER_TO_FPTR(Perl_magic_regdatum_get),
MEMBER_TO_FPTR(Perl_magic_regdatum_set), 0, 0, 0};
EXT MGVTBL PL_vtbl_ovrld = {0, 0,
0, 0, MEMBER_TO_FPTR(Perl_magic_freeovrld)};
+EXT MGVTBL PL_vtbl_utf8 = {0,
+ MEMBER_TO_FPTR(Perl_magic_setutf8),
+ 0, 0, 0};
+
#else /* !DOINIT */
EXT MGVTBL PL_vtbl_sv;
EXT MGVTBL PL_vtbl_amagicelem;
EXT MGVTBL PL_vtbl_backref;
+EXT MGVTBL PL_vtbl_utf8;
#endif /* !DOINIT */
#define PERLDB_ALL (PERLDBf_SUB | PERLDBf_LINE | \
PERLDBf_NOOPT | PERLDBf_INTER | \
PERLDBf_SUBLINE| PERLDBf_SINGLE| \
- PERLDBf_NAMEEVAL| PERLDBf_NAMEANON)
- /* No _NONAME, _GOTO */
+ PERLDBf_NAMEEVAL| PERLDBf_NAMEANON )
+ /* No _NONAME, _GOTO, _ASSERTION */
#define PERLDBf_SUB 0x01 /* Debug sub enter/exit */
#define PERLDBf_LINE 0x02 /* Keep line # */
#define PERLDBf_NOOPT 0x04 /* Switch off optimizations */
#define PERLDBf_GOTO 0x80 /* Report goto: call DB::goto */
#define PERLDBf_NAMEEVAL 0x100 /* Informative names for evals */
#define PERLDBf_NAMEANON 0x200 /* Informative names for anon subs */
+#define PERLDBf_ASSERTION 0x400 /* Debug assertion subs enter/exit */
#define PERLDB_SUB (PL_perldb && (PL_perldb & PERLDBf_SUB))
#define PERLDB_LINE (PL_perldb && (PL_perldb & PERLDBf_LINE))
#define PERLDB_GOTO (PL_perldb && (PL_perldb & PERLDBf_GOTO))
#define PERLDB_NAMEEVAL (PL_perldb && (PL_perldb & PERLDBf_NAMEEVAL))
#define PERLDB_NAMEANON (PL_perldb && (PL_perldb & PERLDBf_NAMEANON))
-
+#define PERLDB_ASSERTION (PL_perldb && (PL_perldb & PERLDBf_ASSERTION))
#ifdef USE_LOCALE_NUMERIC
# define Atoul(s) Strtoul(s, (char **)NULL, 10)
#endif
-#if !defined(PERLIO_IS_STDIO)
-/*
- * Remap printf
- */
-#undef printf
-#if defined(__GNUC__) && !defined(__STRICT_ANSI__) && !defined(PERL_GCC_PEDANTIC)
-#define printf(fmt,args...) PerlIO_stdoutf(fmt,##args)
-#else
-#define printf PerlIO_stdoutf
-#endif
-#endif
/* if these never got defined, they need defaults */
#ifndef PERL_SET_CONTEXT
*/
#ifndef PERL_MICRO
-# ifndef PERL_OLD_SIGNALS
-# ifndef PERL_ASYNC_CHECK
-# define PERL_ASYNC_CHECK() if (PL_sig_pending) despatch_signals()
-# endif
-# endif
+# ifndef PERL_ASYNC_CHECK
+# define PERL_ASYNC_CHECK() if (PL_sig_pending) despatch_signals()
+# endif
#endif
#ifndef PERL_ASYNC_CHECK
#if O_TEXT != O_BINARY
/* If you have different O_TEXT and O_BINARY and you are a CLRF shop,
* that is, you are somehow DOSish. */
-# if defined(__BEOS__) || defined(__VOS__)
+# if defined(__BEOS__) || defined(__VOS__) || defined(__CYGWIN__)
/* BeOS has O_TEXT != O_BINARY but O_TEXT and O_BINARY have no effect;
* BeOS is always UNIXoid (LF), not DOSish (CRLF). */
/* VOS has O_TEXT != O_BINARY, and they have effect,
/* Input flags: */
#define PERL_SCAN_ALLOW_UNDERSCORES 0x01 /* grok_??? accept _ in numbers */
#define PERL_SCAN_DISALLOW_PREFIX 0x02 /* grok_??? reject 0x in hex etc */
+#define PERL_SCAN_SILENT_ILLDIGIT 0x04 /* grok_??? not warn about illegal digits */
/* Output flags: */
#define PERL_SCAN_GREATER_THAN_UV_MAX 0x02 /* should this merge with above? */
# define PIPESOCK_MODE
#endif
+#define PERL_MAGIC_UTF8_CACHESIZE 2
+
+#define PERL_UNICODE_STDIN_FLAG 0x0001
+#define PERL_UNICODE_STDOUT_FLAG 0x0002
+#define PERL_UNICODE_STDERR_FLAG 0x0004
+#define PERL_UNICODE_IN_FLAG 0x0008
+#define PERL_UNICODE_OUT_FLAG 0x0010
+#define PERL_UNICODE_ARGV_FLAG 0x0020
+#define PERL_UNICODE_LOCALE_FLAG 0x0040
+#define PERL_UNICODE_WIDESYSCALLS_FLAG 0x0080 /* for Sarathy */
+
+#define PERL_UNICODE_STD_FLAG \
+ (PERL_UNICODE_STDIN_FLAG | \
+ PERL_UNICODE_STDOUT_FLAG | \
+ PERL_UNICODE_STDERR_FLAG)
+
+#define PERL_UNICODE_INOUT_FLAG \
+ (PERL_UNICODE_IN_FLAG | \
+ PERL_UNICODE_OUT_FLAG)
+
+#define PERL_UNICODE_DEFAULT_FLAGS \
+ (PERL_UNICODE_STD_FLAG | \
+ PERL_UNICODE_INOUT_FLAG | \
+ PERL_UNICODE_LOCALE_FLAG)
+
+#define PERL_UNICODE_ALL_FLAGS 0x00ff
+
+#define PERL_UNICODE_STDIN 'I'
+#define PERL_UNICODE_STDOUT 'O'
+#define PERL_UNICODE_STDERR 'E'
+#define PERL_UNICODE_STD 'S'
+#define PERL_UNICODE_IN 'i'
+#define PERL_UNICODE_OUT 'o'
+#define PERL_UNICODE_INOUT 'D'
+#define PERL_UNICODE_ARGV 'A'
+#define PERL_UNICODE_LOCALE 'L'
+#define PERL_UNICODE_WIDESYSCALLS 'W'
+
+#define PERL_SIGNALS_UNSAFE_FLAG 0x0001
+
+/* From sigaction(2) (FreeBSD man page):
+ * | Signal routines normally execute with the signal that
+ * | caused their invocation blocked, but other signals may
+ * | yet occur.
+ * Emulation of this behavior (from within Perl) is enabled
+ * by defining PERL_BLOCK_SIGNALS.
+ */
+#define PERL_BLOCK_SIGNALS
+
+#if defined(HAS_SIGPROCMASK) && defined(PERL_BLOCK_SIGNALS)
+# define PERL_BLOCKSIG_ADD(set,sig) \
+ sigset_t set; sigemptyset(&(set)); sigaddset(&(set), sig)
+# define PERL_BLOCKSIG_BLOCK(set) \
+ sigprocmask(SIG_BLOCK, &(set), NULL)
+# define PERL_BLOCKSIG_UNBLOCK(set) \
+ sigprocmask(SIG_UNBLOCK, &(set), NULL)
+#endif /* HAS_SIGPROCMASK && PERL_BLOCK_SIGNALS */
+
+/* How about the old style of sigblock()? */
+
+#ifndef PERL_BLOCKSIG_ADD
+# define PERL_BLOCKSIG_ADD(set, sig) NOOP
+#endif
+#ifndef PERL_BLOCKSIG_BLOCK
+# define PERL_BLOCKSIG_BLOCK(set) NOOP
+#endif
+#ifndef PERL_BLOCKSIG_UNBLOCK
+# define PERL_BLOCKSIG_UNBLOCK(set) NOOP
+#endif
+
+/* Use instead of abs() since abs() forces its argument to be an int,
+ * but also beware since this evaluates its argument twice, so no x++. */
+#define PERL_ABS(x) ((x) < 0 ? -(x) : (x))
+
/* and finally... */
#define PERL_PATCHLEVEL_H_IMPLICIT
#include "patchlevel.h"
HAS_UALARM
HAS_USLEEP
- HAS_NANOSLEEP
HAS_SETITIMER
HAS_GETITIMER