#define H_PERL 1
#define OVERLOAD
+#ifdef PERL_FOR_X2P
+/*
+ * This file is being used for x2p stuff.
+ * Above symbol is defined via -D in 'x2p/Makefile.SH'
+ * Decouple x2p stuff from some of perls more extreme eccentricities.
+ */
+#undef MULTIPLICITY
+#undef EMBED
+#undef USE_STDIO
+#define USE_STDIO
+#endif /* PERL_FOR_X2P */
+
+/*
+ * STMT_START { statements; } STMT_END;
+ * can be used as a single statement, as in
+ * if (x) STMT_START { ... } STMT_END; else ...
+ *
+ * Trying to select a version that gives no warnings...
+ */
+#if !(defined(STMT_START) && defined(STMT_END))
+# if defined(__GNUC__) && !defined(__STRICT_ANSI__)
+# define STMT_START (void)( /* gcc supports ``({ STATEMENTS; })'' */
+# define STMT_END )
+# else
+ /* Now which other defined()s do we need here ??? */
+# if (VOIDFLAGS) && (defined(sun) || defined(__sun__))
+# define STMT_START if (1)
+# define STMT_END else (void)0
+# else
+# define STMT_START do
+# define STMT_END while (0)
+# endif
+# endif
+#endif
+
#include "embed.h"
#define VOIDUSED 1
* code can be a lot prettier. Well, so much for theory. Sorry, Henry...
*/
-#ifdef MYMALLOC
-# ifdef HIDEMYMALLOC
-# define malloc Mymalloc
-# define realloc Myremalloc
-# define free Myfree
-# endif
-# define safemalloc malloc
-# define saferealloc realloc
-# define safefree free
-#endif
-
-/* work around some libPW problems */
-#ifdef DOINIT
-EXT char Error[1];
-#endif
-
/* define this once if either system, instead of cluttering up the src */
#if defined(MSDOS) || defined(atarist)
#define DOSISH 1
#define TAINT_PROPER(s) if (tainting) taint_proper(no_security, s)
#define TAINT_ENV() if (tainting) taint_env()
-#ifndef HAS_VFORK
-# define vfork fork
+/* 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.
+*/
+/* Process group stuff changed from traditional BSD to POSIX.
+ perlfunc.pod documents the traditional BSD-style syntax, so we'll
+ try to preserve that, if possible.
+*/
+#ifdef HAS_SETPGID
+# define BSD_SETPGRP(pid, pgrp) setpgid((pid), (pgrp))
+#else
+# if defined(HAS_SETPGRP) && defined(USE_BSD_SETPGRP)
+# define BSD_SETPGRP(pid, pgrp) setpgrp((pid), (pgrp))
+# else
+# ifdef HAS_SETPGRP2 /* DG/UX */
+# define BSD_SETPGRP(pid, pgrp) setpgrp2((pid), (pgrp))
+# endif
+# endif
+#endif
+#if defined(BSD_SETPGRP) && !defined(HAS_SETPGRP)
+# define HAS_SETPGRP /* Well, effectively it does . . . */
+#endif
+
+/* getpgid isn't POSIX, but at least Solaris and Linux have it, and it makes
+ our life easier :-) so we'll try it.
+*/
+#ifdef HAS_GETPGID
+# define BSD_GETPGRP(pid) getpgid((pid))
+#else
+# if defined(HAS_GETPGRP) && defined(USE_BSD_GETPGRP)
+# define BSD_GETPGRP(pid) getpgrp((pid))
+# else
+# ifdef HAS_GETPGRP2 /* DG/UX */
+# define BSD_GETPGRP(pid) getpgrp2((pid))
+# endif
+# endif
+#endif
+#if defined(BSD_GETPGRP) && !defined(HAS_GETPGRP)
+# define HAS_GETPGRP /* Well, effectively it does . . . */
#endif
-#ifdef HAS_GETPGRP2
-# ifndef HAS_GETPGRP
-# define HAS_GETPGRP
-# endif
+/* These are not exact synonyms, since setpgrp() and getpgrp() may
+ have different behaviors, but perl.h used to define USE_BSDPGRP
+ (prior to 5.003_05) so some extension might depend on it.
+*/
+#if defined(USE_BSD_SETPGRP) || defined(USE_BSD_GETPGRP)
+# ifndef USE_BSDPGRP
+# define USE_BSDPGRP
+# endif
#endif
-#ifdef HAS_SETPGRP2
-# ifndef HAS_SETPGRP
-# define HAS_SETPGRP
+#ifndef _TYPES_ /* If types.h defines this it's easy. */
+# ifndef major /* Does everyone's types.h define this? */
+# include <sys/types.h>
# endif
#endif
-#include <stdio.h>
-#ifdef USE_NEXT_CTYPE
-#include <appkit/NXCType.h>
+#ifdef __cplusplus
+# ifndef I_STDARG
+# define I_STDARG 1
+# endif
+#endif
+
+#ifdef I_STDARG
+# include <stdarg.h>
#else
+# ifdef I_VARARGS
+# include <varargs.h>
+# endif
+#endif
+
+#include "perlio.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 */
+
+#else /* !USE_NEXT_CTYPE */
#include <ctype.h>
+#endif /* USE_NEXT_CTYPE */
+
+#ifdef I_LOCALE
+#include <locale.h>
#endif
+EXT int lc_collate_active;
+
#ifdef METHOD /* Defined by OSF/1 v3.0 by ctype.h */
#undef METHOD
#endif
# include <stdlib.h>
#endif /* STANDARD_C */
+/* Maybe 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. I guess. The patch had no explanation.
+*/
+#ifdef MYMALLOC
+# ifdef HIDEMYMALLOC
+# define malloc Mymalloc
+# define realloc Myrealloc
+# define free Myfree
+# define calloc Mycalloc
+# endif
+# define safemalloc malloc
+# define saferealloc realloc
+# define safefree free
+# define safecalloc calloc
+#endif
+
#define MEM_SIZE Size_t
#if defined(I_STRING) || defined(__cplusplus)
# undef HAS_MEMCMP
#endif
+#ifdef I_MEMORY
+# include <memory.h>
+#endif
+
#ifdef HAS_MEMCPY
# if !defined(STANDARD_C) && !defined(I_STRING) && !defined(I_MEMORY)
# ifndef memcpy
# endif
#endif /* HAS_MEMCMP */
-/* we prefer bcmp slightly for comparisons that don't care about ordering */
-#ifndef HAS_BCMP
-# ifndef bcmp
-# define bcmp(s1,s2,l) memcmp(s1,s2,l)
-# endif
-#endif /* HAS_BCMP */
-
#if !defined(HAS_MEMMOVE) && !defined(memmove)
# if defined(HAS_BCOPY) && defined(HAS_SAFE_BCOPY)
# define memmove(d,s,l) bcopy(s,d,l)
# endif
#endif
-#ifndef _TYPES_ /* If types.h defines this it's easy. */
-# ifndef major /* Does everyone's types.h define this? */
-# include <sys/types.h>
-# endif
-#endif
-
#ifdef I_NETINET_IN
# include <netinet/in.h>
#endif
+#ifdef I_SYS_STAT
#include <sys/stat.h>
+#endif
/* The stat macros for Amdahl UTS, Unisoft System V/88 (and derivatives
like UTekV) are broken, sometimes giving false positives. Undefine
# include <net/errno.h>
# endif
#endif
+#ifndef VMS
+# define FIXSTATUS(sts) (U_L((sts) & 0xffff))
+# define SHIFTSTATUS(sts) ((sts) >> 8)
+# define SETERRNO(errcode,vmserrcode) errno = (errcode)
+#else
+# define FIXSTATUS(sts) (U_L(sts))
+# define SHIFTSTATUS(sts) (sts)
+# define SETERRNO(errcode,vmserrcode) STMT_START {set_errno(errcode); set_vaxc_errno(vmserrcode);} STMT_END
+#endif
#ifndef MSDOS
# ifndef errno
# endif
# endif
# endif
-#endif
+#endif
#ifdef FPUTS_BOTCH
/* work around botch in SunOS 4.0.1 and 4.0.2 */
# define SLOPPYDIVIDE
#endif
-#if defined(cray) || defined(convex) || defined (uts) || BYTEORDER > 0xffff
+#if defined(cray) || defined(convex) || BYTEORDER > 0xffff
# define HAS_QUAD
#endif
+#ifdef UV
+#undef UV
+#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
+*/
+
#ifdef HAS_QUAD
# ifdef cray
# define Quad_t int
# else
-# if defined(convex) || defined (uts)
+# if defined(convex)
# define Quad_t long long
# else
# define Quad_t long
# endif
# endif
+ 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
+#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
+#endif
+
+/* Previously these definitions used hardcoded figures.
+ * It is hoped these formula are more portable, although
+ * no data one way or another is presently known to me.
+ * The "PERL_" names are used because these calculated constants
+ * do not meet the ANSI requirements for LONG_MAX, etc., which
+ * need to be constants acceptable to #if - kja
+ * define PERL_LONG_MAX 2147483647L
+ * define PERL_LONG_MIN (-LONG_MAX - 1)
+ * define PERL ULONG_MAX 4294967295L
+ */
+
+#ifdef I_LIMITS /* Needed for cast_xxx() functions below. */
+# include <limits.h>
+#else
+#ifdef I_VALUES
+# include <values.h>
+#endif
#endif
-#ifdef VOIDSIG
-# define VOIDRET void
+/*
+ * Try to figure out max and min values for the integral types. THE CORRECT
+ * SOLUTION TO THIS MESS: ADAPT enquire.c FROM GCC INTO CONFIGURE. The
+ * following hacks are used if neither limits.h or values.h provide them:
+ * U<TYPE>_MAX: for types >= int: ~(unsigned TYPE)0
+ * for types < int: (unsigned TYPE)~(unsigned)0
+ * The argument to ~ must be unsigned so that later signed->unsigned
+ * conversion can't modify the value's bit pattern (e.g. -0 -> +0),
+ * and it must not be smaller than int because ~ does integral promotion.
+ * <type>_MAX: (<type>) (U<type>_MAX >> 1)
+ * <type>_MIN: -<type>_MAX - <is_twos_complement_architecture: (3 & -1) == 3>.
+ * The latter is a hack which happens to work on some machines but
+ * does *not* catch any random system, or things like integer types
+ * with NaN if that is possible.
+ *
+ * All of the types are explicitly cast to prevent accidental loss of
+ * numeric range, and in the hope that they will be less likely to confuse
+ * over-eager optimizers.
+ *
+ */
+
+#define PERL_UCHAR_MIN ((unsigned char)0)
+
+#ifdef UCHAR_MAX
+# define PERL_UCHAR_MAX ((unsigned char)UCHAR_MAX)
#else
-# define VOIDRET int
+# ifdef MAXUCHAR
+# define PERL_UCHAR_MAX ((unsigned char)MAXUCHAR)
+# else
+# define PERL_UCHAR_MAX ((unsigned char)~(unsigned)0)
+# endif
#endif
+
+/*
+ * CHAR_MIN and CHAR_MAX are not included here, as the (char) type may be
+ * ambiguous. It may be equivalent to (signed char) or (unsigned char)
+ * depending on local options. Until Configure detects this (or at least
+ * detects whether the "signed" keyword is available) the CHAR ranges
+ * will not be included. UCHAR functions normally.
+ * - kja
+ */
-#ifdef DOSISH
-# include "dosish.h"
+#define PERL_USHORT_MIN ((unsigned short)0)
+
+#ifdef USHORT_MAX
+# define PERL_USHORT_MAX ((unsigned short)USHORT_MAX)
#else
-# if defined(VMS)
-# include "vmsish.h"
-# else
-# include "unixish.h"
-# endif
+# ifdef MAXUSHORT
+# define PERL_USHORT_MAX ((unsigned short)MAXUSHORT)
+# else
+# define PERL_USHORT_MAX ((unsigned short)~(unsigned)0)
+# endif
#endif
-#ifndef HAS_PAUSE
-#define pause() sleep((32767<<16)+32767)
+#ifdef SHORT_MAX
+# define PERL_SHORT_MAX ((short)SHORT_MAX)
+#else
+# ifdef MAXSHORT /* Often used in <values.h> */
+# define PERL_SHORT_MAX ((short)MAXSHORT)
+# else
+# define PERL_SHORT_MAX ((short) (PERL_USHORT_MAX >> 1))
+# endif
#endif
-#ifndef IOCPARM_LEN
-# ifdef IOCPARM_MASK
- /* on BSDish systes we're safe */
-# define IOCPARM_LEN(x) (((x) >> 16) & IOCPARM_MASK)
-# else
- /* otherwise guess at what's safe */
-# define IOCPARM_LEN(x) 256
-# endif
+#ifdef SHORT_MIN
+# define PERL_SHORT_MIN ((short)SHORT_MIN)
+#else
+# ifdef MINSHORT
+# define PERL_SHORT_MIN ((short)MINSHORT)
+# else
+# define PERL_SHORT_MIN (-PERL_SHORT_MAX - ((3 & -1) == 3))
+# endif
+#endif
+
+#ifdef UINT_MAX
+# define PERL_UINT_MAX ((unsigned int)UINT_MAX)
+#else
+# ifdef MAXUINT
+# define PERL_UINT_MAX ((unsigned int)MAXUINT)
+# else
+# define PERL_UINT_MAX (~(unsigned int)0)
+# endif
+#endif
+
+#define PERL_UINT_MIN ((unsigned int)0)
+
+#ifdef INT_MAX
+# define PERL_INT_MAX ((int)INT_MAX)
+#else
+# ifdef MAXINT /* Often used in <values.h> */
+# define PERL_INT_MAX ((int)MAXINT)
+# else
+# define PERL_INT_MAX ((int)(PERL_UINT_MAX >> 1))
+# endif
+#endif
+
+#ifdef INT_MIN
+# define PERL_INT_MIN ((int)INT_MIN)
+#else
+# ifdef MININT
+# define PERL_INT_MIN ((int)MININT)
+# else
+# define PERL_INT_MIN (-PERL_INT_MAX - ((3 & -1) == 3))
+# endif
+#endif
+
+#ifdef ULONG_MAX
+# define PERL_ULONG_MAX ((unsigned long)ULONG_MAX)
+#else
+# ifdef MAXULONG
+# define PERL_ULONG_MAX ((unsigned long)MAXULONG)
+# else
+# define PERL_ULONG_MAX (~(unsigned long)0)
+# endif
+#endif
+
+#define PERL_ULONG_MIN ((unsigned long)0L)
+
+#ifdef LONG_MAX
+# define PERL_LONG_MAX ((long)LONG_MAX)
+#else
+# ifdef MAXLONG /* Often used in <values.h> */
+# define PERL_LONG_MAX ((long)MAXLONG)
+# else
+# define PERL_LONG_MAX ((long) (PERL_ULONG_MAX >> 1))
+# endif
+#endif
+
+#ifdef LONG_MIN
+# define PERL_LONG_MIN ((long)LONG_MIN)
+#else
+# ifdef MINLONG
+# define PERL_LONG_MIN ((long)MINLONG)
+# else
+# define PERL_LONG_MIN (-PERL_LONG_MAX - ((3 & -1) == 3))
+# endif
+#endif
+
+#ifdef HAS_QUAD
+
+# ifdef UQUAD_MAX
+# define PERL_UQUAD_MAX ((UV)UQUAD_MAX)
+# else
+# define PERL_UQUAD_MAX (~(UV)0)
+# endif
+
+# define PERL_UQUAD_MIN ((UV)0)
+
+# ifdef QUAD_MAX
+# define PERL_QUAD_MAX ((IV)QUAD_MAX)
+# else
+# define PERL_QUAD_MAX ((IV) (PERL_UQUAD_MAX >> 1))
+# endif
+
+# ifdef QUAD_MIN
+# define PERL_QUAD_MIN ((IV)QUAD_MIN)
+# else
+# define PERL_QUAD_MIN (-PERL_QUAD_MAX - ((3 & -1) == 3))
+# endif
+
#endif
typedef MEM_SIZE STRLEN;
typedef struct svop SVOP;
typedef struct gvop GVOP;
typedef struct pvop PVOP;
-typedef struct cvop CVOP;
typedef struct loop LOOP;
typedef struct Outrec Outrec;
-typedef struct lstring Lstring;
typedef struct interpreter PerlInterpreter;
typedef struct ff FF;
typedef struct sv SV;
typedef struct cv CV;
typedef struct regexp REGEXP;
typedef struct gp GP;
-typedef struct sv GV;
+typedef struct gv GV;
typedef struct io IO;
typedef struct context CONTEXT;
typedef struct block BLOCK;
typedef struct mgvtbl MGVTBL;
typedef union any ANY;
-typedef FILE * (*cryptswitch_t) _((FILE *rfp));
-
#include "handy.h"
-#ifdef HAS_QUAD
-typedef Quad_t IV;
+typedef I32 (*filter_t) _((int, SV *, int));
+#define FILTER_READ(idx, sv, len) filter_read(idx, sv, len)
+#define FILTER_DATA(idx) (AvARRAY(rsfp_filters)[idx])
+#define FILTER_ISREADER(idx) (idx >= AvFILL(rsfp_filters))
+
+#ifdef DOSISH
+# if defined(OS2)
+# include "os2ish.h"
+# else
+# include "dosish.h"
+# endif
#else
-typedef long IV;
+# if defined(VMS)
+# include "vmsish.h"
+# else
+# if defined(PLAN9)
+# include "./plan9/plan9ish.h"
+# else
+# include "unixish.h"
+# 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.
+*/
+#ifdef HAS_PAUSE
+#define Pause pause
+#else
+#define Pause() sleep((32767<<16)+32767)
+#endif
+
+#ifndef IOCPARM_LEN
+# ifdef IOCPARM_MASK
+ /* on BSDish systes we're safe */
+# define IOCPARM_LEN(x) (((x) >> 16) & IOCPARM_MASK)
+# else
+ /* otherwise guess at what's safe */
+# define IOCPARM_LEN(x) 256
+# endif
#endif
union any {
#include "mg.h"
#include "scope.h"
+/* work around some libPW problems */
+#ifdef DOINIT
+EXT char Error[1];
+#endif
+
#if defined(iAPX286) || defined(M_I286) || defined(I80286)
# define I286
#endif
#define U_I(what) ((unsigned int)(what))
#define U_L(what) ((U32)(what))
#else
+# ifdef __cplusplus
+ extern "C" {
+# endif
U32 cast_ulong _((double));
-#define U_S(what) ((U16)cast_ulong(what))
-#define U_I(what) ((unsigned int)cast_ulong(what))
-#define U_L(what) (cast_ulong(what))
+# ifdef __cplusplus
+ }
+# endif
+#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)))
#endif
#ifdef CASTI32
#define I_32(what) ((I32)(what))
#define I_V(what) ((IV)(what))
+#define U_V(what) ((UV)(what))
#else
+# ifdef __cplusplus
+ extern "C" {
+# endif
I32 cast_i32 _((double));
-#define I_32(what) (cast_i32(what))
IV cast_iv _((double));
-#define I_V(what) (cast_iv(what))
+UV cast_uv _((double));
+# ifdef __cplusplus
+ }
+# endif
+#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
struct Outrec {
# define MAXSYSFD 2
#endif
-#ifdef DOSISH
-#define TMPPATH "plXXXXXX"
-#else
-#ifdef VMS
-#define TMPPATH "/sys$scratch/perl-eXXXXXX"
-#else
-#define TMPPATH "/tmp/perl-eXXXXXX"
-#endif
+#ifndef TMPPATH
+# define TMPPATH "/tmp/perl-eXXXXXX"
#endif
#ifndef __cplusplus
#endif
#ifdef DEBUGGING
+#ifndef Perl_debug_log
+#define Perl_debug_log PerlIO_stderr()
+#endif
#define YYDEBUG 1
#define DEB(a) a
#define DEBUG(a) if (debug) 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 (debug & 128) 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
#endif
#define YYMAXDEPTH 300
+#ifndef assert /* <assert.h> might have been included somehow */
#define assert(what) DEB( { \
if (!(what)) { \
croak("Assertion failed: file \"%s\", line %d", \
__FILE__, __LINE__); \
exit(1); \
}})
+#endif
struct ufuncs {
I32 (*uf_val)_((IV, SV*));
extern "C" {
# endif
double exp _((double));
- double fmod _((double,double));
double log _((double));
double sqrt _((double));
double modf _((double,double*));
# endif
#endif
-#ifndef HAS_FMOD
-# ifdef HAS_DREM
-# define fmod(x,y) drem((x),(y))
-# else
-# define USE_MY_FMOD
-# define fmod(x,y) my_fmod(x,y)
-# endif
-#endif
-
#ifndef __cplusplus
+#ifdef __NeXT__ /* or whatever catches all NeXTs */
+char *crypt (); /* Maybe more hosts will need the unprototyped version */
+#else
char *crypt _((const char*, const char*));
+#endif
char *getenv _((const char*));
Off_t lseek _((int,Off_t,int));
char *getlogin _((void));
#endif
-#ifdef EUNICE
+#ifdef UNLINK_ALL_VERSIONS /* Currently only makes sense for VMS */
#define UNLINK unlnk
I32 unlnk _((char*));
#else
#define SCAN_TR 1
#define SCAN_REPL 2
+#ifdef MYMALLOC
+# ifndef DEBUGGING_MSTATS
+# define DEBUGGING_MSTATS
+# endif
+#endif
+
#ifdef DEBUGGING
-# ifndef register
+# ifndef register
# define register
# endif
# define PAD_SV(po) pad_sv(po)
/* global state */
EXT PerlInterpreter * curinterp; /* currently running interpreter */
-#ifndef VMS /* VMS doesn't use environ array */
+/* VMS doesn't use environ array and NeXT has problems with crt0.o globals */
+#if !defined(VMS) && !(defined(NeXT) && defined(__DYNAMIC__))
extern char ** environ; /* environment variables supplied via exec */
-#endif
+#else
+# if defined(NeXT) && defined(__DYNAMIC__)
+
+# include <mach-o/dyld.h>
+EXT char *** environ_pointer;
+# define environ (*environ_pointer)
+# endif
+#endif /* environ processing */
+
EXT int uid; /* current real user id */
EXT int euid; /* current effective user id */
EXT int gid; /* current real group id */
EXT bool nomemok; /* let malloc context handle nomem */
EXT U32 an; /* malloc sequence number */
EXT U32 cop_seqmax; /* statement sequence number */
-EXT U32 op_seqmax; /* op sequence number */
+EXT U16 op_seqmax; /* op sequence number */
EXT U32 evalseq; /* eval sequence number */
EXT U32 sub_generation; /* inc to force methods to be looked up again */
EXT char ** origenviron;
EXT U32 origalen;
EXT U32 * profiledata;
+EXT int maxo INIT(MAXO);/* Number of ops */
+EXT char * osname; /* operating system */
EXT XPV* xiv_arenaroot; /* list of allocated xiv areas */
EXT IV ** xiv_root; /* free xiv list--shared by interpreters */
EXT double * xnv_root; /* free xnv list--shared by interpreters */
EXT XRV * xrv_root; /* free xrv list--shared by interpreters */
EXT XPV * xpv_root; /* free xpv list--shared by interpreters */
+EXT HE * he_root; /* free he list--shared by interpreters */
+EXT char * nice_chunk; /* a nice chunk of memory to reuse */
+EXT U32 nice_chunk_size;/* how nice the chunk of memory is */
/* Stack for currently executing thread--context switch must handle this. */
EXT SV ** stack_base; /* stack->array_ary */
/* temp space */
EXT SV * Sv;
+EXT HE He;
EXT XPV * Xpv;
-EXT char buf[1024];
+EXT char buf[2048]; /* should be longer than PATH_MAX */
EXT char tokenbuf[256];
EXT struct stat statbuf;
#ifdef HAS_TIMES
EXT char no_wrongref[]
INIT("Can't use %s ref as %s ref");
EXT char no_symref[]
- INIT("Can't use a string as %s ref while \"strict refs\" in use");
+ INIT("Can't use string (\"%.32s\") as %s ref while \"strict refs\" in use");
EXT char no_usym[]
INIT("Can't use an undefined value as %s reference");
EXT char no_aelem[]
INIT("Unsupported directory function \"%s\" called");
EXT char no_func[]
INIT("The %s function is unimplemented");
+EXT char no_myglob[]
+ INIT("\"my\" variable %s can't be in a package");
EXT SV sv_undef;
EXT SV sv_no;
#endif
#ifdef DOINIT
-EXT char *sig_name[] = {
- SIG_NAME,0
-};
+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)];
#else
EXT char *sig_name[];
+EXT int sig_num[];
+EXT SV * psig_ptr[];
+EXT SV * psig_name[];
#endif
#ifdef DOINIT
EXT I32 nexttype[5]; /* type of next token */
EXT I32 nexttoke;
-EXT FILE * VOL rsfp INIT(Nullfp);
+EXT PerlIO * VOL rsfp INIT(Nullfp);
EXT SV * linestr;
EXT char * bufptr;
EXT char * oldbufptr;
EXT char * oldoldbufptr;
EXT char * bufend;
EXT expectation expect INIT(XSTATE); /* how to interpret ambiguous tokens */
-EXT char * autoboot_preamble INIT(Nullch);
+EXT AV * rsfp_filters;
EXT I32 multi_start; /* 1st line of multi-line string */
EXT I32 multi_end; /* last line of multi-line string */
EXT I32 subline; /* line this subroutine began on */
EXT SV * subname; /* name of current subroutine */
+EXT CV * compcv; /* currently compiling subroutine */
EXT AV * comppad; /* storage for lexically scoped temporaries */
EXT AV * comppad_name; /* variable names for "my" variables */
EXT I32 comppad_name_fill;/* last "introduced" variable offset */
+EXT I32 comppad_name_floor;/* start of vars in innermost block */
EXT I32 min_intro_pending;/* start of vars to introduce */
EXT I32 max_intro_pending;/* end of vars to introduce */
EXT I32 padix; /* max used index in current "register" pad */
EXT I32 padix_floor; /* how low may inner block reset padix */
-EXT bool pad_reset_pending; /* reset pad on next attempted alloc */
+EXT I32 pad_reset_pending; /* reset pad on next attempted alloc */
EXT COP compiling;
EXT I32 thisexpr; /* name id for nothing_in_common() */
#define HINT_BLOCK_SCOPE 0x00000100
#define HINT_STRICT_SUBS 0x00000200
#define HINT_STRICT_VARS 0x00000400
+#define HINT_STRICT_UNTIE 0x00000800
/**************************************************************************/
/* This regexp stuff is global since it always happens within 1 expr eval */
EXT U16 regflags; /* are we folding, multilining? */
EXT char regprev; /* char before regbol, \n if none */
+EXT bool do_undump; /* -u or dump seen? */
+EXT VOL U32 debug;
+
/***********************************************/
/* Global only to current interpreter instance */
/***********************************************/
IEXT GV * Isiggv;
IEXT GV * Iincgv;
IEXT char * Iorigfilename;
+IEXT SV * Idiehook;
+IEXT SV * Iwarnhook;
+IEXT SV * Iparsehook;
+
+/* 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))
/* switches */
IEXT char * Icddir;
IEXT bool Iminus_c;
-IEXT char Ipatchlevel[6];
-IEXT char * Inrs IINIT("\n");
-IEXT U32 Inrschar IINIT('\n'); /* final char of rs, or 0777 if none */
-IEXT I32 Inrslen IINIT(1);
+IEXT char Ipatchlevel[10];
+IEXT char ** Ilocalpatches;
+IEXT SV * Inrs;
IEXT char * Isplitstr IINIT(" ");
IEXT bool Ipreprocess;
IEXT bool Iminus_n;
IEXT bool Isawi; /* study must assume case insensitive */
IEXT bool Isawvec;
IEXT bool Iunsafe;
-IEXT bool Ido_undump; /* -u or dump seen? */
IEXT char * Iinplace;
IEXT char * Ie_tmpname;
-IEXT FILE * Ie_fp;
-IEXT VOL U32 Idebug;
+IEXT PerlIO * Ie_fp;
IEXT U32 Iperldb;
+ /* This value may be raised by extensions for testing purposes */
+IEXT int Iperl_destruct_level; /* 0=none, 1=full, 2=full with checks */
/* magical thingies */
IEXT Time_t Ibasetime; /* $^T */
IEXT SV * Iformfeed; /* $^L */
IEXT char * Ichopset IINIT(" \n-"); /* $: */
-IEXT char * Irs IINIT("\n"); /* $/ */
-IEXT U32 Irschar IINIT('\n'); /* final char of rs, or 0777 if none */
-IEXT STRLEN Irslen IINIT(1);
-IEXT bool Irspara;
+IEXT SV * Irs; /* $/ */
IEXT char * Iofs; /* $, */
IEXT STRLEN Iofslen;
IEXT char * Iors; /* $\ */
IEXT char * Iofmt; /* $# */
IEXT I32 Imaxsysfd IINIT(MAXSYSFD); /* top fd to pass to subprocesses */
IEXT int Imultiline; /* $*--do strings hold >1 line? */
-IEXT U16 Istatusvalue; /* $? */
+IEXT U32 Istatusvalue; /* $? */
IEXT struct stat Istatcache; /* _ */
IEXT GV * Istatgv;
IEXT I32 Imaxscream IINIT(-1);
IEXT SV * Ilastscream;
+/* shortcuts to misc objects */
+IEXT GV * Ierrgv;
+
/* shortcuts to debugging objects */
IEXT GV * IDBgv;
IEXT GV * IDBline;
IEXT SV * Icurstname; /* name of current package */
IEXT AV * Ibeginav; /* names of BEGIN subroutines */
IEXT AV * Iendav; /* names of END subroutines */
-IEXT AV * Ipad; /* storage for lexically scoped temporaries */
-IEXT AV * Ipadname; /* variable names for "my" variables */
+IEXT HV * Istrtab; /* shared string table */
/* memory management */
IEXT SV ** Itmps_stack;
IEXT OP * Irestartop; /* Are we propagating an error from croak? */
IEXT int Idelaymagic; /* ($<,$>) = ... */
IEXT bool Idirty; /* In the middle of tearing things down? */
-IEXT bool Ilocalizing; /* are we processing a local() list? */
+IEXT U8 Ilocalizing; /* are we processing a local() list? */
IEXT bool Itainted; /* using variables controlled by $< */
IEXT bool Itainting; /* doing taint checks */
+IEXT char * Iop_mask IINIT(NULL); /* masked operations for safe evals */
/* trace state */
IEXT I32 Idlevel;
IEXT char * Idebdelim;
/* current interpreter roots */
+IEXT CV * Imain_cv;
IEXT OP * Imain_root;
IEXT OP * Imain_start;
IEXT OP * Ieval_root;
/* runtime control stuff */
IEXT COP * VOL Icurcop IINIT(&compiling);
+IEXT COP * Icurcopdb IINIT(NULL);
IEXT line_t Icopline IINIT(NOLINE);
IEXT CONTEXT * Icxstack;
IEXT I32 Icxstack_ix IINIT(-1);
IEXT I32 Icxstack_max IINIT(128);
-IEXT jmp_buf Itop_env;
+IEXT Sigjmp_buf Itop_env;
IEXT I32 Irunlevel;
/* stack stuff */
-IEXT AV * Istack; /* THE STACK */
+IEXT AV * Icurstack; /* THE STACK */
IEXT AV * Imainstack; /* the stack when nothing funny is happening */
IEXT SV ** Imystack_base; /* stack->array_ary */
IEXT SV ** Imystack_sp; /* stack pointer now */
IEXT PMOP * Ioldlastpm; /* for saving regexp context during debugger */
IEXT I32 Igensym; /* next symbol for getsym() to define */
IEXT bool Ipreambled;
+IEXT AV * Ipreambleav;
IEXT int Ilaststatval IINIT(-1);
IEXT I32 Ilaststype IINIT(OP_STAT);
extern "C" {
#endif
-#ifdef __cplusplus
-# ifndef I_STDARG
-# define I_STDARG 1
-# endif
-#endif
-
-#ifdef I_STDARG
-# include <stdarg.h>
-#else
-# ifdef I_VARARGS
-# include <varargs.h>
-# endif
-#endif
-
#include "proto.h"
#ifdef EMBED
/* The following must follow proto.h */
#ifdef DOINIT
-MGVTBL vtbl_sv = {magic_get,
+EXT MGVTBL vtbl_sv = {magic_get,
magic_set,
magic_len,
0, 0};
-MGVTBL vtbl_env = {0, 0, 0, 0, 0};
-MGVTBL vtbl_envelem = {0, magic_setenv,
+EXT MGVTBL vtbl_env = {0, 0, 0, 0, 0};
+EXT MGVTBL vtbl_envelem = {0, magic_setenv,
0, magic_clearenv,
0};
-MGVTBL vtbl_sig = {0, 0, 0, 0, 0};
-MGVTBL vtbl_sigelem = {0, magic_setsig,
- 0, 0, 0};
-MGVTBL vtbl_pack = {0, 0, 0, magic_wipepack,
+EXT MGVTBL vtbl_sig = {0, 0, 0, 0, 0};
+EXT MGVTBL vtbl_sigelem = {magic_getsig,
+ magic_setsig,
+ 0, magic_clearsig,
+ 0};
+EXT MGVTBL vtbl_pack = {0, 0, 0, magic_wipepack,
0};
-MGVTBL vtbl_packelem = {magic_getpack,
+EXT MGVTBL vtbl_packelem = {magic_getpack,
magic_setpack,
0, magic_clearpack,
0};
-MGVTBL vtbl_dbline = {0, magic_setdbline,
+EXT MGVTBL vtbl_dbline = {0, magic_setdbline,
0, 0, 0};
-MGVTBL vtbl_isa = {0, magic_setisa,
+EXT MGVTBL vtbl_isa = {0, magic_setisa,
0, 0, 0};
-MGVTBL vtbl_isaelem = {0, magic_setisa,
+EXT MGVTBL vtbl_isaelem = {0, magic_setisa,
0, 0, 0};
-MGVTBL vtbl_arylen = {magic_getarylen,
+EXT MGVTBL vtbl_arylen = {magic_getarylen,
magic_setarylen,
0, 0, 0};
-MGVTBL vtbl_glob = {magic_getglob,
+EXT MGVTBL vtbl_glob = {magic_getglob,
magic_setglob,
0, 0, 0};
-MGVTBL vtbl_mglob = {0, magic_setmglob,
+EXT MGVTBL vtbl_mglob = {0, magic_setmglob,
0, 0, 0};
-MGVTBL vtbl_taint = {magic_gettaint,magic_settaint,
+EXT MGVTBL vtbl_nkeys = {0, magic_setnkeys,
0, 0, 0};
-MGVTBL vtbl_substr = {0, magic_setsubstr,
+EXT MGVTBL vtbl_taint = {magic_gettaint,magic_settaint,
0, 0, 0};
-MGVTBL vtbl_vec = {0, magic_setvec,
+EXT MGVTBL vtbl_substr = {0, magic_setsubstr,
0, 0, 0};
-MGVTBL vtbl_pos = {magic_getpos,
+EXT MGVTBL vtbl_vec = {0, magic_setvec,
+ 0, 0, 0};
+EXT MGVTBL vtbl_pos = {magic_getpos,
magic_setpos,
0, 0, 0};
-MGVTBL vtbl_bm = {0, magic_setbm,
+EXT MGVTBL vtbl_bm = {0, magic_setbm,
0, 0, 0};
-MGVTBL vtbl_uvar = {magic_getuvar,
+EXT MGVTBL vtbl_uvar = {magic_getuvar,
magic_setuvar,
0, 0, 0};
#ifdef OVERLOAD
-MGVTBL vtbl_amagic = {0, magic_setamagic,
- 0, 0, 0};
-MGVTBL vtbl_amagicelem = {0, magic_setamagic,
- 0, 0, 0};
+EXT MGVTBL vtbl_amagic = {0, magic_setamagic,
+ 0, 0, magic_setamagic};
+EXT MGVTBL vtbl_amagicelem = {0, magic_setamagic,
+ 0, 0, magic_setamagic};
#endif /* OVERLOAD */
#else
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;
#ifdef OVERLOAD
EXT long amagic_generation;
-#define NofAMmeth 27
+#define NofAMmeth 29
#ifdef DOINIT
EXT char * AMG_names[NofAMmeth][2] = {
{"fallback","abs"},
{"**", "**="},
{"<<", "<<="},
{">>", ">>="},
+ {"&", "&="},
+ {"|", "|="},
+ {"^", "^="},
{"<", "<="},
{">", ">="},
{"==", "!="},
{"lt", "le"},
{"gt", "ge"},
{"eq", "ne"},
- {"&", "^"},
- {"|", "neg"},
{"!", "~"},
{"++", "--"},
{"atan2", "cos"},
{"sin", "exp"},
{"log", "sqrt"},
{"x","x="},
- {".",".="}
+ {".",".="},
+ {"=","neg"}
};
#else
EXT char * AMG_names[NofAMmeth][2];
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,
slt_amg, sle_amg,
sgt_amg, sge_amg,
seq_amg, sne_amg,
- band_amg, bxor_amg,
- bor_amg, neg_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
+ concat_amg, concat_ass_amg,
+ copy_amg, neg_amg
};
#endif /* OVERLOAD */
+#if !defined(PERLIO_IS_STDIO) && defined(HAS_ATTRIBUTE)
+/*
+ * Now we have __attribute__ out of the way
+ * Remap printf
+ */
+#define printf PerlIO_stdoutf
+#endif
+
#endif /* Include guard */
+