/* 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.
* 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
*/
/* 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
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)
-# else
-# define memzero(d,l) my_bzero(d,l)
-# endif
-# endif
+# define memset(d,c,l) my_memset(d,c,l)
#endif /* HAS_MEMSET */
#if !defined(HAS_MEMMOVE) && !defined(memmove)
# endif
#endif /* HAS_MEMCMP && HAS_SANE_MEMCMP */
+#ifndef memzero
+# ifdef HAS_MEMSET
+# define memzero(d,l) memset(d,0,l)
+# else
+# ifdef HAS_BZERO
+# define memzero(d,l) bzero(d,l)
+# else
+# 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)
# 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
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;
# 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*));
};
+/* 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
# ifndef register
# define register
# endif
-# ifdef MYMALLOC
-# ifndef DEBUGGING_MSTATS
-# define DEBUGGING_MSTATS
-# endif
-# endif
# define PAD_SV(po) pad_sv(po)
#else
# define PAD_SV(po) curpad[po]
EXT PerlInterpreter * curinterp; /* currently running interpreter */
/* 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__)
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 */
/* temp space */
EXT SV * Sv;
EXT XPV * Xpv;
-EXT char buf[2048]; /* should be longer than PATH_MAX */
EXT char tokenbuf[256];
EXT struct stat statbuf;
#ifdef HAS_TIMES
EXTCONST char * patleave INIT("\\.^$@dDwWsSbB+*?|()-nrtfeaxc0123456789[{]}");
EXTCONST char * vert INIT("|");
-EXTCONST char warn_uninit[]
+EXTCONST char warn_uninit[]
INIT("Use of uninitialized value");
-EXTCONST char warn_nosemi[]
+EXTCONST char warn_nosemi[]
INIT("Semicolon seems to be missing");
-EXTCONST char warn_reserved[]
+EXTCONST char warn_reserved[]
INIT("Unquoted string \"%s\" may clash with future reserved word");
-EXTCONST char warn_nl[]
+EXTCONST char warn_nl[]
INIT("Unsuccessful %s on filename containing newline");
-EXTCONST char no_wrongref[]
+EXTCONST char no_wrongref[]
INIT("Can't use %s ref as %s ref");
-EXTCONST char no_symref[]
+EXTCONST char no_symref[]
INIT("Can't use string (\"%.32s\") as %s ref while \"strict refs\" in use");
-EXTCONST char no_usym[]
+EXTCONST char no_usym[]
INIT("Can't use an undefined value as %s reference");
-EXTCONST char no_aelem[]
+EXTCONST char no_aelem[]
INIT("Modification of non-creatable array value attempted, subscript %d");
-EXTCONST char no_helem[]
+EXTCONST char no_helem[]
INIT("Modification of non-creatable hash value attempted, subscript \"%s\"");
-EXTCONST char no_modify[]
+EXTCONST char no_modify[]
INIT("Modification of a read-only value attempted");
-EXTCONST char no_mem[]
+EXTCONST char no_mem[]
INIT("Out of memory!\n");
-EXTCONST char no_security[]
+EXTCONST char no_security[]
INIT("Insecure dependency in %s%s");
-EXTCONST char no_sock_func[]
+EXTCONST char no_sock_func[]
INIT("Unsupported socket function \"%s\" called");
-EXTCONST char no_dir_func[]
+EXTCONST char no_dir_func[]
INIT("Unsupported directory function \"%s\" called");
-EXTCONST char no_func[]
+EXTCONST char no_func[]
INIT("The %s function is unimplemented");
-EXTCONST char no_myglob[]
+EXTCONST char no_myglob[]
INIT("\"my\" variable %s can't be in a package");
EXT SV sv_undef;
IEXT PerlIO * Ie_fp;
IEXT U32 Iperldb;
/* This value may be raised by extensions for testing purposes */
-IEXT int Iperl_destruct_level IINIT(1); /* 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;
/* 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 * Ipreambleav;
IEXT int Ilaststatval IINIT(-1);
IEXT I32 Ilaststype IINIT(OP_STAT);
+IEXT SV * Imess_sv;
#undef IEXT
#undef IINIT
magic_set,
magic_len,
0, 0};
-EXT MGVTBL vtbl_env = {0, 0, 0, 0, 0};
+EXT MGVTBL vtbl_env = {0, 0, 0, magic_clear_all_env,
+ 0};
EXT MGVTBL vtbl_envelem = {0, magic_setenv,
0, magic_clearenv,
0};
EXT MGVTBL vtbl_uvar = {magic_getuvar,
magic_setuvar,
0, 0, 0};
-EXT MGVTBL vtbl_itervar = {magic_getitervar,magic_setitervar,
- 0, 0, magic_freeitervar};
+EXT MGVTBL vtbl_defelem = {magic_getdefelem,magic_setdefelem,
+ 0, 0, magic_freedefelem};
#ifdef USE_LOCALE_COLLATE
EXT MGVTBL vtbl_collxfrm = {0,
EXT MGVTBL vtbl_bm;
EXT MGVTBL vtbl_fm;
EXT MGVTBL vtbl_uvar;
-EXT MGVTBL vtbl_itervar;
+EXT MGVTBL vtbl_defelem;
#ifdef USE_LOCALE_COLLATE
EXT MGVTBL vtbl_collxfrm;
#endif /* !DOINIT */
#ifdef OVERLOAD
+
EXT long amagic_generation;
#define NofAMmeth 58
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 */