X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl.h;h=02a55f2a60d69ffbb1bdb12e059ac2d9a1a68ed4;hb=69969c6f8dad38fedd2ed2c653a7948030e5ecf8;hp=a697a332d504155a320d33030bb0db4b18c3c160;hpb=93a17b20b6d176db3f04f51a63b0a781e5ffd11c;p=p5sagit%2Fp5-mst-13.2.git diff --git a/perl.h b/perl.h index a697a33..02a55f2 100644 --- a/perl.h +++ b/perl.h @@ -1,54 +1,54 @@ -/* $RCSfile: perl.h,v $$Revision: 4.1 $$Date: 92/08/07 18:25:56 $ +/* perl.h * - * Copyright (c) 1991, Larry Wall + * Copyright (c) 1987-1994, 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. * - * $Log: perl.h,v $ - * Revision 4.1 92/08/07 18:25:56 lwall - * - * Revision 4.0.1.6 92/06/08 14:55:10 lwall - * patch20: added Atari ST portability - * patch20: bcopy() and memcpy() now tested for overlap safety - * patch20: Perl now distinguishes overlapped copies from non-overlapped - * patch20: removed implicit int declarations on functions - * - * Revision 4.0.1.5 91/11/11 16:41:07 lwall - * patch19: uts wrongly defines S_ISDIR() et al - * patch19: too many preprocessors can't expand a macro right in #if - * patch19: added little-endian pack/unpack options - * - * Revision 4.0.1.4 91/11/05 18:06:10 lwall - * patch11: various portability fixes - * patch11: added support for dbz - * patch11: added some support for 64-bit integers - * patch11: hex() didn't understand leading 0x - * - * Revision 4.0.1.3 91/06/10 01:25:10 lwall - * patch10: certain pattern optimizations were botched - * - * Revision 4.0.1.2 91/06/07 11:28:33 lwall - * patch4: new copyright notice - * patch4: made some allowances for "semi-standard" C - * patch4: many, many itty-bitty portability fixes - * - * Revision 4.0.1.1 91/04/11 17:49:51 lwall - * patch1: hopefully straightened out some of the Xenix mess - * - * Revision 4.0 91/03/20 01:37:56 lwall - * 4.0 baseline. - * */ +#ifndef H_PERL +#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 VOIDWANT 1 -#ifdef __cplusplus -#include "config_c++.h" -#else +#define VOIDUSED 1 #include "config.h" -#endif #ifndef BYTEORDER # define BYTEORDER 0x1234 @@ -67,38 +67,15 @@ * 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 */ -#define fatal Myfatal -#ifdef DOINIT -char Error[1]; -#endif - /* define this once if either system, instead of cluttering up the src */ #if defined(MSDOS) || defined(atarist) #define DOSISH 1 #endif -#if defined(__STDC__) || defined(_AIX) || defined(__stdc__) || defined(__cplusplus) +#if defined(__STDC__) || defined(vax11c) || defined(_AIX) || defined(__stdc__) || defined(__cplusplus) # define STANDARD_C 1 #endif -#if defined(STANDARD_C) -# define P(args) args -#else -# define P(args) () -#endif - #if defined(HASVOLATILE) || defined(STANDARD_C) # ifdef __cplusplus # define VOL // to temporarily suppress warnings @@ -109,46 +86,106 @@ char Error[1]; # define VOL #endif -#ifdef IAMSUID -# ifndef TAINT -# define TAINT -# 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() + +/* 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 -#ifdef TAINT -# define TAINT_IF(c) (tainted |= (c)) -# define TAINT_NOT (tainted = 0) -# define TAINT_PROPER(s) taint_proper(no_security, s) -# define TAINT_ENV() taint_env() +#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 -# define TAINT_IF(c) -# define TAINT_NOT -# define TAINT_PROPER(s) -# define TAINT_ENV() +# 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 -#ifndef HAS_VFORK -# define vfork fork +/* 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_GETPGRP2 -# ifndef HAS_GETPGRP -# define HAS_GETPGRP +#ifndef _TYPES_ /* If types.h defines this it's easy. */ +# ifndef major /* Does everyone's types.h define this? */ +# include # endif -# define getpgrp getpgrp2 #endif -#ifdef HAS_SETPGRP2 -# ifndef HAS_SETPGRP -# define HAS_SETPGRP -# endif -# define setpgrp setpgrp2 +#ifdef __cplusplus +# ifndef I_STDARG +# define I_STDARG 1 +# endif +#endif + +#ifdef I_STDARG +# include +#else +# ifdef I_VARARGS +# include +# endif #endif -#include +#include "perlio.h" + +#ifdef USE_NEXT_CTYPE + +#if NX_CURRENT_COMPILER_RELEASE >= 400 +#include +#else /* NX_CURRENT_COMPILER_RELEASE < 400 */ +#include +#endif /* NX_CURRENT_COMPILER_RELEASE >= 400 */ + +#else /* !USE_NEXT_CTYPE */ #include +#endif /* USE_NEXT_CTYPE */ + +#ifdef I_LOCALE +#include +#endif + +#ifdef METHOD /* Defined by OSF/1 v3.0 by ctype.h */ +#undef METHOD +#endif + #include -#ifndef MSDOS +#ifdef I_SYS_PARAM # ifdef PARAM_NEEDS_TYPES # include # endif @@ -157,22 +194,52 @@ char Error[1]; /* Use all the "standard" definitions? */ -#ifdef STANDARD_C +#if defined(STANDARD_C) && defined(I_STDLIB) # include +#endif /* STANDARD_C */ + +/* Maybe this comes after 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 Perl_malloc +# define realloc Perl_realloc +# define free Perl_free +# define calloc Perl_calloc +# 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) # include -# define MEM_SIZE size_t #else - typedef unsigned int MEM_SIZE; -#endif /* STANDARD_C */ +# include +#endif + +#if !defined(HAS_STRCHR) && defined(HAS_INDEX) && !defined(strchr) +#define strchr index +#define strrchr rindex +#endif -#if defined(HAS_MEMCMP) && defined(mips) && defined(ultrix) +#if defined(mips) && defined(ultrix) && !defined(__STDC__) # undef HAS_MEMCMP #endif +#ifdef I_MEMORY +# include +#endif + #ifdef HAS_MEMCPY -# ifndef STANDARD_C +# if !defined(STANDARD_C) && !defined(I_STRING) && !defined(I_MEMORY) # ifndef memcpy - extern char * memcpy P((char*, char*, int)); + extern char * memcpy _((char*, char*, int)); # endif # endif #else @@ -186,9 +253,9 @@ char Error[1]; #endif /* HAS_MEMCPY */ #ifdef HAS_MEMSET -# ifndef STANDARD_C +# if !defined(STANDARD_C) && !defined(I_STRING) && !defined(I_MEMORY) # ifndef memset - extern char *memset P((char*, int, int)); + extern char *memset _((char*, int, int)); # endif # endif # define memzero(d,l) memset(d,0,l) @@ -203,29 +270,22 @@ char Error[1]; #endif /* HAS_MEMSET */ #ifdef HAS_MEMCMP -# ifndef STANDARD_C +# if !defined(STANDARD_C) && !defined(I_STRING) && !defined(I_MEMORY) # ifndef memcmp - extern int memcmp P((char*, char*, int)); + extern int memcmp _((char*, char*, int)); # endif # endif #else # ifndef memcmp -# define memcmp(s1,s2,l) my_memcmp(s1,s2,l) +# define memcmp my_memcmp # 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 */ - -#ifndef HAS_MEMMOVE -# if defined(HAS_BCOPY) && defined(SAFE_BCOPY) +#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(SAFE_MEMCPY) +# if defined(HAS_MEMCPY) && defined(HAS_SAFE_MEMCPY) # define memmove(d,s,l) memcpy(d,s,l) # else # define memmove(d,s,l) my_bcopy(s,d,l) @@ -233,33 +293,30 @@ char Error[1]; # endif #endif -#ifndef _TYPES_ /* If types.h defines this it's easy. */ -# ifndef major /* Does everyone's types.h define this? */ -# include -# endif -#endif - #ifdef I_NETINET_IN # include #endif +#ifdef I_SYS_STAT #include +#endif + +/* The stat macros for Amdahl UTS, Unisoft System V/88 (and derivatives + like UTekV) are broken, sometimes giving false positives. Undefine + them here and let the code below set them to proper values. + + The ghs macro stands for GreenHills Software C-1.8.5 which + is the C compiler for sysV88 and the various derivatives. + This header file bug is corrected in gcc-2.5.8 and later versions. + --Kaveh Ghazi (ghazi@noc.rutgers.edu) 10/3/94. */ -#if defined(uts) || defined(UTekV) +#if defined(uts) || (defined(m88k) && defined(ghs)) # undef S_ISDIR # undef S_ISCHR # undef S_ISBLK # undef S_ISREG # undef S_ISFIFO # undef S_ISLNK -# define S_ISDIR(P) (((P)&S_IFMT)==S_IFDIR) -# define S_ISCHR(P) (((P)&S_IFMT)==S_IFCHR) -# define S_ISBLK(P) (((P)&S_IFMT)==S_IFBLK) -# define S_ISREG(P) (((P)&S_IFMT)==S_IFREG) -# define S_ISFIFO(P) (((P)&S_IFMT)==S_IFIFO) -# ifdef S_IFLNK -# define S_ISLNK(P) (((P)&S_IFMT)==S_IFLNK) -# endif #endif #ifdef I_TIME @@ -267,42 +324,74 @@ char Error[1]; #endif #ifdef I_SYS_TIME -# ifdef SYSTIMEKERNEL +# ifdef I_SYS_TIME_KERNEL # define KERNEL # endif # include -# ifdef SYSTIMEKERNEL +# ifdef I_SYS_TIME_KERNEL # undef KERNEL # endif #endif #ifndef MSDOS -#include +# if defined(HAS_TIMES) && defined(I_SYS_TIMES) +# include +# endif #endif #if defined(HAS_STRERROR) && (!defined(HAS_MKDIR) || !defined(HAS_RMDIR)) # undef HAS_STRERROR #endif +#ifndef HAS_MKFIFO +# ifndef mkfifo +# define mkfifo(path, mode) (mknod((path), (mode) | S_IFIFO, 0)) +# endif +#endif /* !HAS_MKFIFO */ + #include +#ifdef HAS_SOCKET +# ifdef I_NET_ERRNO +# include +# 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 extern int errno; /* ANSI allows errno to be an lvalue expr */ # endif #endif -#ifndef strerror -# ifdef HAS_STRERROR - char *strerror P((int)); -# else +#ifdef HAS_STRERROR +# ifdef VMS + char *strerror _((int,...)); +# else + char *strerror _((int)); +# endif +# ifndef Strerror +# define Strerror strerror +# endif +#else +# ifdef HAS_SYS_ERRLIST extern int sys_nerr; extern char *sys_errlist[]; -# define strerror(e) \ +# ifndef Strerror +# define Strerror(e) \ ((e) < 0 || (e) >= sys_nerr ? "(unknown)" : sys_errlist[e]) +# endif # endif #endif -#ifdef I_SYSIOCTL +#ifdef I_SYS_IOCTL # ifndef _IOCTL_ # include # endif @@ -312,67 +401,11 @@ char Error[1]; # ifdef HAS_SOCKETPAIR # undef HAS_SOCKETPAIR # endif -# ifdef HAS_NDBM -# undef HAS_NDBM +# ifdef I_NDBM +# undef I_NDBM # endif #endif -#ifdef WANT_DBZ -# include -# define SOME_DBM -# define dbm_fetch(db,dkey) fetch(dkey) -# define dbm_delete(db,dkey) fatal("dbz doesn't implement delete") -# define dbm_store(db,dkey,dcontent,flags) store(dkey,dcontent) -# define dbm_close(db) dbmclose() -# define dbm_firstkey(db) (fatal("dbz doesn't implement traversal"),fetch()) -# define nextkey() (fatal("dbz doesn't implement traversal"),fetch()) -# define dbm_nextkey(db) (fatal("dbz doesn't implement traversal"),fetch()) -# ifdef HAS_NDBM -# undef HAS_NDBM -# endif -# ifndef HAS_ODBM -# define HAS_ODBM -# endif -#else -# ifdef HAS_GDBM -# ifdef I_GDBM -# include -# endif -# define SOME_DBM -# ifdef HAS_NDBM -# undef HAS_NDBM -# endif -# ifdef HAS_ODBM -# undef HAS_ODBM -# endif -# else -# ifdef HAS_NDBM -# include -# define SOME_DBM -# ifdef HAS_ODBM -# undef HAS_ODBM -# endif -# else -# ifdef HAS_ODBM -# ifdef NULL -# undef NULL /* suppress redefinition message */ -# endif -# include -# ifdef NULL -# undef NULL -# endif -# define NULL 0 /* silly thing is, we don't even use this... */ -# define SOME_DBM -# define dbm_fetch(db,dkey) fetch(dkey) -# define dbm_delete(db,dkey) delete(dkey) -# define dbm_store(db,dkey,dcontent,flags) store(dkey,dcontent) -# define dbm_close(db) dbmclose() -# define dbm_firstkey(db) firstkey() -# endif /* HAS_ODBM */ -# endif /* HAS_NDBM */ -# endif /* HAS_GDBM */ -#endif /* WANT_DBZ */ - #if INTSIZE == 2 # define htoni htons # define ntohi ntohs @@ -381,13 +414,15 @@ char Error[1]; # define ntohi ntohl #endif +/* Configure already sets Direntry_t */ #if defined(I_DIRENT) # include -# define DIRENT dirent +# if defined(NeXT) && defined(I_SYS_DIR) /* NeXT needs dirent + sys/dir.h */ +# include +# endif #else # ifdef I_SYS_NDIR # include -# define DIRENT direct # else # ifdef I_SYS_DIR # ifdef hp9000s500 @@ -395,7 +430,6 @@ char Error[1]; # else # include # endif -# define DIRENT direct # endif # endif #endif @@ -511,50 +545,223 @@ char Error[1]; # undef ff_next #endif -#if defined(cray) || defined(gould) || defined(i860) +#if defined(cray) || defined(gould) || defined(i860) || defined(pyr) # define SLOPPYDIVIDE #endif -#if defined(cray) || defined(convex) || defined (uts) || BYTEORDER > 0xffff -# define QUAD +#if defined(cray) || defined(convex) || BYTEORDER > 0xffff +# define HAS_QUAD #endif -#ifdef QUAD +#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 int +# define Quad_t int # else -# if defined(convex) || defined (uts) -# define quad long long +# if defined(convex) +# define Quad_t long long # else -# define quad long +# 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 +#else +#ifdef I_VALUES +# include +#endif #endif -#ifdef VOIDSIG -# define VOIDRET void +#ifdef CHAR_MAX +# define PERL_CHAR_MAX CHAR_MAX #else -# define VOIDRET int +# ifdef MAXCHAR /* Often used in */ +# define PERL_CHAR_MAX MAXCHAR +# else +# define PERL_CHAR_MAX ((char) ((~(unsigned char)0) >> 1)) +# endif #endif -#ifdef DOSISH -# include "dosish.h" +#ifdef CHAR_MIN +# define PERL_CHAR_MIN CHAR_MIN #else -# include "unixish.h" +# ifdef MINCHAR +# define PERL_CHAR_MIN MINCHAR +# else +# define PERL_CHAR_MIN (-PERL_CHAR_MAX - ((3 & -1) == 3)) +# endif #endif -#ifndef HAS_PAUSE -#define pause() sleep((32767<<16)+32767) +#ifdef UCHAR_MAX +# define PERL_UCHAR_MAX UCHAR_MAX +#else +# ifdef MAXUCHAR +# define PERL_UCHAR_MAX MAXUCHAR +# else +# define PERL_UCHAR_MAX (~(unsigned char)0) +# 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 +#define PERL_UCHAR_MIN 0 + +#ifdef SHORT_MAX +# define PERL_SHORT_MAX SHORT_MAX +#else +# ifdef MAXSHORT /* Often used in */ +# define PERL_SHORT_MAX MAXSHORT +# else +# define PERL_SHORT_MAX ((short) ((~(unsigned short)0) >> 1)) +# endif +#endif + +#ifdef SHORT_MIN +# define PERL_SHORT_MIN SHORT_MIN +#else +# ifdef MINSHORT +# define PERL_SHORT_MIN MINSHORT +# else +# define PERL_SHORT_MIN (-PERL_SHORT_MAX - ((3 & -1) == 3)) +# endif +#endif + +#ifdef USHORT_MAX +# define PERL_USHORT_MAX USHORT_MAX +#else +# ifdef MAXUSHORT +# define PERL_USHORT_MAX MAXUSHORT +# else +# define PERL_USHORT_MAX (~(unsigned short)0) +# endif +#endif + +#define PERL_USHORT_MIN 0 + +#ifdef INT_MAX +# define PERL_INT_MAX INT_MAX +#else +# ifdef MAXINT /* Often used in */ +# define PERL_INT_MAX MAXINT +# else +# define PERL_INT_MAX ((int) ((~(unsigned int)0) >> 1)) +# endif +#endif + +#ifdef INT_MIN +# define PERL_INT_MIN INT_MIN +#else +# ifdef MININT +# define PERL_INT_MIN MININT +# else +# define PERL_INT_MIN (-PERL_INT_MAX - ((3 & -1) == 3)) +# endif +#endif + +#ifdef UINT_MAX +# define PERL_UINT_MAX UINT_MAX +#else +# ifdef MAXUINT +# define PERL_UINT_MAX MAXUINT +# else +# define PERL_UINT_MAX (~(unsigned int)0) +# endif +#endif + +#define PERL_UINT_MIN 0 + +#ifdef LONG_MAX +# define PERL_LONG_MAX LONG_MAX +#else +# ifdef MAXLONG /* Often used in */ +# define PERL_LONG_MAX MAXLONG +# else +# define PERL_LONG_MAX ((long) ((~(unsigned long)0) >> 1)) +# endif +#endif + +#ifdef LONG_MIN +# define PERL_LONG_MIN LONG_MIN +#else +# ifdef MINLONG +# define PERL_LONG_MIN MINLONG +# else +# define PERL_LONG_MIN (-PERL_LONG_MAX - ((3 & -1) == 3)) +# endif +#endif + +#ifdef ULONG_MAX +# define PERL_ULONG_MAX ULONG_MAX +#else +# ifdef MAXULONG +# define PERL_ULONG_MAX MAXULONG +# else +# define PERL_ULONG_MAX (~(unsigned long)0) +# endif +#endif + +#define PERL_ULONG_MIN 0L + +#ifdef HAS_QUAD +# ifdef QUAD_MAX +# define PERL_QUAD_MAX QUAD_MAX +# else +# define PERL_QUAD_MAX ((IV) ((~(UV)0) >> 1)) +# endif + +# ifdef QUAD_MIN +# define PERL_QUAD_MIN QUAD_MIN +# else +# define PERL_QUAD_MIN (-PERL_QUAD_MAX - ((3 & -1) == 3)) +# endif + +# ifdef UQUAD_MAX +# define PERL_UQUAD_MAX UQUAD_MAX +# else +# define PERL_UQUAD_MAX (~(UV)0) +# endif + +# define PERL_UQUAD_MIN 0 #endif typedef MEM_SIZE STRLEN; @@ -570,25 +777,24 @@ typedef struct pmop PMOP; 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 io IO; typedef struct sv SV; typedef struct av AV; typedef struct hv HV; 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 magic MAGIC; +typedef struct xrv XRV; typedef struct xpv XPV; typedef struct xpviv XPVIV; typedef struct xpvnv XPVNV; @@ -600,13 +806,61 @@ typedef struct xpvgv XPVGV; typedef struct xpvcv XPVCV; typedef struct xpvbm XPVBM; typedef struct xpvfm XPVFM; +typedef struct xpvio XPVIO; typedef struct mgvtbl MGVTBL; typedef union any ANY; #include "handy.h" + +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 +# 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 { void* any_ptr; I32 any_i32; + IV any_iv; + long any_long; + void (*any_dptr) _((void*)); }; #include "regexp.h" @@ -623,16 +877,13 @@ union any { #include "mg.h" #include "scope.h" -#if defined(iAPX286) || defined(M_I286) || defined(I80286) -# define I286 +/* work around some libPW problems */ +#ifdef DOINIT +EXT char Error[1]; #endif -#ifndef STANDARD_C -# ifdef CHARSPRINTF - char *sprintf P((char *, ...)); -# else - int sprintf P((char *, ...)); -# endif +#if defined(iAPX286) || defined(M_I286) || defined(I80286) +# define I286 #endif #if defined(htonl) && !defined(HAS_HTONL) @@ -694,10 +945,35 @@ union any { #define U_I(what) ((unsigned int)(what)) #define U_L(what) ((U32)(what)) #else -U32 cast_ulong P((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 + extern "C" { +# endif +U32 cast_ulong _((double)); +# 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)); +IV cast_iv _((double)); +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 { @@ -710,20 +986,21 @@ struct Outrec { # define MAXSYSFD 2 #endif -#ifndef DOSISH -#define TMPPATH "/tmp/perl-eXXXXXX" -#else -#define TMPPATH "plXXXXXX" -#endif /* MSDOS */ +#ifndef TMPPATH +# define TMPPATH "/tmp/perl-eXXXXXX" +#endif #ifndef __cplusplus -UIDTYPE getuid P(()); -UIDTYPE geteuid P(()); -GIDTYPE getgid P(()); -GIDTYPE getegid P(()); +Uid_t getuid _((void)); +Uid_t geteuid _((void)); +Gid_t getgid _((void)); +Gid_t getegid _((void)); #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 @@ -734,7 +1011,7 @@ GIDTYPE getegid P(()); #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 @@ -742,6 +1019,7 @@ GIDTYPE getegid P(()); #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 #else #define DEB(a) #define DEBUG(a) @@ -760,29 +1038,34 @@ GIDTYPE getegid P(()); #define DEBUG_L(a) #define DEBUG_H(a) #define DEBUG_X(a) +#define DEBUG_D(a) #endif #define YYMAXDEPTH 300 +#ifndef assert /* might have been included somehow */ #define assert(what) DEB( { \ if (!(what)) { \ - fatal("Assertion failed: file \"%s\", line %d", \ + croak("Assertion failed: file \"%s\", line %d", \ __FILE__, __LINE__); \ exit(1); \ }}) +#endif struct ufuncs { - I32 (*uf_val)P((I32, SV*)); - I32 (*uf_set)P((I32, SV*)); - I32 uf_index; + I32 (*uf_val)_((IV, SV*)); + I32 (*uf_set)_((IV, SV*)); + IV uf_index; }; /* Fix these up for __STDC__ */ -char *mktemp P((char*)); -double atof P((const char*)); +#ifndef __cplusplus +char *mktemp _((char*)); +double atof _((const char*)); +#endif #ifndef STANDARD_C /* All of these are in stdlib.h or time.h for ANSI C */ -long time(); +Time_t time(); struct tm *gmtime(), *localtime(); char *strchr(), *strrchr(); char *strcpy(), *strcat(); @@ -795,53 +1078,67 @@ char *strcpy(), *strcat(); # ifdef __cplusplus extern "C" { # endif - double exp P((double)); - double log P((double)); - double sqrt P((double)); - double modf P((double,int*)); - double sin P((double)); - double cos P((double)); - double atan2 P((double,double)); - double pow P((double,double)); + double exp _((double)); + double log _((double)); + double sqrt _((double)); + double modf _((double,double*)); + double sin _((double)); + double cos _((double)); + double atan2 _((double,double)); + double pow _((double,double)); # ifdef __cplusplus }; # 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 -char *crypt P((const char*, const char*)); -char *getenv P((const char*)); -long lseek P((int,int,int)); -char *getlogin P((void)); - -#ifdef EUNICE +#ifdef UNLINK_ALL_VERSIONS /* Currently only makes sense for VMS */ #define UNLINK unlnk -int unlnk P((char*)); +I32 unlnk _((char*)); #else #define UNLINK unlink #endif #ifndef HAS_SETREUID -#ifdef HAS_SETRESUID -#define setreuid(r,e) setresuid(r,e,-1) -#define HAS_SETREUID -#endif +# ifdef HAS_SETRESUID +# define setreuid(r,e) setresuid(r,e,(Uid_t)-1) +# define HAS_SETREUID +# endif #endif #ifndef HAS_SETREGID -#ifdef HAS_SETRESGID -#define setregid(r,e) setresgid(r,e,-1) -#define HAS_SETREGID -#endif +# ifdef HAS_SETRESGID +# define setregid(r,e) setresgid(r,e,(Gid_t)-1) +# define HAS_SETREGID +# endif #endif #define SCAN_DEF 0 #define SCAN_TR 1 #define SCAN_REPL 2 +#ifdef MYMALLOC +# ifndef DEBUGGING_MSTATS +# define DEBUGGING_MSTATS +# endif +#endif + #ifdef DEBUGGING -#define PAD_SV(po) pad_sv(po) +# ifndef register +# define register +# endif +# define PAD_SV(po) pad_sv(po) #else -#define PAD_SV(po) curpad[po] +# define PAD_SV(po) curpad[po] #endif /****************/ @@ -849,18 +1146,43 @@ int unlnk P((char*)); /****************/ /* global state */ -EXT PerlInterpreter *curinterp; /* currently running interpreter */ +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__)) extern char ** environ; /* environment variables supplied via exec */ +#else +# if defined(NeXT) && defined(__DYNAMIC__) + +# include +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 int egid; /* current effective group id */ EXT bool nomemok; /* let malloc context handle nomem */ EXT U32 an; /* malloc sequence number */ -EXT U32 cop_seq; /* statement sequence number */ -EXT U32 op_seq; /* op sequence number */ +EXT U32 cop_seqmax; /* statement 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 */ @@ -891,13 +1213,15 @@ EXT SV ** curpad; /* 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; -#ifndef MSDOS +#ifdef HAS_TIMES EXT struct tms timesbuf; #endif +EXT STRLEN na; /* for use in SvPV when length is Not Applicable */ /* for tmp use in stupid debuggers */ EXT int * di; @@ -911,10 +1235,20 @@ EXT char * hexdigit INIT("0123456789abcdef0123456789ABCDEFx"); EXT char * patleave INIT("\\.^$@dDwWsSbB+*?|()-nrtfeaxc0123456789[{]}"); EXT char * vert INIT("|"); -EXT char * warn_nl +EXT char warn_uninit[] + INIT("Use of uninitialized value"); +EXT char warn_nosemi[] + INIT("Semicolon seems to be missing"); +EXT char warn_reserved[] + INIT("Unquoted string \"%s\" may clash with future reserved word"); +EXT char warn_nl[] INIT("Unsuccessful %s on filename containing newline"); +EXT char no_wrongref[] + INIT("Can't use %s ref as %s ref"); +EXT char no_symref[] + 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 to create a symbol"); + INIT("Can't use an undefined value as %s reference"); EXT char no_aelem[] INIT("Modification of non-creatable array value attempted, subscript %d"); EXT char no_helem[] @@ -924,13 +1258,15 @@ EXT char no_modify[] EXT char no_mem[] INIT("Out of memory!\n"); EXT char no_security[] - INIT("Insecure dependency in %s"); + INIT("Insecure dependency in %s%s"); EXT char no_sock_func[] INIT("Unsupported socket function \"%s\" called"); EXT char no_dir_func[] 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; @@ -941,25 +1277,15 @@ EXT SV sv_yes; #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[]; -#endif - -#ifdef DOINIT - EXT char coeff[] = { /* hash function coefficients */ - 61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1, - 61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1, - 61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1, - 61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1, - 61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1, - 61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1, - 61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1, - 61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1}; -#else - EXT char coeff[]; +EXT int sig_num[]; +EXT SV * psig_ptr[]; +EXT SV * psig_name[]; #endif #ifdef DOINIT @@ -1040,24 +1366,67 @@ EXT unsigned char freq[] = { /* letter frequencies for mixed English/C */ EXT unsigned char freq[]; #endif +#ifdef DEBUGGING +#ifdef DOINIT +EXT char* block_type[] = { + "NULL", + "SUB", + "EVAL", + "LOOP", + "SUBST", + "BLOCK", +}; +#else +EXT char* block_type[]; +#endif +#endif + /*****************************************************************************/ /* This lexer/parser stuff is currently global since yacc is hard to reenter */ /*****************************************************************************/ +/* XXX This needs to be revisited, since BEGIN makes yacc re-enter... */ + +#include "perly.h" typedef enum { XOPERATOR, XTERM, - XBLOCK, XREF, + XSTATE, + XBLOCK, + XTERMBLOCK } expectation; -EXT FILE * VOL rsfp INIT(Nullfp); +EXT U32 lex_state; /* next token is determined */ +EXT U32 lex_defer; /* state after determined token */ +EXT expectation lex_expect; /* expect after determined token */ +EXT I32 lex_brackets; /* bracket count */ +EXT I32 lex_formbrack; /* bracket count at outer format level */ +EXT I32 lex_fakebrack; /* outer bracket is mere delimiter */ +EXT I32 lex_casemods; /* casemod count */ +EXT I32 lex_dojoin; /* doing an array interpolation */ +EXT I32 lex_starts; /* how many interps done on level */ +EXT SV * lex_stuff; /* runtime pattern from m// or s/// */ +EXT SV * lex_repl; /* runtime replacement from s/// */ +EXT OP * lex_op; /* extra info to pass back on op */ +EXT OP * lex_inpat; /* in pattern $) and $| are special */ +EXT I32 lex_inwhat; /* what kind of quoting are we in */ +EXT char * lex_brackstack; /* what kind of brackets to pop */ +EXT char * lex_casestack; /* what kind of case mods in effect */ + +/* What we know when we're in LEX_KNOWNEXT state. */ +EXT YYSTYPE nextval[5]; /* value of next token, if any */ +EXT I32 nexttype[5]; /* type of next token */ +EXT I32 nexttoke; + +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(XBLOCK); /* how to interpret ambiguous tokens */ +EXT expectation expect INIT(XSTATE); /* how to interpret ambiguous tokens */ +EXT AV * rsfp_filters; EXT I32 multi_start; /* 1st line of multi-line string */ EXT I32 multi_end; /* last line of multi-line string */ @@ -1069,22 +1438,39 @@ EXT I32 error_count; /* how many errors so far, max 10 */ 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 * comppadname; /* variable names for "my" variables */ -EXT I32 comppadnamefill;/* last "introduced" variable offset */ +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 I32 pad_reset_pending; /* reset pad on next attempted alloc */ EXT COP compiling; -EXT SV * evstr; /* op_fold_const() temp string cache */ EXT I32 thisexpr; /* name id for nothing_in_common() */ EXT char * last_uni; /* position of last named-unary operator */ EXT char * last_lop; /* position of last list operator */ -EXT bool in_format; /* we're compiling a run_format */ +EXT OPCODE last_lop_op; /* last list operator */ EXT bool in_my; /* we're compiling a "my" declaration */ #ifdef FCRYPT EXT I32 cryptseen; /* has fast crypt() been initialized? */ #endif +EXT U32 hints; /* various compilation flags */ + + /* Note: the lowest 8 bits are reserved for + stuffing into op->op_private */ +#define HINT_INTEGER 0x00000001 +#define HINT_STRICT_REFS 0x00000002 + +#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 */ /**************************************************************************/ @@ -1095,27 +1481,27 @@ EXT char * regxend; /* End of input for compile */ EXT I32 regnpar; /* () count. */ EXT char * regcode; /* Code-emit pointer; ®dummy = don't. */ EXT I32 regsize; /* Code size. */ -EXT I32 regfold; /* are we folding? */ -EXT I32 regsawbracket; /* Did we do {d,d} trick? */ +EXT I32 regnaughty; /* How bad is this pattern? */ EXT I32 regsawback; /* Did we see \1, ...? */ EXT char * reginput; /* String-input pointer. */ -EXT char regprev; /* char before regbol, \n if none */ EXT char * regbol; /* Beginning of input, for ^ check. */ EXT char * regeol; /* End of input, for $ check. */ EXT char ** regstartp; /* Pointer to startp array. */ EXT char ** regendp; /* Ditto for endp. */ -EXT char * reglastparen; /* Similarly for lastparen. */ +EXT U32 * reglastparen; /* Similarly for lastparen. */ EXT char * regtill; /* How far we are required to go. */ -EXT I32 regmyp_size; -EXT char ** regmystartp; -EXT char ** regmyendp; +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 */ /***********************************************/ -#ifdef EMBEDDED +#ifdef MULTIPLICITY #define IEXT #define IINIT(x) struct interpreter { @@ -1131,52 +1517,56 @@ IEXT GV * Ienvgv; 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 Iminus_p; IEXT bool Iminus_l; IEXT bool Iminus_a; +IEXT bool Iminus_F; IEXT bool Idoswitches; IEXT bool Idowarn; IEXT bool Idoextract; -IEXT bool Iallgvs; /* init all customary symbols in symbol table?*/ 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 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 I32 Iarybase; /* $[ */ +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 I32 Irslen IINIT(1); -IEXT bool Irspara; +IEXT SV * Irs; /* $/ */ IEXT char * Iofs; /* $, */ -IEXT I32 Iofslen; +IEXT STRLEN Iofslen; IEXT char * Iors; /* $\ */ -IEXT I32 Iorslen; +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 U16 Istatusvalue; /* $? */ +IEXT U32 Istatusvalue; /* $? */ IEXT struct stat Istatcache; /* _ */ IEXT GV * Istatgv; @@ -1188,7 +1578,6 @@ IEXT GV * Ilast_in_gv; IEXT GV * Idefgv; IEXT GV * Iargvgv; IEXT GV * Idefoutgv; -IEXT GV * Icuroutgv; IEXT GV * Iargvoutgv; /* shortcuts to regexp stuff */ @@ -1201,6 +1590,9 @@ IEXT I32 * Iscreamnext; 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; @@ -1218,15 +1610,17 @@ IEXT HV * Idebstash; /* symbol table for perldb package */ 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 * Ifreestrroot; IEXT SV ** Itmps_stack; IEXT I32 Itmps_ix IINIT(-1); IEXT I32 Itmps_floor IINIT(-1); -IEXT I32 Itmps_max IINIT(-1); +IEXT I32 Itmps_max; +IEXT I32 Isv_count; /* how many SV* are currently allocated */ +IEXT I32 Isv_objcount; /* how many objects are currently allocated */ +IEXT SV* Isv_root; /* storage for SVs belonging to interp */ +IEXT SV* Isv_arenaroot; /* list of areas for garbage collection */ /* funky return mechanisms */ IEXT I32 Ilastspbase; @@ -1238,15 +1632,14 @@ 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 OP * Irestartop; /* Are we propagating an error from fatal? */ +IEXT VOL int Iin_eval; /* trap "fatal" errors? */ +IEXT OP * Irestartop; /* Are we propagating an error from croak? */ IEXT int Idelaymagic; /* ($<,$>) = ... */ -IEXT bool Idirty; /* clean before rerunning */ -IEXT bool Ilocalizing; /* are we processing a local() list? */ -#ifdef TAINT +IEXT bool Idirty; /* In the middle of tearing things down? */ +IEXT U8 Ilocalizing; /* are we processing a local() list? */ IEXT bool Itainted; /* using variables controlled by $< */ -IEXT bool Itaintanyway; /* force taint checks when !set?id */ -#endif +IEXT bool Itainting; /* doing taint checks */ +IEXT char * Iop_mask IINIT(NULL); /* masked operations for safe evals */ /* trace state */ IEXT I32 Idlevel; @@ -1255,30 +1648,33 @@ IEXT char * Idebname; IEXT char * Idebdelim; /* current interpreter roots */ -IEXT OP * VOL Imain_root; -IEXT OP * VOL Imain_start; -IEXT OP * VOL Ieval_root; -IEXT OP * VOL Ieval_start; +IEXT CV * Imain_cv; +IEXT OP * Imain_root; +IEXT OP * Imain_start; +IEXT OP * Ieval_root; +IEXT OP * Ieval_start; /* 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 SV ** Imystack_max; /* stack->array_ary + stack->array_max */ /* format accumulators */ -IEXT SV * formtarget; -IEXT SV * bodytarget; -IEXT SV * toptarget; +IEXT SV * Iformtarget; +IEXT SV * Ibodytarget; +IEXT SV * Itoptarget; /* statics moved here for shared library purposes */ IEXT SV Istrchop; /* return value from chop */ @@ -1295,17 +1691,17 @@ IEXT AV * Isortstack; /* temp stack during pp_sort() */ IEXT AV * Isignalstack; /* temp stack during sighandler() */ IEXT SV * Imystrk; /* temp key string for do_each() */ IEXT I32 Idumplvl; /* indentation level on syntax tree dump */ -IEXT I32 Idbmrefcnt; /* safety check for old dbm */ 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); #undef IEXT #undef IINIT -#ifdef EMBEDDED +#ifdef MULTIPLICITY }; #else struct interpreter { @@ -1321,6 +1717,14 @@ extern "C" { #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 + #ifdef __cplusplus }; #endif @@ -1328,35 +1732,181 @@ extern "C" { /* The following must follow proto.h */ #ifdef DOINIT -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, 0, 0, 0}; -MGVTBL vtbl_sig = {0, 0, 0, 0, 0}; -MGVTBL vtbl_sigelem = {0, magic_setsig, 0, 0, 0}; -MGVTBL vtbl_dbm = {0, 0, 0, 0, 0}; -MGVTBL vtbl_dbmelem = {0, magic_setdbm, 0, 0, 0}; -MGVTBL vtbl_dbline = {0, magic_setdbline, 0, 0, 0}; -MGVTBL vtbl_arylen = {magic_getarylen,magic_setarylen, 0, 0, 0}; -MGVTBL vtbl_glob = {magic_getglob, magic_setglob, 0, 0, 0}; -MGVTBL vtbl_mglob = {0, magic_setmglob, 0, 0, 0}; -MGVTBL vtbl_substr = {0, magic_setsubstr, 0, 0, 0}; -MGVTBL vtbl_vec = {0, magic_setvec, 0, 0, 0}; -MGVTBL vtbl_bm = {0, magic_setbm, 0, 0, 0}; -MGVTBL vtbl_uvar = {magic_getuvar, magic_setuvar, 0, 0, 0}; +EXT MGVTBL vtbl_sv = {magic_get, + magic_set, + magic_len, + 0, 0}; +EXT MGVTBL vtbl_env = {0, 0, 0, 0, 0}; +EXT MGVTBL vtbl_envelem = {0, magic_setenv, + 0, magic_clearenv, + 0}; +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}; +EXT MGVTBL vtbl_packelem = {magic_getpack, + magic_setpack, + 0, magic_clearpack, + 0}; +EXT MGVTBL vtbl_dbline = {0, magic_setdbline, + 0, 0, 0}; +EXT MGVTBL vtbl_isa = {0, magic_setisa, + 0, 0, 0}; +EXT MGVTBL vtbl_isaelem = {0, magic_setisa, + 0, 0, 0}; +EXT MGVTBL vtbl_arylen = {magic_getarylen, + magic_setarylen, + 0, 0, 0}; +EXT MGVTBL vtbl_glob = {magic_getglob, + magic_setglob, + 0, 0, 0}; +EXT MGVTBL vtbl_mglob = {0, magic_setmglob, + 0, 0, 0}; +EXT MGVTBL vtbl_taint = {magic_gettaint,magic_settaint, + 0, 0, 0}; +EXT MGVTBL vtbl_substr = {0, magic_setsubstr, + 0, 0, 0}; +EXT MGVTBL vtbl_vec = {0, magic_setvec, + 0, 0, 0}; +EXT MGVTBL vtbl_pos = {magic_getpos, + magic_setpos, + 0, 0, 0}; +EXT MGVTBL vtbl_bm = {0, magic_setbm, + 0, 0, 0}; +EXT MGVTBL vtbl_uvar = {magic_getuvar, + magic_setuvar, + 0, 0, 0}; + +#ifdef OVERLOAD +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_sv; EXT MGVTBL vtbl_env; EXT MGVTBL vtbl_envelem; EXT MGVTBL vtbl_sig; EXT MGVTBL vtbl_sigelem; -EXT MGVTBL vtbl_dbm; -EXT MGVTBL vtbl_dbmelem; +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_taint; EXT MGVTBL vtbl_substr; EXT MGVTBL vtbl_vec; +EXT MGVTBL vtbl_pos; EXT MGVTBL vtbl_bm; EXT MGVTBL vtbl_uvar; + +#ifdef OVERLOAD +EXT MGVTBL vtbl_amagic; +EXT MGVTBL vtbl_amagicelem; +#endif /* OVERLOAD */ + #endif + +#ifdef OVERLOAD +EXT long amagic_generation; + +#define NofAMmeth 29 +#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"} +}; +#else +EXT char * AMG_names[NofAMmeth][2]; +#endif /* def INITAMAGIC */ + +struct am_table { + long was_ok_sub; + long was_ok_am; + CV* table[NofAMmeth*2]; + long fallback; +}; +typedef struct am_table AMT; + +#define AMGfallNEVER 1 +#define AMGfallNO 2 +#define AMGfallYES 3 + +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, + mod_amg, mod_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 +}; +#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 */ +