-/* $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
#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
#endif
/* work around some libPW problems */
-#define fatal Myfatal
#ifdef DOINIT
-char Error[1];
+EXT char Error[1];
#endif
/* define this once if either system, instead of cluttering up the src */
#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
# define VOL
#endif
-#ifdef IAMSUID
-# ifndef TAINT
-# define TAINT
-# 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()
-#else
-# define TAINT_IF(c)
-# define TAINT_NOT
-# define TAINT_PROPER(s)
-# define TAINT_ENV()
-#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()
#ifndef HAS_VFORK
# define vfork fork
# ifndef HAS_GETPGRP
# define HAS_GETPGRP
# endif
-# define getpgrp getpgrp2
#endif
#ifdef HAS_SETPGRP2
# ifndef HAS_SETPGRP
# define HAS_SETPGRP
# endif
-# define setpgrp setpgrp2
#endif
#include <stdio.h>
+#ifdef USE_NEXT_CTYPE
+#include <appkit/NXCType.h>
+#else
#include <ctype.h>
+#endif
+
+#ifdef METHOD /* Defined by OSF/1 v3.0 by ctype.h */
+#undef METHOD
+#endif
+
#include <setjmp.h>
-#ifndef MSDOS
+#ifdef I_SYS_PARAM
# ifdef PARAM_NEEDS_TYPES
# include <sys/types.h>
# endif
/* Use all the "standard" definitions? */
-#ifdef STANDARD_C
+#if defined(STANDARD_C) && defined(I_STDLIB)
# include <stdlib.h>
+#endif /* STANDARD_C */
+
+#define MEM_SIZE Size_t
+
+#if defined(I_STRING) || defined(__cplusplus)
# include <string.h>
-# define MEM_SIZE size_t
#else
- typedef unsigned int MEM_SIZE;
-#endif /* STANDARD_C */
+# include <strings.h>
+#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 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
#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)
#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
# 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)
#include <sys/stat.h>
-#if defined(uts) || defined(UTekV)
+/* 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
-# 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
#endif
#ifdef I_SYS_TIME
-# ifdef SYSTIMEKERNEL
+# ifdef I_SYS_TIME_KERNEL
# define KERNEL
# endif
# include <sys/time.h>
-# ifdef SYSTIMEKERNEL
+# ifdef I_SYS_TIME_KERNEL
# undef KERNEL
# endif
#endif
#ifndef MSDOS
-#include <sys/times.h>
+# if defined(HAS_TIMES) && defined(I_SYS_TIMES)
+# include <sys/times.h>
+# 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 <errno.h>
+#ifdef HAS_SOCKET
+# ifdef I_NET_ERRNO
+# include <net/errno.h>
+# endif
+#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 <sys/ioctl.h>
# endif
# 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 <dbz.h>
-# 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 <gdbm.h>
-# endif
-# define SOME_DBM
-# ifdef HAS_NDBM
-# undef HAS_NDBM
-# endif
-# ifdef HAS_ODBM
-# undef HAS_ODBM
-# endif
-# else
-# ifdef HAS_NDBM
-# include <ndbm.h>
-# define SOME_DBM
-# ifdef HAS_ODBM
-# undef HAS_ODBM
-# endif
-# else
-# ifdef HAS_ODBM
-# ifdef NULL
-# undef NULL /* suppress redefinition message */
-# endif
-# include <dbm.h>
-# 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
# define ntohi ntohl
#endif
+/* 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_SYS_NDIR
# include <sys/ndir.h>
-# define DIRENT direct
# else
# ifdef I_SYS_DIR
# ifdef hp9000s500
# else
# include <sys/dir.h>
# endif
-# define DIRENT direct
# endif
# endif
-#endif
+#endif
#ifdef FPUTS_BOTCH
/* work around botch in SunOS 4.0.1 and 4.0.2 */
# undef ff_next
#endif
-#if defined(cray) || defined(gould) || defined(i860)
+#if defined(cray) || defined(gould) || defined(i860) || defined(pyr)
# define SLOPPYDIVIDE
#endif
#ifdef DOSISH
# include "dosish.h"
#else
+# if defined(VMS)
+# include "vmsish.h"
+# else
# include "unixish.h"
+# endif
#endif
#ifndef HAS_PAUSE
typedef struct Outrec Outrec;
typedef struct lstring Lstring;
-typedef struct interpreter Interpreter;
+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 regexp REGEXP;
typedef struct gp GP;
typedef struct sv 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;
typedef struct xpvcv XPVCV;
typedef struct xpvbm XPVBM;
typedef struct xpvfm XPVFM;
+typedef struct xpvio XPVIO;
typedef struct mgvtbl MGVTBL;
typedef union any ANY;
+typedef FILE * (*cryptswitch_t) _((FILE *rfp));
+
#include "handy.h"
+
+#ifdef QUAD
+typedef quad IV;
+#else
+typedef long IV;
+#endif
+
union any {
void* any_ptr;
I32 any_i32;
+ IV any_iv;
+ long any_long;
+ void (*any_dptr) _((void*));
};
#include "regexp.h"
#ifndef STANDARD_C
# ifdef CHARSPRINTF
- char *sprintf P((char *, ...));
+ char *sprintf _((char *, const char *, ...));
# else
- int sprintf P((char *, ...));
+ int sprintf _((char *, const char *, ...));
# endif
#endif
#define U_I(what) ((unsigned int)(what))
#define U_L(what) ((U32)(what))
#else
-U32 cast_ulong P((double));
+U32 cast_ulong _((double));
#define U_S(what) ((U16)cast_ulong(what))
#define U_I(what) ((unsigned int)cast_ulong(what))
#define U_L(what) (cast_ulong(what))
#endif
+#ifdef CASTI32
+#define I_32(what) ((I32)(what))
+#define I_V(what) ((IV)(what))
+#else
+I32 cast_i32 _((double));
+#define I_32(what) (cast_i32(what))
+IV cast_iv _((double));
+#define I_V(what) (cast_iv(what))
+#endif
+
struct Outrec {
I32 o_lines;
char *o_str;
# define MAXSYSFD 2
#endif
-#ifndef DOSISH
-#define TMPPATH "/tmp/perl-eXXXXXX"
-#else
+#ifdef DOSISH
#define TMPPATH "plXXXXXX"
-#endif /* MSDOS */
+#else
+#ifdef VMS
+#define TMPPATH "/sys$scratch/perl-eXXXXXX"
+#else
+#define TMPPATH "/tmp/perl-eXXXXXX"
+#endif
+#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
#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_L(a)
#define DEBUG_H(a)
#define DEBUG_X(a)
+#define DEBUG_D(a)
#endif
#define YYMAXDEPTH 300
#define assert(what) DEB( { \
if (!(what)) { \
- fatal("Assertion failed: file \"%s\", line %d", \
+ croak("Assertion failed: file \"%s\", line %d", \
__FILE__, __LINE__); \
exit(1); \
}})
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 *index(), *rindex();
+char *strchr(), *strrchr();
char *strcpy(), *strcat();
#endif /* ! STANDARD_C */
# 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 fmod _((double,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
+#if !defined(HAS_FMOD) && defined(HAS_DREM)
+#define fmod(x,y) drem((x),(y))
+#endif
-char *crypt P((const char*, const char*));
-char *getenv P((const char*));
-long lseek P((int,int,int));
-char *getlogin P((void));
+#ifndef __cplusplus
+char *crypt _((const char*, const char*));
+char *getenv _((const char*));
+Off_t lseek _((int,Off_t,int));
+char *getlogin _((void));
+#endif
#ifdef EUNICE
#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_REPL 2
#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
/****************/
/****************/
/* global state */
-EXT Interpreter *curinterp; /* currently running interpreter */
+EXT PerlInterpreter * curinterp; /* currently running interpreter */
+#ifndef VMS /* VMS doesn't use environ array */
extern char ** environ; /* environment variables supplied via exec */
+#endif
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_seqmax; /* statement sequence number */
+EXT U32 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 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 */
/* Stack for currently executing thread--context switch must handle this. */
EXT SV ** stack_base; /* stack->array_ary */
#ifndef MSDOS
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;
EXT char * Yes INIT("1");
EXT char * No INIT("");
EXT char * hexdigit INIT("0123456789abcdef0123456789ABCDEFx");
-EXT char * warn_nl INIT("Unsuccessful %s on filename containing newline");
-EXT char no_modify[] INIT("Modification of a read-only value attempted");
-EXT char no_mem[] INIT("Out of memory!\n");
-EXT char no_security[] INIT("Insecure dependency in %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 * patleave INIT("\\.^$@dDwWsSbB+*?|()-nrtfeaxc0123456789[{]}");
EXT char * vert INIT("|");
+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 a string as %s ref while \"strict refs\" in use");
+EXT char no_usym[]
+ INIT("Can't use an undefined value as %s reference");
+EXT char no_aelem[]
+ INIT("Modification of non-creatable array value attempted, subscript %d");
+EXT char no_helem[]
+ INIT("Modification of non-creatable hash value attempted, subscript \"%s\"");
+EXT char no_modify[]
+ INIT("Modification of a read-only value attempted");
+EXT char no_mem[]
+ INIT("Out of memory!\n");
+EXT char no_security[]
+ 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 SV sv_undef;
EXT SV sv_no;
EXT SV sv_yes;
#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[];
-#endif
-
-#ifdef DOINIT
EXT unsigned char fold[] = { /* fast case folding table */
0, 1, 2, 3, 4, 5, 6, 7,
8, 9, 10, 11, 12, 13, 14, 15,
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 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 FILE * 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 char * autoboot_preamble INIT(Nullch);
EXT I32 multi_start; /* 1st line of multi-line string */
EXT I32 multi_end; /* last line of multi-line string */
EXT I32 subline; /* line this subroutine began on */
EXT SV * subname; /* name of current subroutine */
-EXT AV * pad; /* storage for lexically scoped temporaries */
-EXT AV * comppad; /* same for currently compiling routine */
+EXT AV * comppad; /* storage for lexically scoped temporaries */
+EXT AV * comppad_name; /* variable names for "my" variables */
+EXT I32 comppad_name_fill;/* last "introduced" variable offset */
+EXT I32 min_intro_pending;/* start of vars to introduce */
+EXT I32 max_intro_pending;/* end of vars to introduce */
EXT I32 padix; /* max used index in current "register" pad */
+EXT I32 padix_floor; /* how low may inner block reset padix */
+EXT bool pad_reset_pending; /* reset pad on next attempted alloc */
EXT 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
+
/**************************************************************************/
/* This regexp stuff is global since it always happens within 1 expr eval */
/**************************************************************************/
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 */
/***********************************************/
/* Global only to current interpreter instance */
/***********************************************/
-#ifdef EMBEDDED
+#ifdef MULTIPLICITY
#define IEXT
#define IINIT(x)
struct interpreter {
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 * 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 U32 Iperldb;
/* 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 STRLEN Irslen IINIT(1);
IEXT bool Irspara;
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 GV * Idefgv;
IEXT GV * Iargvgv;
IEXT GV * Idefoutgv;
-IEXT GV * Icuroutgv;
IEXT GV * Iargvoutgv;
/* shortcuts to regexp stuff */
IEXT GV * Iampergv;
IEXT GV * Irightgv;
IEXT PMOP * Icurpm; /* what to do \ interps from */
-IEXT char * Ihint; /* hint from cop_exec to do_match et al */
IEXT I32 * Iscreamfirst;
IEXT I32 * Iscreamnext;
IEXT I32 Imaxscream IINIT(-1);
IEXT HV * Icurstash; /* symbol table for current package */
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 */
/* 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;
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 Idirty; /* In the middle of tearing things down? */
IEXT bool Ilocalizing; /* are we processing a local() list? */
-#ifdef TAINT
IEXT bool Itainted; /* using variables controlled by $< */
-IEXT bool Itaintanyway; /* force taint checks when !set?id */
-#endif
+IEXT bool Itainting; /* doing taint checks */
/* trace state */
IEXT I32 Idlevel;
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 OP * Ilast_root;
-IEXT char * Ilast_eval;
-IEXT I32 Ilast_elen;
+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 I32 Icxstack_ix IINIT(-1);
IEXT I32 Icxstack_max IINIT(128);
IEXT jmp_buf Itop_env;
+IEXT I32 Irunlevel;
/* stack stuff */
IEXT AV * Istack; /* THE STACK */
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 */
+IEXT SV Istrchop; /* return value from chop */
IEXT int Ifilemode; /* so nextargv() can preserve mode */
IEXT int Ilastfd; /* what to preserve mode on */
IEXT char * Ioldname; /* what to preserve mode on */
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;
#undef IEXT
#undef IINIT
-#ifdef EMBEDDED
+#ifdef MULTIPLICITY
};
#else
struct interpreter {
extern "C" {
#endif
+#ifdef __cplusplus
+# ifndef I_STDARG
+# define I_STDARG 1
+# endif
+#endif
+
+#ifdef I_STDARG
+# include <stdarg.h>
+#else
+# ifdef I_VARARGS
+# include <varargs.h>
+# endif
+#endif
+
#include "proto.h"
+#ifdef EMBED
+#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
-/* The follow must follow proto.h */
+/* The following must follow proto.h */
#ifdef DOINIT
-MGVTBL vtbl_sv = {magic_get, magic_set, 0, 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_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};
+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, magic_clearenv,
+ 0};
+MGVTBL vtbl_sig = {0, 0, 0, 0, 0};
+MGVTBL vtbl_sigelem = {0, magic_setsig,
+ 0, 0, 0};
+MGVTBL vtbl_pack = {0, 0, 0, magic_wipepack,
+ 0};
+MGVTBL vtbl_packelem = {magic_getpack,
+ magic_setpack,
+ 0, magic_clearpack,
+ 0};
+MGVTBL vtbl_dbline = {0, magic_setdbline,
+ 0, 0, 0};
+MGVTBL vtbl_isa = {0, magic_setisa,
+ 0, 0, 0};
+MGVTBL vtbl_isaelem = {0, magic_setisa,
+ 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_taint = {magic_gettaint,magic_settaint,
+ 0, 0, 0};
+MGVTBL vtbl_substr = {0, magic_setsubstr,
+ 0, 0, 0};
+MGVTBL vtbl_vec = {0, magic_setvec,
+ 0, 0, 0};
+MGVTBL vtbl_pos = {magic_getpos,
+ magic_setpos,
+ 0, 0, 0};
+MGVTBL vtbl_bm = {0, magic_setbm,
+ 0, 0, 0};
+MGVTBL vtbl_uvar = {magic_getuvar,
+ magic_setuvar,
+ 0, 0, 0};
+
+#ifdef OVERLOAD
+MGVTBL vtbl_amagic = {0, magic_setamagic,
+ 0, 0, 0};
+MGVTBL vtbl_amagicelem = {0, magic_setamagic,
+ 0, 0, 0};
+#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 27
+#ifdef DOINIT
+EXT char * AMG_names[NofAMmeth][2] = {
+ {"fallback","abs"},
+ {"bool", "nomethod"},
+ {"\"\"", "0+"},
+ {"+","+="},
+ {"-","-="},
+ {"*", "*="},
+ {"/", "/="},
+ {"%", "%="},
+ {"**", "**="},
+ {"<<", "<<="},
+ {">>", ">>="},
+ {"<", "<="},
+ {">", ">="},
+ {"==", "!="},
+ {"<=>", "cmp"},
+ {"lt", "le"},
+ {"gt", "ge"},
+ {"eq", "ne"},
+ {"&", "^"},
+ {"|", "neg"},
+ {"!", "~"},
+ {"++", "--"},
+ {"atan2", "cos"},
+ {"sin", "exp"},
+ {"log", "sqrt"},
+ {"x","x="},
+ {".",".="}
+};
+#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,
+ 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,
+ band_amg, bxor_amg,
+ bor_amg, neg_amg,
+ not_amg, compl_amg,
+ inc_amg, dec_amg,
+ atan2_amg, cos_amg,
+ sin_amg, exp_amg,
+ log_amg, sqrt_amg,
+ repeat_amg, repeat_ass_amg,
+ concat_amg, concat_ass_amg
+};
+#endif /* OVERLOAD */
+
+#endif /* Include guard */
projects / p5sagit/p5-mst-13.2.git / blobdiff