/* perl.h
*
- * Copyright (c) 1987-1994, Larry Wall
+ * Copyright (c) 1987-1997, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
#undef NO_EMBED
#define NO_EMBED
#undef MULTIPLICITY
-#undef HIDEMYMALLOC
-#undef EMBEDMYMALLOC
#undef USE_STDIO
#define USE_STDIO
#endif /* PERL_FOR_X2P */
+#define VOIDUSED 1
+#include "config.h"
+
+#include "embed.h"
+
+#ifdef OP_IN_REGISTER
+# ifdef __GNUC__
+# define stringify_immed(s) #s
+# define stringify(s) stringify_immed(s)
+register struct op *op asm(stringify(OP_IN_REGISTER));
+# endif
+#endif
+
/*
* STMT_START { statements; } STMT_END;
* can be used as a single statement, as in
* Trying to select a version that gives no warnings...
*/
#if !(defined(STMT_START) && defined(STMT_END))
-# if defined(__GNUC__) && !defined(__STRICT_ANSI__)
+# if defined(__GNUC__) && !defined(__STRICT_ANSI__) && !defined(__cplusplus)
# define STMT_START (void)( /* gcc supports ``({ STATEMENTS; })'' */
# define STMT_END )
# else
# endif
#endif
-#include "embed.h"
+#define NOOP (void)0
-#define VOIDUSED 1
-#include "config.h"
+#define WITH_THR(s) do { dTHR; s; } while (0)
+
+#ifdef USE_THREADS
+# ifdef FAKE_THREADS
+# include "fakethr.h"
+# else
+# ifdef WIN32
+# include "win32/win32thread.h"
+# else
+# include <pthread.h>
+typedef pthread_mutex_t perl_mutex;
+typedef pthread_cond_t perl_cond;
+typedef pthread_key_t perl_key;
+# endif /* WIN32 */
+# endif /* FAKE_THREADS */
+#endif /* USE_THREADS */
/*
* SOFT_CAST can be used for args to prototyped functions to retain some
*/
/* define this once if either system, instead of cluttering up the src */
-#if defined(MSDOS) || defined(atarist)
+#if defined(MSDOS) || defined(atarist) || defined(WIN32)
#define DOSISH 1
#endif
# define STANDARD_C 1
#endif
+#if defined(__cplusplus) || defined(WIN32)
+# define DONT_DECLARE_STD 1
+#endif
+
#if defined(HASVOLATILE) || defined(STANDARD_C)
# ifdef __cplusplus
# define VOL // to temporarily suppress warnings
# define VOL
#endif
-#define TAINT_IF(c) (tainted |= (c))
-#define TAINT_NOT (tainted = 0)
-#define TAINT_PROPER(s) if (tainting) taint_proper(no_security, s)
-#define TAINT_ENV() if (tainting) taint_env()
+#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); }
/* 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.
#include <ctype.h>
#endif /* USE_NEXT_CTYPE */
-#ifdef I_LOCALE
-#include <locale.h>
-#endif
-
#ifdef METHOD /* Defined by OSF/1 v3.0 by ctype.h */
#undef METHOD
#endif
+#ifdef I_LOCALE
+# include <locale.h>
+#endif
+
+#if !defined(NO_LOCALE) && defined(HAS_SETLOCALE)
+# define USE_LOCALE
+# if !defined(NO_LOCALE_COLLATE) && defined(LC_COLLATE) \
+ && defined(HAS_STRXFRM)
+# define USE_LOCALE_COLLATE
+# endif
+# if !defined(NO_LOCALE_CTYPE) && defined(LC_CTYPE)
+# define USE_LOCALE_CTYPE
+# endif
+# if !defined(NO_LOCALE_NUMERIC) && defined(LC_NUMERIC)
+# define USE_LOCALE_NUMERIC
+# endif
+#endif /* !NO_LOCALE && HAS_SETLOCALE */
+
#include <setjmp.h>
#ifdef I_SYS_PARAM
/* Use all the "standard" definitions? */
#if defined(STANDARD_C) && defined(I_STDLIB)
# include <stdlib.h>
-#endif /* STANDARD_C */
+#endif
/* This comes after <stdlib.h> so we don't try to change the standard
* library prototypes; we'll use our own in proto.h instead. */
#define MEM_SIZE Size_t
+#if defined(STANDARD_C) && defined(I_STDDEF)
+# include <stddef.h>
+# define STRUCT_OFFSET(s,m) offsetof(s,m)
+#else
+# define STRUCT_OFFSET(s,m) (Size_t)(&(((s *)0)->m))
+#endif
+
#if defined(I_STRING) || defined(__cplusplus)
# include <string.h>
#else
#define strrchr rindex
#endif
-#if defined(mips) && defined(ultrix) && !defined(__STDC__)
-# undef HAS_MEMCMP
-#endif
-
#ifdef I_MEMORY
# include <memory.h>
#endif
extern char *memset _((char*, int, int));
# endif
# endif
-# define memzero(d,l) memset(d,0,l)
#else
-# ifndef memzero
-# ifdef HAS_BZERO
-# define memzero(d,l) bzero(d,l)
+# define memset(d,c,l) my_memset(d,c,l)
+#endif /* HAS_MEMSET */
+
+#if !defined(HAS_MEMMOVE) && !defined(memmove)
+# if defined(HAS_BCOPY) && defined(HAS_SAFE_BCOPY)
+# define memmove(d,s,l) bcopy(s,d,l)
+# else
+# if defined(HAS_MEMCPY) && defined(HAS_SAFE_MEMCPY)
+# define memmove(d,s,l) memcpy(d,s,l)
# else
-# define memzero(d,l) my_bzero(d,l)
+# define memmove(d,s,l) my_bcopy(s,d,l)
# endif
# endif
-#endif /* HAS_MEMSET */
+#endif
-#ifdef HAS_MEMCMP
+#if defined(mips) && defined(ultrix) && !defined(__STDC__)
+# undef HAS_MEMCMP
+#endif
+
+#if defined(HAS_MEMCMP) && defined(HAS_SANE_MEMCMP)
# if !defined(STANDARD_C) && !defined(I_STRING) && !defined(I_MEMORY)
# ifndef memcmp
extern int memcmp _((char*, char*, int));
# endif
# endif
+# ifdef BUGGY_MSC
+ # pragma function(memcmp)
+# endif
#else
# ifndef memcmp
# define memcmp my_memcmp
# endif
-#endif /* HAS_MEMCMP */
+#endif /* HAS_MEMCMP && HAS_SANE_MEMCMP */
-#if !defined(HAS_MEMMOVE) && !defined(memmove)
-# if defined(HAS_BCOPY) && defined(HAS_SAFE_BCOPY)
-# define memmove(d,s,l) bcopy(s,d,l)
+#ifndef memzero
+# ifdef HAS_MEMSET
+# define memzero(d,l) memset(d,0,l)
# else
-# if defined(HAS_MEMCPY) && defined(HAS_SAFE_MEMCPY)
-# define memmove(d,s,l) memcpy(d,s,l)
+# ifdef HAS_BZERO
+# define memzero(d,l) bzero(d,l)
# else
-# define memmove(d,s,l) my_bcopy(s,d,l)
+# define memzero(d,l) my_bzero(d,l)
# endif
# endif
#endif
+#ifndef HAS_BCMP
+# ifndef bcmp
+# define bcmp(s1,s2,l) memcmp(s1,s2,l)
+# endif
+#endif /* !HAS_BCMP */
+
#ifdef I_NETINET_IN
# include <netinet/in.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). */
+# undef SF_APPEND
+#endif
+
#ifdef I_SYS_STAT
-#include <sys/stat.h>
+# include <sys/stat.h>
#endif
/* The stat macros for Amdahl UTS, Unisoft System V/88 (and derivatives
# 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)
+
+#ifdef VMS
+# define SETERRNO(errcode,vmserrcode) \
+ STMT_START { \
+ set_errno(errcode); \
+ set_vaxc_errno(vmserrcode); \
+ } STMT_END
#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
+# define SETERRNO(errcode,vmserrcode) errno = (errcode)
#endif
#ifndef errno
# ifdef VMS
char *strerror _((int,...));
# else
+#ifndef DONT_DECLARE_STD
char *strerror _((int));
+#endif
# endif
# ifndef Strerror
# define Strerror strerror
# define SLOPPYDIVIDE
#endif
-#if defined(cray) || defined(convex) || BYTEORDER > 0xffff
-# define HAS_QUAD
-#endif
-
#ifdef UV
#undef UV
#endif
--Andy Dougherty August 1996
*/
-#ifdef HAS_QUAD
-# ifdef cray
-# define Quad_t int
+#ifdef cray
+# define Quad_t int
+#else
+# ifdef convex
+# define Quad_t long long
# else
-# if defined(convex)
-# define Quad_t long long
-# else
+# if BYTEORDER > 0xFFFF
# define Quad_t long
# endif
# endif
+#endif
+
+#ifdef Quad_t
+# define HAS_QUAD
typedef Quad_t IV;
typedef unsigned Quad_t UV;
# define IV_MAX PERL_QUAD_MAX
#endif
+/* Digital UNIX defines a typedef CONTEXT when pthreads is in use */
+#if defined(__osf__)
+# define CONTEXT PERL_CONTEXT
+#endif
+
typedef MEM_SIZE STRLEN;
typedef struct op OP;
typedef struct Outrec Outrec;
typedef struct interpreter PerlInterpreter;
-typedef struct ff FF;
+#ifndef __BORLANDC__
+typedef struct ff FF; /* XXX not defined anywhere, should go? */
+#endif
typedef struct sv SV;
typedef struct av AV;
typedef struct hv HV;
typedef struct xrv XRV;
typedef struct xpv XPV;
typedef struct xpviv XPVIV;
+typedef struct xpvuv XPVUV;
typedef struct xpvnv XPVNV;
typedef struct xpvmg XPVMG;
typedef struct xpvlv XPVLV;
# endif
#endif
+#ifdef VMS
+# define STATUS_NATIVE statusvalue_vms
+# define STATUS_NATIVE_EXPORT \
+ ((I32)statusvalue_vms == -1 ? 44 : 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; \
+ else \
+ statusvalue = (statusvalue_vms & STS$M_SEVERITY) << 8; \
+ } STMT_END
+# define STATUS_POSIX statusvalue
+# ifdef VMSISH_STATUS
+# define STATUS_CURRENT (VMSISH_STATUS ? STATUS_NATIVE : STATUS_POSIX)
+# else
+# define STATUS_CURRENT STATUS_POSIX
+# endif
+# define STATUS_POSIX_SET(n) \
+ STMT_START { \
+ statusvalue = (n); \
+ if (statusvalue != -1) { \
+ statusvalue &= 0xFFFF; \
+ statusvalue_vms = statusvalue ? 44 : 1; \
+ } \
+ else statusvalue_vms = -1; \
+ } STMT_END
+# define STATUS_ALL_SUCCESS (statusvalue = 0, statusvalue_vms = 1)
+# define STATUS_ALL_FAILURE (statusvalue = 1, 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_SET(n) \
+ STMT_START { \
+ statusvalue = (n); \
+ if (statusvalue != -1) \
+ statusvalue &= 0xFFFF; \
+ } STMT_END
+# define STATUS_CURRENT STATUS_POSIX
+# define STATUS_ALL_SUCCESS (statusvalue = 0)
+# define STATUS_ALL_FAILURE (statusvalue = 1)
+#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.
void (*any_dptr) _((void*));
};
+#ifdef USE_THREADS
+#define ARGSproto struct thread *
+#else
+#define ARGSproto void
+#endif /* USE_THREADS */
+
+/* Work around some cygwin32 problems with importing global symbols */
+#if defined(CYGWIN32) && defined(DLLIMPORT)
+# include "cw32imp.h"
+#endif
+
#include "regexp.h"
#include "sv.h"
#include "util.h"
};
/* Fix these up for __STDC__ */
-#ifndef __cplusplus
+#ifndef DONT_DECLARE_STD
char *mktemp _((char*));
double atof _((const char*));
#endif
# endif
double exp _((double));
double log _((double));
+ double log10 _((double));
double sqrt _((double));
+ double frexp _((double,int*));
+ double ldexp _((double,int));
double modf _((double,double*));
double sin _((double));
double cos _((double));
#else
char *crypt _((const char*, const char*));
#endif
+#ifndef DONT_DECLARE_STD
+#ifndef getenv
char *getenv _((const char*));
+#endif
Off_t lseek _((int,Off_t,int));
+#endif
char *getlogin _((void));
#endif
# endif
#endif
+typedef Signal_t (*Sighandler_t) _((int));
+
+#ifdef HAS_SIGACTION
+typedef struct sigaction Sigsave_t;
+#else
+typedef Sighandler_t Sigsave_t;
+#endif
+
#define SCAN_DEF 0
#define SCAN_TR 1
#define SCAN_REPL 2
# ifndef register
# define register
# endif
-# ifdef MYMALLOC
-# ifndef DEBUGGING_MSTATS
-# define DEBUGGING_MSTATS
-# endif
-# endif
# define PAD_SV(po) pad_sv(po)
+# define RUNOPS_DEFAULT runops_debug
#else
# define PAD_SV(po) curpad[po]
+# define RUNOPS_DEFAULT runops_standard
+#endif
+
+/*
+ * These need prototyping here because <proto.h> isn't
+ * included until after runops is initialised.
+ */
+
+int runops_standard _((void));
+#ifdef DEBUGGING
+int runops_debug _((void));
#endif
/****************/
/* global state */
EXT PerlInterpreter * curinterp; /* currently running interpreter */
+#ifdef USE_THREADS
+EXT perl_key thr_key; /* For per-thread struct thread ptr */
+EXT perl_mutex sv_mutex; /* Mutex for allocating SVs in sv.c */
+EXT perl_mutex malloc_mutex; /* Mutex for malloc */
+EXT perl_mutex eval_mutex; /* Mutex for doeval */
+EXT perl_cond eval_cond; /* Condition variable for doeval */
+EXT struct thread * eval_owner; /* Owner thread for doeval */
+EXT int nthreads; /* Number of threads currently */
+EXT perl_mutex threads_mutex; /* Mutex for nthreads and thread list */
+EXT perl_cond nthreads_cond; /* Condition variable for nthreads */
+#ifdef FAKE_THREADS
+EXT struct thread * thr; /* Currently executing (fake) thread */
+#endif
+#endif /* USE_THREADS */
+
/* VMS doesn't use environ array and NeXT has problems with crt0.o globals */
#if !defined(VMS) && !(defined(NeXT) && defined(__DYNAMIC__))
+#ifndef DONT_DECLARE_STD
extern char ** environ; /* environment variables supplied via exec */
+#endif
#else
# if defined(NeXT) && defined(__DYNAMIC__)
# endif
#endif /* environ processing */
-EXT int lc_collate_active;
EXT int uid; /* current real user id */
EXT int euid; /* current effective user id */
EXT int gid; /* current real group id */
EXT U32 sub_generation; /* inc to force methods to be looked up again */
EXT char ** origenviron;
EXT U32 origalen;
+EXT HV * pidstatus; /* pid-to-status mappings for waitpid */
EXT U32 * profiledata;
EXT int maxo INIT(MAXO);/* Number of ops */
EXT char * osname; /* operating system */
+EXT char * sh_path INIT(SH_PATH); /* full path of shell */
+EXT Sighandler_t sighandlerp;
EXT XPV* xiv_arenaroot; /* list of allocated xiv areas */
EXT IV ** xiv_root; /* free xiv list--shared by interpreters */
/* likewise for these */
-EXT OP * op; /* current op--oughta be in a global register */
-
+#ifdef OP_IN_REGISTER
+EXT OP * opsave; /* save current op register across longjmps */
+#else
+EXT OP * op; /* current op--when not in a global register */
+#endif
+EXT int (*runops) _((void)) INIT(RUNOPS_DEFAULT);
EXT I32 * scopestack; /* blocks we've entered */
EXT I32 scopestack_ix;
EXT I32 scopestack_max;
/* temp space */
EXT SV * Sv;
-EXT HE He;
EXT XPV * Xpv;
-EXT char buf[2048]; /* should be longer than PATH_MAX */
EXT char tokenbuf[256];
EXT struct stat statbuf;
#ifdef HAS_TIMES
EXT char * dc;
/* handy constants */
-EXT char * Yes INIT("1");
-EXT char * No INIT("");
-EXT char * hexdigit INIT("0123456789abcdef0123456789ABCDEFx");
-EXT char * patleave INIT("\\.^$@dDwWsSbB+*?|()-nrtfeaxc0123456789[{]}");
-EXT char * vert INIT("|");
+EXTCONST char * Yes INIT("1");
+EXTCONST char * No INIT("");
+EXTCONST char * hexdigit INIT("0123456789abcdef0123456789ABCDEFx");
+EXTCONST char * patleave INIT("\\.^$@dDwWsSbB+*?|()-nrtfeaxc0123456789[{]}");
+EXTCONST char * vert INIT("|");
-EXT char warn_uninit[]
+EXTCONST char warn_uninit[]
INIT("Use of uninitialized value");
-EXT char warn_nosemi[]
+EXTCONST char warn_nosemi[]
INIT("Semicolon seems to be missing");
-EXT char warn_reserved[]
+EXTCONST char warn_reserved[]
INIT("Unquoted string \"%s\" may clash with future reserved word");
-EXT char warn_nl[]
+EXTCONST char warn_nl[]
INIT("Unsuccessful %s on filename containing newline");
-EXT char no_wrongref[]
+EXTCONST char no_wrongref[]
INIT("Can't use %s ref as %s ref");
-EXT char no_symref[]
+EXTCONST char no_symref[]
INIT("Can't use string (\"%.32s\") as %s ref while \"strict refs\" in use");
-EXT char no_usym[]
+EXTCONST char no_usym[]
INIT("Can't use an undefined value as %s reference");
-EXT char no_aelem[]
+EXTCONST char no_aelem[]
INIT("Modification of non-creatable array value attempted, subscript %d");
-EXT char no_helem[]
+EXTCONST char no_helem[]
INIT("Modification of non-creatable hash value attempted, subscript \"%s\"");
-EXT char no_modify[]
+EXTCONST char no_modify[]
INIT("Modification of a read-only value attempted");
-EXT char no_mem[]
+EXTCONST char no_mem[]
INIT("Out of memory!\n");
-EXT char no_security[]
+EXTCONST char no_security[]
INIT("Insecure dependency in %s%s");
-EXT char no_sock_func[]
+EXTCONST char no_sock_func[]
INIT("Unsupported socket function \"%s\" called");
-EXT char no_dir_func[]
+EXTCONST char no_dir_func[]
INIT("Unsupported directory function \"%s\" called");
-EXT char no_func[]
+EXTCONST char no_func[]
INIT("The %s function is unimplemented");
-EXT char no_myglob[]
+EXTCONST char no_myglob[]
INIT("\"my\" variable %s can't be in a package");
EXT SV sv_undef;
EXT SV * psig_name[];
#endif
+/* fast case folding tables */
+
+#ifdef DOINIT
+EXTCONST unsigned char 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,
+ 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, 'a', 'b', 'c', 'd', 'e', 'f', 'g',
+ 'h', 'i', 'j', 'k', 'l', 'm', 'n', 'o',
+ 'p', 'q', 'r', 's', 't', 'u', 'v', 'w',
+ 'x', 'y', 'z', 91, 92, 93, 94, 95,
+ 96, 'A', 'B', 'C', 'D', 'E', 'F', 'G',
+ 'H', 'I', 'J', 'K', 'L', 'M', 'N', 'O',
+ 'P', 'Q', 'R', 'S', 'T', 'U', 'V', 'W',
+ 'X', 'Y', 'Z', 123, 124, 125, 126, 127,
+ 128, 129, 130, 131, 132, 133, 134, 135,
+ 136, 137, 138, 139, 140, 141, 142, 143,
+ 144, 145, 146, 147, 148, 149, 150, 151,
+ 152, 153, 154, 155, 156, 157, 158, 159,
+ 160, 161, 162, 163, 164, 165, 166, 167,
+ 168, 169, 170, 171, 172, 173, 174, 175,
+ 176, 177, 178, 179, 180, 181, 182, 183,
+ 184, 185, 186, 187, 188, 189, 190, 191,
+ 192, 193, 194, 195, 196, 197, 198, 199,
+ 200, 201, 202, 203, 204, 205, 206, 207,
+ 208, 209, 210, 211, 212, 213, 214, 215,
+ 216, 217, 218, 219, 220, 221, 222, 223,
+ 224, 225, 226, 227, 228, 229, 230, 231,
+ 232, 233, 234, 235, 236, 237, 238, 239,
+ 240, 241, 242, 243, 244, 245, 246, 247,
+ 248, 249, 250, 251, 252, 253, 254, 255
+};
+#else
+EXTCONST unsigned char fold[];
+#endif
+
#ifdef DOINIT
-EXT unsigned char fold[] = { /* fast case folding table */
+EXT unsigned char 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[];
+EXT unsigned char fold_locale[];
#endif
#ifdef DOINIT
-EXT unsigned char freq[] = { /* letter frequencies for mixed English/C */
+EXTCONST unsigned char 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,
138, 139, 141, 142, 143, 144, 145, 146
};
#else
-EXT unsigned char freq[];
+EXTCONST unsigned char freq[];
#endif
#ifdef DEBUGGING
#ifdef DOINIT
-EXT char* block_type[] = {
+EXTCONST char* block_type[] = {
"NULL",
"SUB",
"EVAL",
"BLOCK",
};
#else
-EXT char* block_type[];
+EXTCONST char* block_type[];
#endif
#endif
#include "perly.h"
+#define LEX_NOTPARSING 11 /* borrowed from toke.c */
+
typedef enum {
XOPERATOR,
XTERM,
EXT char * last_lop; /* position of last list operator */
EXT OPCODE last_lop_op; /* last list operator */
EXT bool in_my; /* we're compiling a "my" declaration */
+EXT HV * in_my_stash; /* declared class of this "my" declaration */
#ifdef FCRYPT
EXT I32 cryptseen; /* has fast crypt() been initialized? */
#endif
#define HINT_BLOCK_SCOPE 0x00000100
#define HINT_STRICT_SUBS 0x00000200
#define HINT_STRICT_VARS 0x00000400
+#define HINT_LOCALE 0x00000800
/**************************************************************************/
/* This regexp stuff is global since it always happens within 1 expr eval */
IEXT bool Idoextract;
IEXT bool Isawampersand; /* must save all match strings */
IEXT bool Isawstudy; /* do fbm_instr on all strings */
-IEXT bool Isawi; /* study must assume case insensitive */
IEXT bool Isawvec;
IEXT bool Iunsafe;
IEXT char * Iinplace;
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 */
+IEXT int Iperl_destruct_level IINIT(0); /* 0=none, 1=full, 2=full with checks */
/* magical thingies */
IEXT Time_t Ibasetime; /* $^T */
IEXT STRLEN Iorslen;
IEXT char * Iofmt; /* $# */
IEXT I32 Imaxsysfd IINIT(MAXSYSFD); /* top fd to pass to subprocesses */
-IEXT int Imultiline; /* $*--do strings hold >1 line? */
-IEXT U32 Istatusvalue; /* $? */
+IEXT int Imultiline; /* $*--do strings hold >1 line? */
+IEXT I32 Istatusvalue; /* $? */
+#ifdef VMS
+IEXT U32 Istatusvalue_vms;
+#endif
IEXT struct stat Istatcache; /* _ */
IEXT GV * Istatgv;
IEXT SV * Icurstname; /* name of current package */
IEXT AV * Ibeginav; /* names of BEGIN subroutines */
IEXT AV * Iendav; /* names of END subroutines */
+IEXT AV * Iinitav; /* names of INIT subroutines */
IEXT HV * Istrtab; /* shared string table */
/* memory management */
/* subprocess state */
IEXT AV * Ifdpid; /* keep fd-to-pid mappings for my_popen */
-IEXT HV * Ipidstatus; /* keep pid-to-status mappings for waitpid */
/* internal state */
IEXT VOL int Iin_eval; /* trap "fatal" errors? */
IEXT CONTEXT * Icxstack;
IEXT I32 Icxstack_ix IINIT(-1);
IEXT I32 Icxstack_max IINIT(128);
-IEXT Sigjmp_buf Itop_env;
+IEXT JMPENV Istart_env; /* empty startup sigjmp() environment */
+IEXT JMPENV * Itop_env; /* ptr. to current sigjmp() environment */
IEXT I32 Irunlevel;
/* stack stuff */
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 SV ** Imystack_max; /* stack->array_ary + stack->array_max */
/* format accumulators */
IEXT SV * Iformtarget;
IEXT AV * Ipreambleav;
IEXT int Ilaststatval IINIT(-1);
IEXT I32 Ilaststype IINIT(OP_STAT);
+IEXT SV * Imess_sv;
+
+#ifdef USE_THREADS
+/* threads stuff */
+IEXT SV * Ithrsv; /* holds struct thread for main thread */
+#endif /* USE_THREADS */
#undef IEXT
#undef IINIT
};
#endif
+#include "thread.h"
#include "pp.h"
#ifdef __cplusplus
/* The following must follow proto.h */
#ifdef DOINIT
+
EXT MGVTBL vtbl_sv = {magic_get,
magic_set,
magic_len,
0, 0};
-EXT MGVTBL vtbl_env = {0, 0, 0, 0, 0};
+EXT MGVTBL vtbl_env = {0, magic_set_all_env,
+ 0, magic_clear_all_env,
+ 0};
EXT MGVTBL vtbl_envelem = {0, magic_setenv,
0, magic_clearenv,
0};
EXT MGVTBL vtbl_dbline = {0, magic_setdbline,
0, 0, 0};
EXT MGVTBL vtbl_isa = {0, magic_setisa,
- 0, 0, 0};
+ 0, magic_setisa,
+ 0};
EXT MGVTBL vtbl_isaelem = {0, magic_setisa,
0, 0, 0};
EXT MGVTBL vtbl_arylen = {magic_getarylen,
EXT MGVTBL vtbl_uvar = {magic_getuvar,
magic_setuvar,
0, 0, 0};
+#ifdef USE_THREADS
+EXT MGVTBL vtbl_mutex = {0, 0, 0, 0, magic_mutexfree};
+#endif /* USE_THREADS */
+EXT MGVTBL vtbl_defelem = {magic_getdefelem,magic_setdefelem,
+ 0, 0, magic_freedefelem};
+
+#ifdef USE_LOCALE_COLLATE
+EXT MGVTBL vtbl_collxfrm = {0,
+ magic_setcollxfrm,
+ 0, 0, 0};
+#endif
#ifdef OVERLOAD
EXT MGVTBL vtbl_amagic = {0, magic_setamagic,
0, 0, magic_setamagic};
#endif /* OVERLOAD */
-#else
+#else /* !DOINIT */
+
EXT MGVTBL vtbl_sv;
EXT MGVTBL vtbl_env;
EXT MGVTBL vtbl_envelem;
EXT MGVTBL vtbl_fm;
EXT MGVTBL vtbl_uvar;
+#ifdef USE_THREADS
+EXT MGVTBL vtbl_mutex;
+#endif /* USE_THREADS */
+
+EXT MGVTBL vtbl_defelem;
+
+#ifdef USE_LOCALE_COLLATE
+EXT MGVTBL vtbl_collxfrm;
+#endif
+
#ifdef OVERLOAD
EXT MGVTBL vtbl_amagic;
EXT MGVTBL vtbl_amagicelem;
#endif /* OVERLOAD */
-#endif
+#endif /* !DOINIT */
#ifdef OVERLOAD
+
EXT long amagic_generation;
-#define NofAMmeth 29
+#define NofAMmeth 58
#ifdef DOINIT
-EXT char * AMG_names[NofAMmeth][2] = {
- {"fallback","abs"},
- {"bool", "nomethod"},
- {"\"\"", "0+"},
- {"+","+="},
- {"-","-="},
- {"*", "*="},
- {"/", "/="},
- {"%", "%="},
- {"**", "**="},
- {"<<", "<<="},
- {">>", ">>="},
- {"&", "&="},
- {"|", "|="},
- {"^", "^="},
- {"<", "<="},
- {">", ">="},
- {"==", "!="},
- {"<=>", "cmp"},
- {"lt", "le"},
- {"gt", "ge"},
- {"eq", "ne"},
- {"!", "~"},
- {"++", "--"},
- {"atan2", "cos"},
- {"sin", "exp"},
- {"log", "sqrt"},
- {"x","x="},
- {".",".="},
- {"=","neg"}
+EXTCONST char * AMG_names[NofAMmeth] = {
+ "fallback", "abs", /* "fallback" should be the first. */
+ "bool", "nomethod",
+ "\"\"", "0+",
+ "+", "+=",
+ "-", "-=",
+ "*", "*=",
+ "/", "/=",
+ "%", "%=",
+ "**", "**=",
+ "<<", "<<=",
+ ">>", ">>=",
+ "&", "&=",
+ "|", "|=",
+ "^", "^=",
+ "<", "<=",
+ ">", ">=",
+ "==", "!=",
+ "<=>", "cmp",
+ "lt", "le",
+ "gt", "ge",
+ "eq", "ne",
+ "!", "~",
+ "++", "--",
+ "atan2", "cos",
+ "sin", "exp",
+ "log", "sqrt",
+ "x", "x=",
+ ".", ".=",
+ "=", "neg"
};
#else
-EXT char * AMG_names[NofAMmeth][2];
+EXTCONST char * AMG_names[NofAMmeth];
#endif /* def INITAMAGIC */
-struct am_table {
+struct am_table {
long was_ok_sub;
long was_ok_am;
- CV* table[NofAMmeth*2];
+ U32 flags;
+ CV* table[NofAMmeth];
long fallback;
};
+struct am_table_short {
+ long was_ok_sub;
+ long was_ok_am;
+ U32 flags;
+};
typedef struct am_table AMT;
+typedef struct am_table_short AMTS;
#define AMGfallNEVER 1
#define AMGfallNO 2
#define AMGfallYES 3
+#define AMTf_AMAGIC 1
+#define AMT_AMAGIC(amt) ((amt)->flags & AMTf_AMAGIC)
+#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,
concat_amg, concat_ass_amg,
copy_amg, neg_amg
};
+
+/*
+ * some compilers like to redefine cos et alia as faster
+ * (and less accurate?) versions called F_cos et cetera (Quidquid
+ * latine dictum sit, altum viditur.) This trick collides with
+ * the Perl overloading (amg). The following #defines fool both.
+ */
+
+#ifdef _FASTMATH
+# ifdef atan2
+# define F_atan2_amg atan2_amg
+# endif
+# ifdef cos
+# define F_cos_amg cos_amg
+# endif
+# ifdef exp
+# define F_exp_amg exp_amg
+# endif
+# ifdef log
+# define F_log_amg log_amg
+# endif
+# ifdef pow
+# define F_pow_amg pow_amg
+# endif
+# ifdef sin
+# define F_sin_amg sin_amg
+# endif
+# ifdef sqrt
+# define F_sqrt_amg sqrt_amg
+# endif
+#endif /* _FASTMATH */
+
#endif /* OVERLOAD */
+#define PERLDB_ALL 0xff
+#define PERLDBf_SUB 0x01 /* Debug sub enter/exit. */
+#define PERLDBf_LINE 0x02 /* Keep line #. */
+#define PERLDBf_NOOPT 0x04 /* Switch off optimizations. */
+#define PERLDBf_INTER 0x08 /* Preserve more data for
+ later inspections. */
+#define PERLDBf_SUBLINE 0x10 /* Keep subr source lines. */
+#define PERLDBf_SINGLE 0x20 /* Start with single-step on. */
+
+#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))
+
+#ifdef USE_LOCALE_COLLATE
+EXT U32 collation_ix; /* Collation generation index */
+EXT char * collation_name; /* Name of current collation */
+EXT bool collation_standard INIT(TRUE); /* Assume simple collation */
+EXT Size_t collxfrm_base; /* Basic overhead in *xfrm() */
+EXT Size_t collxfrm_mult INIT(2); /* Expansion factor in *xfrm() */
+#endif /* USE_LOCALE_COLLATE */
+
+#ifdef USE_LOCALE_NUMERIC
+
+EXT char * numeric_name; /* Name of current numeric locale */
+EXT bool numeric_standard INIT(TRUE); /* Assume simple numerics */
+EXT bool numeric_local INIT(TRUE); /* Assume local numerics */
+
+#define SET_NUMERIC_STANDARD() \
+ STMT_START { \
+ if (! numeric_standard) \
+ perl_set_numeric_standard(); \
+ } STMT_END
+
+#define SET_NUMERIC_LOCAL() \
+ STMT_START { \
+ if (! numeric_local) \
+ perl_set_numeric_local(); \
+ } STMT_END
+
+#else /* !USE_LOCALE_NUMERIC */
+
+#define SET_NUMERIC_STANDARD() /**/
+#define SET_NUMERIC_LOCAL() /**/
+
+#endif /* !USE_LOCALE_NUMERIC */
+
#if !defined(PERLIO_IS_STDIO) && defined(HAS_ATTRIBUTE)
/*
* Now we have __attribute__ out of the way
#define printf PerlIO_stdoutf
#endif
+/*
+ * nice_chunk and nice_chunk size need to be set
+ * and queried under the protection of sv_mutex
+ */
+#define offer_nice_chunk(chunk, chunk_size) do { \
+ MUTEX_LOCK(&sv_mutex); \
+ if (!nice_chunk) { \
+ nice_chunk = (char*)(chunk); \
+ nice_chunk_size = (chunk_size); \
+ } \
+ MUTEX_UNLOCK(&sv_mutex); \
+ } while (0)
+
#endif /* Include guard */
projects / p5sagit/p5-mst-13.2.git / blobdiff