-/* $Header: perl.h,v 3.0.1.6 90/03/12 16:40:43 lwall Locked $
+/* perl.h
*
- * Copyright (c) 1989, Larry Wall
+ * Copyright (c) 1987-1997, Larry Wall
*
- * You may distribute under the terms of the GNU General Public License
- * as specified in the README file that comes with the perl 3.0 kit.
+ * 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 3.0.1.6 90/03/12 16:40:43 lwall
- * patch13: did some ndir straightening up for Xenix
- *
- * Revision 3.0.1.5 90/02/28 17:52:28 lwall
- * patch9: Configure now determines whether volatile is supported
- * patch9: volatilized some more variables for super-optimizing compilers
- * patch9: unused VREG symbol deleted
- * patch9: perl can now start up other interpreters scripts
- * patch9: you may now undef $/ to have no input record separator
- * patch9: nested evals clobbered their longjmp environment
- *
- * Revision 3.0.1.4 89/12/21 20:07:35 lwall
- * patch7: arranged for certain registers to be restored after longjmp()
- * patch7: Configure now compiles a test program to figure out time.h fiasco
- * patch7: Configure now detects DG/UX thingies like [sg]etpgrp2 and utime.h
- * patch7: memcpy() and memset() return void in __STDC__
- * patch7: errno may now be a macro with an lvalue
- * patch7: ANSI strerror() is now supported
- * patch7: Xenix support for sys/ndir.h, cross compilation
- *
- * Revision 3.0.1.3 89/11/17 15:28:57 lwall
- * patch5: byteorder now is a hex value
- * patch5: Configure now looks for <time.h> including <sys/time.h>
- *
- * Revision 3.0.1.2 89/11/11 04:39:38 lwall
- * patch2: Configure may now set -DDEBUGGING
- * patch2: netinet/in.h needed sys/types.h some places
- * patch2: more <sys/time.h> and <time.h> wrangling
- * patch2: yydebug moved to where type doesn't matter
- *
- * Revision 3.0.1.1 89/10/26 23:17:08 lwall
- * patch1: vfork now conditionally defined based on VFORK
- * patch1: DEC risc machines have a buggy memcmp
- * patch1: perl.h now includes <netinet/in.h> if it exists
- *
- * Revision 3.0 89/10/18 15:21:21 lwall
- * 3.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 EMBED
+#undef NO_EMBED
+#define NO_EMBED
+#undef MULTIPLICITY
+#undef USE_STDIO
+#define USE_STDIO
+#endif /* PERL_FOR_X2P */
#define VOIDUSED 1
#include "config.h"
-#if defined(HASVOLATILE) || defined(__STDC__)
-#define VOLATILE volatile
+#include "embed.h"
+
+#undef START_EXTERN_C
+#undef END_EXTERN_C
+#undef EXTERN_C
+#ifdef __cplusplus
+# define START_EXTERN_C extern "C" {
+# define END_EXTERN_C }
+# define EXTERN_C extern "C"
#else
-#define VOLATILE
+# define START_EXTERN_C
+# define END_EXTERN_C
+# define EXTERN_C
#endif
-#ifdef IAMSUID
-# ifndef TAINT
-# define TAINT
-# endif
+#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
-#ifndef VFORK
-# define vfork fork
+/*
+ * 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__) && !defined(__cplusplus)
+# 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
-#ifdef GETPGRP2
-# ifndef GETPGRP
-# define GETPGRP
-# endif
-# define getpgrp getpgrp2
+#define NOOP (void)0
+
+#define WITH_THR(s) STMT_START { dTHR; s; } STMT_END
+
+/*
+ * SOFT_CAST can be used for args to prototyped functions to retain some
+ * type checking; it only casts if the compiler does not know prototypes.
+ */
+#if defined(CAN_PROTOTYPE) && defined(DEBUGGING_COMPILE)
+#define SOFT_CAST(type)
+#else
+#define SOFT_CAST(type) (type)
+#endif
+
+#ifndef BYTEORDER
+# define BYTEORDER 0x1234
#endif
-#ifdef SETPGRP2
-# ifndef SETPGRP
-# define SETPGRP
+/* Overall memory policy? */
+#ifndef CONSERVATIVE
+# define LIBERAL 1
+#endif
+
+/*
+ * The following contortions are brought to you on behalf of all the
+ * standards, semi-standards, de facto standards, not-so-de-facto standards
+ * of the world, as well as all the other botches anyone ever thought of.
+ * The basic theory is that if we work hard enough here, the rest of the
+ * code can be a lot prettier. Well, so much for theory. Sorry, Henry...
+ */
+
+/* define this once if either system, instead of cluttering up the src */
+#if defined(MSDOS) || defined(atarist) || defined(WIN32)
+#define DOSISH 1
+#endif
+
+#if defined(__STDC__) || defined(vax11c) || defined(_AIX) || defined(__stdc__) || defined(__cplusplus)
+# define STANDARD_C 1
+#endif
+
+#if defined(__cplusplus) || defined(WIN32) || defined(__sgi) || defined(OS2) \
+ || defined(__DGUX)
+# define DONT_DECLARE_STD 1
+#endif
+
+#if defined(HASVOLATILE) || defined(STANDARD_C)
+# ifdef __cplusplus
+# define VOL // to temporarily suppress warnings
+# else
+# define VOL volatile
# endif
-# define setpgrp setpgrp2
+#else
+# define VOL
#endif
-#if defined(MEMCMP) && defined(mips) && BYTEORDER == 0x1234
-#undef MEMCMP
+#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.
+*/
+/* 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
-#ifdef MEMCPY
-#ifndef memcpy
-#ifdef __STDC__
-extern void *memcpy(), *memset();
+/* 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
-extern char *memcpy(), *memset();
+# 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
-#define bcopy(s1,s2,l) memcpy(s2,s1,l)
-#define bzero(s,l) memset(s,0,l)
+
+/* 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
-#ifndef BCMP /* prefer bcmp slightly 'cuz it doesn't order */
-#define bcmp(s1,s2,l) memcmp(s1,s2,l)
+
+#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 __cplusplus
+# ifndef I_STDARG
+# define I_STDARG 1
+# endif
#endif
-#include <stdio.h>
+#ifdef I_STDARG
+# include <stdarg.h>
+#else
+# ifdef I_VARARGS
+# include <varargs.h>
+# endif
+#endif
+
+#include "perlio.h"
+#include "perllio.h"
+#include "perlsock.h"
+#include "perlproc.h"
+#include "perlenv.h"
+#include "perldir.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 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>
-#include <sys/param.h> /* if this needs types.h we're still wrong */
-#ifndef _TYPES_ /* If types.h defines this it's easy. */
-#ifndef major /* Does everyone's types.h define this? */
-#include <sys/types.h>
+#ifdef I_SYS_PARAM
+# ifdef PARAM_NEEDS_TYPES
+# include <sys/types.h>
+# endif
+# include <sys/param.h>
+#endif
+
+
+/* Use all the "standard" definitions? */
+#if defined(STANDARD_C) && defined(I_STDLIB)
+# include <stdlib.h>
+#endif
+
+#define MEM_SIZE Size_t
+
+/* 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. */
+
+#ifdef MYMALLOC
+
+# ifdef HIDEMYMALLOC
+# define malloc Mymalloc
+# define calloc Mycalloc
+# define realloc Myremalloc
+# define free Myfree
+Malloc_t Mymalloc _((MEM_SIZE nbytes));
+Malloc_t Mycalloc _((MEM_SIZE elements, MEM_SIZE size));
+Malloc_t Myrealloc _((Malloc_t where, MEM_SIZE nbytes));
+Free_t Myfree _((Malloc_t where));
+# endif
+# ifdef EMBEDMYMALLOC
+# define malloc Perl_malloc
+# define calloc Perl_calloc
+# define realloc Perl_realloc
+# define free Perl_free
+Malloc_t Perl_malloc _((MEM_SIZE nbytes));
+Malloc_t Perl_calloc _((MEM_SIZE elements, MEM_SIZE size));
+Malloc_t Perl_realloc _((Malloc_t where, MEM_SIZE nbytes));
+Free_t Perl_free _((Malloc_t where));
+# endif
+
+# undef safemalloc
+# undef safecalloc
+# undef saferealloc
+# undef safefree
+# define safemalloc malloc
+# define safecalloc calloc
+# define saferealloc realloc
+# define safefree free
+
+#endif /* MYMALLOC */
+
+#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
+# include <strings.h>
+#endif
+
+#if !defined(HAS_STRCHR) && defined(HAS_INDEX) && !defined(strchr)
+#define strchr index
+#define strrchr rindex
#endif
+#ifdef I_MEMORY
+# include <memory.h>
+#endif
+
+#ifdef HAS_MEMCPY
+# if !defined(STANDARD_C) && !defined(I_STRING) && !defined(I_MEMORY)
+# ifndef memcpy
+ extern char * memcpy _((char*, char*, int));
+# endif
+# endif
+#else
+# ifndef memcpy
+# ifdef HAS_BCOPY
+# define memcpy(d,s,l) bcopy(s,d,l)
+# else
+# define memcpy(d,s,l) my_bcopy(s,d,l)
+# endif
+# endif
+#endif /* HAS_MEMCPY */
+
+#ifdef HAS_MEMSET
+# if !defined(STANDARD_C) && !defined(I_STRING) && !defined(I_MEMORY)
+# ifndef memset
+ extern char *memset _((char*, int, int));
+# endif
+# endif
+#else
+# 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 memmove(d,s,l) my_bcopy(s,d,l)
+# endif
+# endif
+#endif
+
+#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 && 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)
+# endif
+#endif /* !HAS_BCMP */
+
#ifdef I_NETINET_IN
-#include <netinet/in.h>
+# 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>
#endif
-#include <sys/stat.h>
+/* 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(m88k) && defined(ghs))
+# undef S_ISDIR
+# undef S_ISCHR
+# undef S_ISBLK
+# undef S_ISREG
+# undef S_ISFIFO
+# undef S_ISLNK
+#endif
#ifdef I_TIME
# include <time.h>
#endif
-#ifdef I_SYSTIME
-# ifdef SYSTIMEKERNEL
+#ifdef I_SYS_TIME
+# ifdef I_SYS_TIME_KERNEL
# define KERNEL
# endif
# include <sys/time.h>
-# ifdef SYSTIMEKERNEL
+# ifdef I_SYS_TIME_KERNEL
# undef KERNEL
# endif
#endif
-#include <sys/times.h>
+#if defined(HAS_TIMES) && defined(I_SYS_TIMES)
+# include <sys/times.h>
+#endif
-#if defined(STRERROR) && (!defined(MKDIR) || !defined(RMDIR))
-#undef STRERROR
+#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 <errno.h>
-#ifndef errno
-extern int errno; /* ANSI allows errno to be an lvalue expr */
+#ifdef HAS_SOCKET
+# ifdef I_NET_ERRNO
+# include <net/errno.h>
+# endif
#endif
-#ifdef STRERROR
-char *strerror();
+#ifdef VMS
+# define SETERRNO(errcode,vmserrcode) \
+ STMT_START { \
+ set_errno(errcode); \
+ set_vaxc_errno(vmserrcode); \
+ } STMT_END
#else
-extern int sys_nerr;
-extern char *sys_errlist[];
-#define strerror(e) ((e) < 0 || (e) >= sys_nerr ? "(unknown)" : sys_errlist[e])
+# define SETERRNO(errcode,vmserrcode) errno = (errcode)
#endif
-#ifdef I_SYSIOCTL
-#ifndef _IOCTL_
-#include <sys/ioctl.h>
-#endif
-#endif
+#ifdef USE_THREADS
+# define ERRSV (thr->errsv)
+# define ERRHV (thr->errhv)
+# define DEFSV THREADSV(0)
+# define SAVE_DEFSV save_threadsv(0)
+#else
+# define ERRSV GvSV(errgv)
+# define ERRHV GvHV(errgv)
+# define DEFSV GvSV(defgv)
+# define SAVE_DEFSV SAVESPTR(GvSV(defgv))
+#endif /* USE_THREADS */
-#if defined(mc300) || defined(mc500) || defined(mc700) /* MASSCOMP */
-#ifdef SOCKETPAIR
-#undef SOCKETPAIR
-#endif
-#ifdef NDBM
-#undef NDBM
-#endif
+#ifndef errno
+ extern int errno; /* ANSI allows errno to be an lvalue expr */
#endif
-#ifdef NDBM
-#include <ndbm.h>
-#define SOME_DBM
-#ifdef ODBM
-#undef ODBM
+#ifdef HAS_STRERROR
+# ifdef VMS
+ char *strerror _((int,...));
+# else
+#ifndef DONT_DECLARE_STD
+ char *strerror _((int));
#endif
+# endif
+# ifndef Strerror
+# define Strerror strerror
+# endif
#else
-#ifdef ODBM
-#ifdef NULL
-#undef NULL /* suppress redefinition message */
+# ifdef HAS_SYS_ERRLIST
+ extern int sys_nerr;
+ extern char *sys_errlist[];
+# ifndef Strerror
+# define Strerror(e) \
+ ((e) < 0 || (e) >= sys_nerr ? "(unknown)" : sys_errlist[e])
+# endif
+# endif
#endif
-#include <dbm.h>
-#ifdef NULL
-#undef NULL
+
+#ifdef I_SYS_IOCTL
+# ifndef _IOCTL_
+# include <sys/ioctl.h>
+# endif
#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 /* ODBM */
-#endif /* NDBM */
-#ifdef SOME_DBM
-EXT char *dbmkey;
-EXT int dbmlen;
+
+#if defined(mc300) || defined(mc500) || defined(mc700) || defined(mc6000)
+# ifdef HAS_SOCKETPAIR
+# undef HAS_SOCKETPAIR
+# endif
+# ifdef I_NDBM
+# undef I_NDBM
+# endif
#endif
#if INTSIZE == 2
-#define htoni htons
-#define ntohi ntohs
+# define htoni htons
+# define ntohi ntohs
#else
-#define htoni htonl
-#define ntohi ntohl
+# define htoni htonl
+# define ntohi ntohl
#endif
-#if defined(I_DIRENT) && !defined(M_XENIX)
+/* Configure already sets Direntry_t */
+#if defined(I_DIRENT)
# include <dirent.h>
-# define DIRENT dirent
+# if defined(NeXT) && defined(I_SYS_DIR) /* NeXT needs dirent + sys/dir.h */
+# include <sys/dir.h>
+# endif
#else
-# ifdef I_SYSNDIR
+# ifdef I_SYS_NDIR
# include <sys/ndir.h>
-# define DIRENT direct
# else
-# ifdef I_SYSDIR
+# ifdef I_SYS_DIR
# ifdef hp9000s500
# include <ndir.h> /* may be wrong in the future */
# else
# include <sys/dir.h>
# endif
-# define DIRENT direct
# endif
# endif
#endif
-typedef struct arg ARG;
-typedef struct cmd CMD;
-typedef struct formcmd FCMD;
-typedef struct scanpat SPAT;
-typedef struct stio STIO;
-typedef struct sub SUBR;
-typedef struct string STR;
-typedef struct atbl ARRAY;
-typedef struct htbl HASH;
+#ifdef FPUTS_BOTCH
+/* work around botch in SunOS 4.0.1 and 4.0.2 */
+# ifndef fputs
+# define fputs(sv,fp) fprintf(fp,"%s",sv)
+# endif
+#endif
+
+/*
+ * The following gobbledygook brought to you on behalf of __STDC__.
+ * (I could just use #ifndef __STDC__, but this is more bulletproof
+ * in the face of half-implementations.)
+ */
+
+#ifndef S_IFMT
+# ifdef _S_IFMT
+# define S_IFMT _S_IFMT
+# else
+# define S_IFMT 0170000
+# endif
+#endif
+
+#ifndef S_ISDIR
+# define S_ISDIR(m) ((m & S_IFMT) == S_IFDIR)
+#endif
+
+#ifndef S_ISCHR
+# define S_ISCHR(m) ((m & S_IFMT) == S_IFCHR)
+#endif
+
+#ifndef S_ISBLK
+# ifdef S_IFBLK
+# define S_ISBLK(m) ((m & S_IFMT) == S_IFBLK)
+# else
+# define S_ISBLK(m) (0)
+# endif
+#endif
+
+#ifndef S_ISREG
+# define S_ISREG(m) ((m & S_IFMT) == S_IFREG)
+#endif
+
+#ifndef S_ISFIFO
+# ifdef S_IFIFO
+# define S_ISFIFO(m) ((m & S_IFMT) == S_IFIFO)
+# else
+# define S_ISFIFO(m) (0)
+# endif
+#endif
+
+#ifndef S_ISLNK
+# ifdef _S_ISLNK
+# define S_ISLNK(m) _S_ISLNK(m)
+# else
+# ifdef _S_IFLNK
+# define S_ISLNK(m) ((m & S_IFMT) == _S_IFLNK)
+# else
+# ifdef S_IFLNK
+# define S_ISLNK(m) ((m & S_IFMT) == S_IFLNK)
+# else
+# define S_ISLNK(m) (0)
+# endif
+# endif
+# endif
+#endif
+
+#ifndef S_ISSOCK
+# ifdef _S_ISSOCK
+# define S_ISSOCK(m) _S_ISSOCK(m)
+# else
+# ifdef _S_IFSOCK
+# define S_ISSOCK(m) ((m & S_IFMT) == _S_IFSOCK)
+# else
+# ifdef S_IFSOCK
+# define S_ISSOCK(m) ((m & S_IFMT) == S_IFSOCK)
+# else
+# define S_ISSOCK(m) (0)
+# endif
+# endif
+# endif
+#endif
+
+#ifndef S_IRUSR
+# ifdef S_IREAD
+# define S_IRUSR S_IREAD
+# define S_IWUSR S_IWRITE
+# define S_IXUSR S_IEXEC
+# else
+# define S_IRUSR 0400
+# define S_IWUSR 0200
+# define S_IXUSR 0100
+# endif
+# define S_IRGRP (S_IRUSR>>3)
+# define S_IWGRP (S_IWUSR>>3)
+# define S_IXGRP (S_IXUSR>>3)
+# define S_IROTH (S_IRUSR>>6)
+# define S_IWOTH (S_IWUSR>>6)
+# define S_IXOTH (S_IXUSR>>6)
+#endif
+
+#ifndef S_ISUID
+# define S_ISUID 04000
+#endif
+
+#ifndef S_ISGID
+# define S_ISGID 02000
+#endif
+
+#ifdef ff_next
+# undef ff_next
+#endif
+
+#if defined(cray) || defined(gould) || defined(i860) || defined(pyr)
+# define SLOPPYDIVIDE
+#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 cray
+# define Quad_t int
+#else
+# ifdef 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
+# 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
+
+/*
+ * 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
+# 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
+ */
+
+#define PERL_USHORT_MIN ((unsigned short)0)
+
+#ifdef USHORT_MAX
+# define PERL_USHORT_MAX ((unsigned short)USHORT_MAX)
+#else
+# ifdef MAXUSHORT
+# define PERL_USHORT_MAX ((unsigned short)MAXUSHORT)
+# else
+# ifdef USHRT_MAX
+# define PERL_USHORT_MAX ((unsigned short)USHRT_MAX)
+# else
+# define PERL_USHORT_MAX ((unsigned short)~(unsigned)0)
+# endif
+# endif
+#endif
+
+#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
+# ifdef SHRT_MAX
+# define PERL_SHORT_MAX ((short)SHRT_MAX)
+# else
+# define PERL_SHORT_MAX ((short) (PERL_USHORT_MAX >> 1))
+# endif
+# endif
+#endif
+
+#ifdef SHORT_MIN
+# define PERL_SHORT_MIN ((short)SHORT_MIN)
+#else
+# ifdef MINSHORT
+# define PERL_SHORT_MIN ((short)MINSHORT)
+# else
+# ifdef SHRT_MIN
+# define PERL_SHORT_MIN ((short)SHRT_MIN)
+# else
+# define PERL_SHORT_MIN (-PERL_SHORT_MAX - ((3 & -1) == 3))
+# endif
+# 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 op OP;
+typedef struct cop COP;
+typedef struct unop UNOP;
+typedef struct binop BINOP;
+typedef struct listop LISTOP;
+typedef struct logop LOGOP;
+typedef struct condop CONDOP;
+typedef struct pmop PMOP;
+typedef struct svop SVOP;
+typedef struct gvop GVOP;
+typedef struct pvop PVOP;
+typedef struct loop LOOP;
+
+typedef struct Outrec Outrec;
+typedef struct interpreter PerlInterpreter;
+#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 cv CV;
typedef struct regexp REGEXP;
-typedef struct stabptrs STBP;
-typedef struct stab STAB;
+typedef struct gp GP;
+typedef struct gv GV;
+typedef struct io IO;
+typedef struct context PERL_CONTEXT;
+typedef struct block BLOCK;
+
+typedef struct magic MAGIC;
+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;
+typedef struct xpvav XPVAV;
+typedef struct xpvhv XPVHV;
+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 >= AvFILLp(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
+
+/*
+ * USE_THREADS needs to be after unixish.h as <pthread.h> includes
+ * <sys/signal.h> which defines NSIG - which will stop inclusion of <signal.h>
+ * this results in many functions being undeclared which bothers C++
+ * May make sense to have threads after "*ish.h" anyway
+ */
+
+#ifdef USE_THREADS
+# ifdef FAKE_THREADS
+# include "fakethr.h"
+# else
+# ifdef WIN32
+# include <win32thread.h>
+# else
+# ifdef OS2
+# include "os2thread.h"
+# else
+# include <pthread.h>
+typedef pthread_t perl_os_thread;
+typedef pthread_mutex_t perl_mutex;
+typedef pthread_cond_t perl_cond;
+typedef pthread_key_t perl_key;
+# endif /* OS2 */
+# endif /* WIN32 */
+# endif /* FAKE_THREADS */
+#endif /* USE_THREADS */
+
+
+
+#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.
+*/
+#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*));
+};
+
+#ifdef USE_THREADS
+#define ARGSproto struct perl_thread *thr
+#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 "str.h"
+#include "sv.h"
#include "util.h"
#include "form.h"
-#include "stab.h"
-#include "spat.h"
-#include "arg.h"
-#include "cmd.h"
-#include "array.h"
-#include "hash.h"
+#include "gv.h"
+#include "cv.h"
+#include "opcode.h"
+#include "op.h"
+#include "cop.h"
+#include "av.h"
+#include "hv.h"
+#include "mg.h"
+#include "scope.h"
+#include "bytecode.h"
+#include "byterun.h"
+
+/* work around some libPW problems */
+#ifdef DOINIT
+EXT char Error[1];
+#endif
#if defined(iAPX286) || defined(M_I286) || defined(I80286)
# define I286
#endif
-#ifndef __STDC__
-#ifdef CHARSPRINTF
- char *sprintf();
+#if defined(htonl) && !defined(HAS_HTONL)
+#define HAS_HTONL
+#endif
+#if defined(htons) && !defined(HAS_HTONS)
+#define HAS_HTONS
+#endif
+#if defined(ntohl) && !defined(HAS_NTOHL)
+#define HAS_NTOHL
+#endif
+#if defined(ntohs) && !defined(HAS_NTOHS)
+#define HAS_NTOHS
+#endif
+#ifndef HAS_HTONL
+#if (BYTEORDER & 0xffff) != 0x4321
+#define HAS_HTONS
+#define HAS_HTONL
+#define HAS_NTOHS
+#define HAS_NTOHL
+#define MYSWAP
+#define htons my_swap
+#define htonl my_htonl
+#define ntohs my_swap
+#define ntohl my_ntohl
+#endif
+#else
+#if (BYTEORDER & 0xffff) == 0x4321
+#undef HAS_HTONS
+#undef HAS_HTONL
+#undef HAS_NTOHS
+#undef HAS_NTOHL
+#endif
+#endif
+
+/*
+ * Little-endian byte order functions - 'v' for 'VAX', or 'reVerse'.
+ * -DWS
+ */
+#if BYTEORDER != 0x1234
+# define HAS_VTOHL
+# define HAS_VTOHS
+# define HAS_HTOVL
+# define HAS_HTOVS
+# if BYTEORDER == 0x4321
+# define vtohl(x) ((((x)&0xFF)<<24) \
+ +(((x)>>24)&0xFF) \
+ +(((x)&0x0000FF00)<<8) \
+ +(((x)&0x00FF0000)>>8) )
+# define vtohs(x) ((((x)&0xFF)<<8) + (((x)>>8)&0xFF))
+# define htovl(x) vtohl(x)
+# define htovs(x) vtohs(x)
+# endif
+ /* otherwise default to functions in util.c */
+#endif
+
+#ifdef CASTNEGFLOAT
+#define U_S(what) ((U16)(what))
+#define U_I(what) ((unsigned int)(what))
+#define U_L(what) ((U32)(what))
#else
- int sprintf();
+EXTERN_C U32 cast_ulong _((double));
+#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
+START_EXTERN_C
+I32 cast_i32 _((double));
+IV cast_iv _((double));
+UV cast_uv _((double));
+END_EXTERN_C
+#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
-EXT char *Yes INIT("1");
-EXT char *No INIT("");
+struct Outrec {
+ I32 o_lines;
+ char *o_str;
+ U32 o_len;
+};
-/* "gimme" values */
+#ifndef MAXSYSFD
+# define MAXSYSFD 2
+#endif
-/* Note: cmd.c assumes that it can use && to produce one of these values! */
-#define G_SCALAR 0
-#define G_ARRAY 1
+#ifndef TMPPATH
+# define TMPPATH "/tmp/perl-eXXXXXX"
+#endif
-#ifdef CRIPPLED_CC
-int str_true();
-#else /* !CRIPPLED_CC */
-#define str_true(str) (Str = (str), \
- (Str->str_pok ? \
- ((*Str->str_ptr > '0' || \
- Str->str_cur > 1 || \
- (Str->str_cur && *Str->str_ptr != '0')) ? 1 : 0) \
- : \
- (Str->str_nok ? (Str->str_u.str_nval != 0.0) : 0 ) ))
-#endif /* CRIPPLED_CC */
+#ifndef __cplusplus
+Uid_t getuid _((void));
+Uid_t geteuid _((void));
+Gid_t getgid _((void));
+Gid_t getegid _((void));
+#endif
#ifdef DEBUGGING
-#define str_peek(str) (Str = (str), \
- (Str->str_pok ? \
- Str->str_ptr : \
- (Str->str_nok ? \
- (sprintf(tokenbuf,"num(%g)",Str->str_u.str_nval), \
- (char*)tokenbuf) : \
- "" )))
-#endif
-
-#ifdef CRIPPLED_CC
-char *str_get();
-#else
-#ifdef TAINT
-#define str_get(str) (Str = (str), tainted |= Str->str_tainted, \
- (Str->str_pok ? Str->str_ptr : str_2ptr(Str)))
-#else
-#define str_get(str) (Str = (str), (Str->str_pok ? Str->str_ptr : str_2ptr(Str)))
-#endif /* TAINT */
-#endif /* CRIPPLED_CC */
-
-#ifdef CRIPPLED_CC
-double str_gnum();
-#else /* !CRIPPLED_CC */
-#ifdef TAINT
-#define str_gnum(str) (Str = (str), tainted |= Str->str_tainted, \
- (Str->str_nok ? Str->str_u.str_nval : str_2num(Str)))
-#else /* !TAINT */
-#define str_gnum(str) (Str = (str), (Str->str_nok ? Str->str_u.str_nval : str_2num(Str)))
-#endif /* TAINT*/
-#endif /* CRIPPLED_CC */
-EXT STR *Str;
-
-#define GROWSTR(pp,lp,len) if (*(lp) < (len)) growstr(pp,lp,len)
-
-#define STR_GROW(str,len) if ((str)->str_len < (len)) str_grow(str,len)
+#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_p(a) if (debug & 1) a
+#define DEBUG_s(a) if (debug & 2) a
+#define DEBUG_l(a) if (debug & 4) a
+#define DEBUG_t(a) if (debug & 8) 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 (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
+#define DEBUG_u(a) if (debug & 2048) a
+#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)
+#define DEBUG_p(a)
+#define DEBUG_s(a)
+#define DEBUG_l(a)
+#define DEBUG_t(a)
+#define DEBUG_o(a)
+#define DEBUG_c(a)
+#define DEBUG_P(a)
+#define DEBUG_m(a)
+#define DEBUG_f(a)
+#define DEBUG_r(a)
+#define DEBUG_x(a)
+#define DEBUG_u(a)
+#define DEBUG_L(a)
+#define DEBUG_H(a)
+#define DEBUG_X(a)
+#define DEBUG_D(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__); \
+ PerlProc_exit(1); \
+ }})
+#endif
-#ifndef BYTEORDER
-#define BYTEORDER 0x1234
+struct ufuncs {
+ I32 (*uf_val)_((IV, SV*));
+ I32 (*uf_set)_((IV, SV*));
+ IV uf_index;
+};
+
+/* Fix these up for __STDC__ */
+#ifndef DONT_DECLARE_STD
+char *mktemp _((char*));
+double atof _((const char*));
#endif
-#if defined(htonl) && !defined(HTONL)
-#define HTONL
+#ifndef STANDARD_C
+/* All of these are in stdlib.h or time.h for ANSI C */
+Time_t time();
+struct tm *gmtime(), *localtime();
+char *strchr(), *strrchr();
+char *strcpy(), *strcat();
+#endif /* ! STANDARD_C */
+
+
+#ifdef I_MATH
+# include <math.h>
+#else
+START_EXTERN_C
+ 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));
+ double atan2 _((double,double));
+ double pow _((double,double));
+END_EXTERN_C
#endif
-#if defined(htons) && !defined(HTONS)
-#define HTONS
+
+#ifndef __cplusplus
+# ifdef __NeXT__ /* or whatever catches all NeXTs */
+char *crypt (); /* Maybe more hosts will need the unprototyped version */
+# else
+# if !defined(WIN32) || !defined(HAVE_DES_FCRYPT)
+char *crypt _((const char*, const char*));
+# endif /* !WIN32 && !HAVE_CRYPT_SOURCE */
+# endif /* !__NeXT__ */
+# ifndef DONT_DECLARE_STD
+# ifndef getenv
+char *getenv _((const char*));
+# endif /* !getenv */
+Off_t lseek _((int,Off_t,int));
+# endif /* !DONT_DECLARE_STD */
+char *getlogin _((void));
+#endif /* !__cplusplus */
+
+#ifdef UNLINK_ALL_VERSIONS /* Currently only makes sense for VMS */
+#define UNLINK unlnk
+I32 unlnk _((char*));
+#else
+#define UNLINK unlink
#endif
-#if defined(ntohl) && !defined(NTOHL)
-#define NTOHL
+
+#ifndef HAS_SETREUID
+# ifdef HAS_SETRESUID
+# define setreuid(r,e) setresuid(r,e,(Uid_t)-1)
+# define HAS_SETREUID
+# endif
#endif
-#if defined(ntohs) && !defined(NTOHS)
-#define NTOHS
+#ifndef HAS_SETREGID
+# ifdef HAS_SETRESGID
+# define setregid(r,e) setresgid(r,e,(Gid_t)-1)
+# define HAS_SETREGID
+# endif
#endif
-#ifndef HTONL
-#if (BYTEORDER != 0x4321) && (BYTEORDER != 0x87654321)
-#define HTONS
-#define HTONL
-#define NTOHS
-#define NTOHL
-#define MYSWAP
-#define htons my_swap
-#define htonl my_htonl
-#define ntohs my_swap
-#define ntohl my_ntohl
+
+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
+
+#ifdef DEBUGGING
+# ifndef register
+# define register
+# endif
+# define PAD_SV(po) pad_sv(po)
+# define RUNOPS_DEFAULT runops_debug
#else
-#if (BYTEORDER == 0x4321) || (BYTEORDER == 0x87654321)
-#undef HTONS
-#undef HTONL
-#undef NTOHS
-#undef NTOHL
-#endif
-#endif
-
-CMD *add_label();
-CMD *block_head();
-CMD *append_line();
-CMD *make_acmd();
-CMD *make_ccmd();
-CMD *make_icmd();
-CMD *invert();
-CMD *addcond();
-CMD *addloop();
-CMD *wopt();
-CMD *over();
-
-STAB *stabent();
-STAB *genstab();
-
-ARG *stab2arg();
-ARG *op_new();
-ARG *make_op();
-ARG *make_match();
-ARG *make_split();
-ARG *rcatmaybe();
-ARG *listish();
-ARG *maybelistish();
-ARG *localize();
-ARG *fixeval();
-ARG *jmaybe();
-ARG *l();
-ARG *fixl();
-ARG *mod_match();
-ARG *make_list();
-ARG *cmd_to_arg();
-ARG *addflags();
-ARG *hide_ary();
-ARG *cval_to_arg();
-
-STR *str_new();
-STR *stab_str();
-
-int do_each();
-int do_subr();
-int do_match();
-int do_unpack();
-int eval(); /* this evaluates expressions */
-int do_eval(); /* this evaluates eval operator */
-int do_assign();
-
-SUBR *make_sub();
-
-FCMD *load_format();
-
-char *scanpat();
-char *scansubst();
-char *scantrans();
-char *scanstr();
-char *scanreg();
-char *str_append_till();
-char *str_gets();
-char *str_grow();
-
-bool do_open();
-bool do_close();
-bool do_print();
-bool do_aprint();
-bool do_exec();
-bool do_aexec();
-
-int do_subst();
-int cando();
-int ingroup();
-
-void str_replace();
-void str_inc();
-void str_dec();
-void str_free();
-void stab_clear();
-void do_join();
-void do_sprintf();
-void do_accept();
-void do_pipe();
-void do_vecset();
-void savelist();
-void saveitem();
-void saveint();
-void savelong();
-void savesptr();
-void savehptr();
-void restorelist();
-void repeatcpy();
-HASH *savehash();
-ARRAY *saveary();
-
-EXT char **origargv;
-EXT int origargc;
-EXT line_t line INIT(0);
-EXT line_t subline INIT(0);
-EXT STR *subname INIT(Nullstr);
-EXT int arybase INIT(0);
-
-struct outrec {
- line_t o_lines;
- char *o_str;
- int o_len;
+# define PAD_SV(po) curpad[po]
+# define RUNOPS_DEFAULT runops_standard
+#endif
+
+#ifdef MYMALLOC
+# define MALLOC_INIT MUTEX_INIT(&malloc_mutex)
+# define MALLOC_TERM MUTEX_DESTROY(&malloc_mutex)
+#else
+# define MALLOC_INIT
+# define MALLOC_TERM
+#endif
+
+
+/*
+ * These need prototyping here because <proto.h> isn't
+ * included until after runops is initialised.
+ */
+
+typedef int runops_proc_t _((void));
+int runops_standard _((void));
+#ifdef DEBUGGING
+int runops_debug _((void));
+#endif
+
+/* _ (for $_) must be first in the following list (DEFSV requires it) */
+#define THREADSV_NAMES "_123456789&`'+/.,\\\";^-%=|~:\001\005!@"
+
+/* VMS doesn't use environ array and NeXT has problems with crt0.o globals */
+#if !defined(VMS) && !(defined(NeXT) && defined(__DYNAMIC__))
+#if !defined(DONT_DECLARE_STD) \
+ || (defined(__svr4__) && defined(__GNUC__) && defined(sun)) \
+ || defined(__sgi) || defined(__DGUX)
+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 */
+
+
+/* for tmp use in stupid debuggers */
+EXT int * di;
+EXT short * ds;
+EXT char * dc;
+
+/* handy constants */
+EXTCONST char warn_uninit[]
+ INIT("Use of uninitialized value");
+EXTCONST char warn_nosemi[]
+ INIT("Semicolon seems to be missing");
+EXTCONST char warn_reserved[]
+ INIT("Unquoted string \"%s\" may clash with future reserved word");
+EXTCONST char warn_nl[]
+ INIT("Unsuccessful %s on filename containing newline");
+EXTCONST char no_wrongref[]
+ INIT("Can't use %s ref as %s ref");
+EXTCONST char no_symref[]
+ INIT("Can't use string (\"%.32s\") as %s ref while \"strict refs\" in use");
+EXTCONST char no_usym[]
+ INIT("Can't use an undefined value as %s reference");
+EXTCONST char no_aelem[]
+ INIT("Modification of non-creatable array value attempted, subscript %d");
+EXTCONST char no_helem[]
+ INIT("Modification of non-creatable hash value attempted, subscript \"%s\"");
+EXTCONST char no_modify[]
+ INIT("Modification of a read-only value attempted");
+EXTCONST char no_mem[]
+ INIT("Out of memory!\n");
+EXTCONST char no_security[]
+ INIT("Insecure dependency in %s%s");
+EXTCONST char no_sock_func[]
+ INIT("Unsupported socket function \"%s\" called");
+EXTCONST char no_dir_func[]
+ INIT("Unsupported directory function \"%s\" called");
+EXTCONST char no_func[]
+ INIT("The %s function is unimplemented");
+EXTCONST char no_myglob[]
+ INIT("\"my\" variable %s can't be in a package");
+
+#ifdef DOINIT
+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
+
+/* 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
-EXT struct outrec outrec;
-EXT struct outrec toprec;
-
-EXT STAB *stdinstab INIT(Nullstab);
-EXT STAB *last_in_stab INIT(Nullstab);
-EXT STAB *defstab INIT(Nullstab);
-EXT STAB *argvstab INIT(Nullstab);
-EXT STAB *envstab INIT(Nullstab);
-EXT STAB *sigstab INIT(Nullstab);
-EXT STAB *defoutstab INIT(Nullstab);
-EXT STAB *curoutstab INIT(Nullstab);
-EXT STAB *argvoutstab INIT(Nullstab);
-EXT STAB *incstab INIT(Nullstab);
-EXT STAB *leftstab INIT(Nullstab);
-EXT STAB *amperstab INIT(Nullstab);
-EXT STAB *rightstab INIT(Nullstab);
-EXT STAB *DBstab INIT(Nullstab);
-EXT STAB *DBsub INIT(Nullstab);
-
-EXT HASH *defstash; /* main symbol table */
-EXT HASH *curstash; /* symbol table for current package */
-EXT HASH *debstash; /* symbol table for perldb package */
-
-EXT STR *curstname; /* name of current package */
-
-EXT STR *freestrroot INIT(Nullstr);
-EXT STR *lastretstr INIT(Nullstr);
-EXT STR *DBsingle INIT(Nullstr);
-
-EXT int lastspbase;
-EXT int lastsize;
-
-EXT char *filename;
-EXT char *origfilename;
-EXT FILE * VOLATILE rsfp;
-EXT char buf[1024];
-EXT char *bufptr;
-EXT char *oldbufptr;
-EXT char *oldoldbufptr;
-EXT char *bufend;
-
-EXT STR *linestr INIT(Nullstr);
-
-EXT int record_separator INIT('\n');
-EXT int rslen INIT(1);
-EXT char *ofs INIT(Nullch);
-EXT int ofslen INIT(0);
-EXT char *ors INIT(Nullch);
-EXT int orslen INIT(0);
-EXT char *ofmt INIT(Nullch);
-EXT char *inplace INIT(Nullch);
-EXT char *nointrp INIT("");
-
-EXT bool preprocess INIT(FALSE);
-EXT bool minus_n INIT(FALSE);
-EXT bool minus_p INIT(FALSE);
-EXT bool minus_a INIT(FALSE);
-EXT bool doswitches INIT(FALSE);
-EXT bool dowarn INIT(FALSE);
-EXT bool allstabs INIT(FALSE); /* init all customary symbols in symbol table?*/
-EXT bool sawampersand INIT(FALSE); /* must save all match strings */
-EXT bool sawstudy INIT(FALSE); /* do fbminstr on all strings */
-EXT bool sawi INIT(FALSE); /* study must assume case insensitive */
-EXT bool sawvec INIT(FALSE);
-EXT bool localizing INIT(FALSE); /* are we processing a local() list? */
-
-#ifdef CSH
-char *cshname INIT(CSH);
-int cshlen INIT(0);
-#endif /* CSH */
-
-#ifdef TAINT
-EXT bool tainted INIT(FALSE); /* using variables controlled by $< */
-#endif
-
-#define TMPPATH "/tmp/perl-eXXXXXX"
-EXT char *e_tmpname;
-EXT FILE *e_fp INIT(Nullfp);
-
-EXT char tokenbuf[256];
-EXT int expectterm INIT(TRUE); /* how to interpret ambiguous tokens */
-EXT VOLATILE int in_eval INIT(FALSE); /* trap fatal errors? */
-EXT int multiline INIT(0); /* $*--do strings hold >1 line? */
-EXT int forkprocess; /* so do_open |- can return proc# */
-EXT int do_undump INIT(0); /* -u or dump seen? */
-EXT int error_count INIT(0); /* how many errors so far, max 10 */
-EXT int multi_start INIT(0); /* 1st line of multi-line string */
-EXT int multi_end INIT(0); /* last line of multi-line string */
-EXT int multi_open INIT(0); /* delimiter of said string */
-EXT int multi_close INIT(0); /* delimiter of said string */
-
-FILE *popen();
-/* char *str_get(); */
-STR *interp();
-void free_arg();
-STIO *stio_new();
-
-EXT struct stat statbuf;
-EXT struct stat statcache;
-STAB *statstab INIT(Nullstab);
-STR *statname;
-EXT struct tms timesbuf;
-EXT int uid;
-EXT int euid;
-EXT int gid;
-EXT int egid;
-UIDTYPE getuid();
-UIDTYPE geteuid();
-GIDTYPE getgid();
-GIDTYPE getegid();
-EXT int unsafe;
+#ifdef DOINIT
+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,
+ 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
+EXT unsigned char fold_locale[];
+#endif
+
+#ifdef DOINIT
+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,
+ 129, 140, 147, 148, 149, 150, 152, 153,
+ 255, 182, 224, 205, 174, 176, 180, 217,
+ 233, 232, 236, 187, 235, 228, 234, 226,
+ 222, 219, 211, 195, 188, 193, 185, 184,
+ 191, 183, 201, 229, 181, 220, 194, 162,
+ 163, 208, 186, 202, 200, 218, 198, 179,
+ 178, 214, 166, 170, 207, 199, 209, 206,
+ 204, 160, 212, 216, 215, 192, 175, 173,
+ 243, 172, 161, 190, 203, 189, 164, 230,
+ 167, 248, 227, 244, 242, 255, 241, 231,
+ 240, 253, 169, 210, 245, 237, 249, 247,
+ 239, 168, 252, 251, 254, 238, 223, 221,
+ 213, 225, 177, 197, 171, 196, 159, 4,
+ 5, 6, 8, 9, 10, 11, 12, 13,
+ 14, 15, 16, 17, 19, 20, 21, 22,
+ 23, 24, 25, 26, 27, 28, 30, 31,
+ 32, 33, 34, 35, 36, 37, 38, 39,
+ 41, 42, 43, 44, 45, 46, 47, 48,
+ 49, 50, 52, 53, 54, 55, 56, 57,
+ 58, 59, 60, 61, 63, 64, 65, 66,
+ 67, 68, 69, 70, 71, 72, 74, 75,
+ 76, 77, 78, 79, 80, 81, 82, 83,
+ 86, 87, 88, 89, 90, 91, 92, 93,
+ 94, 95, 97, 98, 99, 100, 101, 102,
+ 103, 104, 105, 106, 108, 109, 110, 111,
+ 112, 113, 114, 115, 116, 117, 119, 120,
+ 121, 122, 123, 124, 125, 126, 127, 128,
+ 130, 131, 132, 133, 134, 135, 136, 137,
+ 138, 139, 141, 142, 143, 144, 145, 146
+};
+#else
+EXTCONST unsigned char freq[];
+#endif
#ifdef DEBUGGING
-EXT VOLATILE int debug INIT(0);
-EXT int dlevel INIT(0);
-EXT int dlmax INIT(128);
-EXT char *debname;
-EXT char *debdelim;
-#define YYDEBUG 1
+#ifdef DOINIT
+EXTCONST char* block_type[] = {
+ "NULL",
+ "SUB",
+ "EVAL",
+ "LOOP",
+ "SUBST",
+ "BLOCK",
+};
+#else
+EXTCONST char* block_type[];
+#endif
#endif
-EXT int perldb INIT(0);
-EXT line_t cmdline INIT(NOLINE);
+/*****************************************************************************/
+/* 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... */
-EXT STR str_undef;
-EXT STR str_no;
-EXT STR str_yes;
+#include "perly.h"
-/* runtime control stuff */
+#define LEX_NOTPARSING 11 /* borrowed from toke.c */
-EXT struct loop {
- char *loop_label; /* what the loop was called, if anything */
- int loop_sp; /* stack pointer to copy stuff down to */
- jmp_buf loop_env;
-} *loop_stack;
+typedef enum {
+ XOPERATOR,
+ XTERM,
+ XREF,
+ XSTATE,
+ XBLOCK,
+ XTERMBLOCK
+} expectation;
-EXT int loop_ptr INIT(-1);
-EXT int loop_max INIT(128);
-EXT jmp_buf top_env;
+ /* Note: the lowest 8 bits are reserved for
+ stuffing into op->op_private */
+#define HINT_INTEGER 0x00000001
+#define HINT_STRICT_REFS 0x00000002
-EXT char * VOLATILE goto_targ INIT(Nullch); /* cmd_exec gets strange when set */
+#define HINT_BLOCK_SCOPE 0x00000100
+#define HINT_STRICT_SUBS 0x00000200
+#define HINT_STRICT_VARS 0x00000400
+#define HINT_LOCALE 0x00000800
-EXT ARRAY *stack; /* THE STACK */
+/* 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))
-EXT ARRAY * VOLATILE savestack; /* to save non-local values on */
+/* Set up PERLVAR macros for populating structs */
+#define PERLVAR(var,type) type var;
+#define PERLVARI(var,type,init) type var;
+#define PERLVARIC(var,type,init) type var;
-EXT ARRAY *tosave; /* strings to save on recursive subroutine */
+#ifdef PERL_GLOBAL_STRUCT
+struct perl_vars {
+#include "perlvars.h"
+};
-EXT ARRAY *lineary; /* lines of script for debugger */
+#ifdef PERL_CORE
+EXT struct perl_vars Perl_Vars;
+EXT struct perl_vars *Perl_VarsPtr INIT(&Perl_Vars);
+#else
+#if !defined(__GNUC__) || !defined(WIN32)
+EXT
+#endif
+struct perl_vars *Perl_VarsPtr;
+#define Perl_Vars (*((Perl_VarsPtr) ? Perl_VarsPtr : (Perl_VarsPtr = Perl_GetVars())))
+#endif
+#endif /* PERL_GLOBAL_STRUCT */
+
+#ifdef MULTIPLICITY
+/* If we have multiple interpreters define a struct
+ holding variables which must be per-interpreter
+ If we don't have threads anything that would have
+ be per-thread is per-interpreter.
+*/
+
+struct interpreter {
+#ifndef USE_THREADS
+#include "thrdvar.h"
+#endif
+#include "intrpvar.h"
+};
-EXT ARRAY *pidstatary; /* keep pids and statuses by fd for mypopen */
+#else
+struct interpreter {
+ char broiled;
+};
+#endif
-EXT int *di; /* for tmp use in debuggers */
-EXT char *dc;
-EXT short *ds;
+#ifdef USE_THREADS
+/* If we have threads define a struct with all the variables
+ * that have to be per-thread
+ */
-double atof();
-long time();
-struct tm *gmtime(), *localtime();
-char *mktemp();
-char *index(), *rindex();
-char *strcpy(), *strcat();
-#ifdef EUNICE
-#define UNLINK unlnk
-int unlnk();
+struct perl_thread {
+#include "thrdvar.h"
+};
+
+typedef struct perl_thread *Thread;
+
#else
-#define UNLINK unlink
+typedef void *Thread;
#endif
-#ifndef SETREUID
-#ifdef SETRESUID
-#define setreuid(r,e) setresuid(r,e,-1)
-#define SETREUID
+/* Done with PERLVAR macros for now ... */
+#undef PERLVAR
+#undef PERLVARI
+#undef PERLVARIC
+
+#include "thread.h"
+#include "pp.h"
+#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
+
+/* The following must follow proto.h as #defines mess up syntax */
+
+#include "embedvar.h"
+
+/* Now include all the 'global' variables
+ * If we don't have threads or multiple interpreters
+ * these include variables that would have been their struct-s
+ */
+
+#define PERLVAR(var,type) EXT type var;
+#define PERLVARI(var,type,init) EXT type var INIT(init);
+#define PERLVARIC(var,type,init) EXTCONST type var INIT(init);
+
+#ifndef PERL_GLOBAL_STRUCT
+#include "perlvars.h"
+#endif
+
+#ifndef MULTIPLICITY
+
+#ifndef USE_THREADS
+#include "thrdvar.h"
#endif
-#ifndef SETREGID
-#ifdef SETRESGID
-#define setregid(r,e) setresgid(r,e,-1)
-#define SETREGID
+
+#include "intrpvar.h"
+#endif
+
+
+#undef PERLVAR
+#undef PERLVARI
+#undef PERLVARIC
+
+#if defined(HASATTRIBUTE) && defined(WIN32)
+/*
+ * This provides a layer of functions and macros to ensure extensions will
+ * get to use the same RTL functions as the core.
+ * It has to go here or #define of printf messes up __attribute__
+ * stuff in proto.h
+ */
+# include <win32iop.h>
+#endif /* WIN32 */
+
+#ifdef DOINIT
+
+EXT MGVTBL vtbl_sv = {magic_get,
+ magic_set,
+ magic_len,
+ 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_sig = {0, 0, 0, 0, 0};
+EXT MGVTBL vtbl_sigelem = {magic_getsig,
+ magic_setsig,
+ 0, magic_clearsig,
+ 0};
+EXT MGVTBL vtbl_pack = {0, 0, magic_sizepack, 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, magic_setisa,
+ 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_nkeys = {0, magic_setnkeys,
+ 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_fm = {0, magic_setfm,
+ 0, 0, 0};
+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};
+
+EXT MGVTBL vtbl_regexp = {0,0,0,0, magic_freeregexp};
+
+#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};
+EXT MGVTBL vtbl_amagicelem = {0, magic_setamagic,
+ 0, 0, magic_setamagic};
+#endif /* OVERLOAD */
+
+#else /* !DOINIT */
+
+EXT MGVTBL vtbl_sv;
+EXT MGVTBL vtbl_env;
+EXT MGVTBL vtbl_envelem;
+EXT MGVTBL vtbl_sig;
+EXT MGVTBL vtbl_sigelem;
+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_nkeys;
+EXT MGVTBL vtbl_taint;
+EXT MGVTBL vtbl_substr;
+EXT MGVTBL vtbl_vec;
+EXT MGVTBL vtbl_pos;
+EXT MGVTBL vtbl_bm;
+EXT MGVTBL vtbl_fm;
+EXT MGVTBL vtbl_uvar;
+
+#ifdef USE_THREADS
+EXT MGVTBL vtbl_mutex;
+#endif /* USE_THREADS */
+
+EXT MGVTBL vtbl_defelem;
+EXT MGVTBL vtbl_regexp;
+
+#ifdef USE_LOCALE_COLLATE
+EXT MGVTBL vtbl_collxfrm;
+#endif
+
+#ifdef OVERLOAD
+EXT MGVTBL vtbl_amagic;
+EXT MGVTBL vtbl_amagicelem;
+#endif /* OVERLOAD */
+
+#endif /* !DOINIT */
+
+#ifdef OVERLOAD
+
+#define NofAMmeth 58
+#ifdef DOINIT
+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
+EXTCONST char * AMG_names[NofAMmeth];
+#endif /* def INITAMAGIC */
+
+struct am_table {
+ long was_ok_sub;
+ long was_ok_am;
+ 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,
+ 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
+};
+
+/*
+ * 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_NUMERIC
+
+#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
+ * Remap printf
+ */
+#define printf PerlIO_stdoutf
#endif
+
+#ifndef PERL_SCRIPT_MODE
+#define PERL_SCRIPT_MODE "r"
#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 { \
+ LOCK_SV_MUTEX; \
+ if (!nice_chunk) { \
+ nice_chunk = (char*)(chunk); \
+ nice_chunk_size = (chunk_size); \
+ } \
+ UNLOCK_SV_MUTEX; \
+ } while (0)
+
+
+#endif /* Include guard */
+