X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl.h;h=a77988662ee28f6b3db4b839f98b4fc1e3d6d646;hb=72ea3524c3f4de196665e0574292cdc2981b4a2b;hp=4c3c9aad74c97700341794832c7bcb0707b5953c;hpb=a0d0e21ea6ea90a22318550944fe6cb09ae10cda;p=p5sagit%2Fp5-mst-13.2.git diff --git a/perl.h b/perl.h index 4c3c9aa..a779886 100644 --- a/perl.h +++ b/perl.h @@ -10,11 +10,60 @@ #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 HIDEMYMALLOC +#undef EMBEDMYMALLOC +#undef USE_STDIO +#define USE_STDIO +#endif /* PERL_FOR_X2P */ + +/* + * STMT_START { statements; } STMT_END; + * can be used as a single statement, as in + * if (x) STMT_START { ... } STMT_END; else ... + * + * Trying to select a version that gives no warnings... + */ +#if !(defined(STMT_START) && defined(STMT_END)) +# if defined(__GNUC__) && !defined(__STRICT_ANSI__) +# define STMT_START (void)( /* gcc supports ``({ STATEMENTS; })'' */ +# define STMT_END ) +# else + /* Now which other defined()s do we need here ??? */ +# if (VOIDFLAGS) && (defined(sun) || defined(__sun__)) +# define STMT_START if (1) +# define STMT_END else (void)0 +# else +# define STMT_START do +# define STMT_END while (0) +# endif +# endif +#endif + #include "embed.h" #define VOIDUSED 1 #include "config.h" +/* + * 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 @@ -32,22 +81,6 @@ * code can be a lot prettier. Well, so much for theory. Sorry, Henry... */ -#ifdef MYMALLOC -# ifdef HIDEMYMALLOC -# define malloc Mymalloc -# define realloc Myremalloc -# define free Myfree -# endif -# define safemalloc malloc -# define saferealloc realloc -# define safefree free -#endif - -/* work around some libPW problems */ -#ifdef DOINIT -EXT char Error[1]; -#endif - /* define this once if either system, instead of cluttering up the src */ #if defined(MSDOS) || defined(atarist) #define DOSISH 1 @@ -72,27 +105,92 @@ EXT char Error[1]; #define TAINT_PROPER(s) if (tainting) taint_proper(no_security, s) #define TAINT_ENV() if (tainting) taint_env() -#ifndef HAS_VFORK -# define vfork fork +/* 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 HAS_GETPGRP2 -# ifndef HAS_GETPGRP -# define HAS_GETPGRP -# endif +/* getpgid isn't POSIX, but at least Solaris and Linux have it, and it makes + our life easier :-) so we'll try it. +*/ +#ifdef HAS_GETPGID +# define BSD_GETPGRP(pid) getpgid((pid)) +#else +# 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 -#ifdef HAS_SETPGRP2 -# ifndef HAS_SETPGRP -# define HAS_SETPGRP +/* 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 _TYPES_ /* If types.h defines this it's easy. */ +# ifndef major /* Does everyone's types.h define this? */ +# include # endif #endif -#include -#ifdef USE_NEXT_CTYPE -#include +#ifdef __cplusplus +# ifndef I_STDARG +# define I_STDARG 1 +# endif +#endif + +#ifdef I_STDARG +# include #else +# ifdef I_VARARGS +# include +# endif +#endif + +#include "perlio.h" + +#ifdef USE_NEXT_CTYPE + +#if NX_CURRENT_COMPILER_RELEASE >= 400 +#include +#else /* NX_CURRENT_COMPILER_RELEASE < 400 */ +#include +#endif /* NX_CURRENT_COMPILER_RELEASE >= 400 */ + +#else /* !USE_NEXT_CTYPE */ #include +#endif /* USE_NEXT_CTYPE */ + +#ifdef I_LOCALE +#include #endif #ifdef METHOD /* Defined by OSF/1 v3.0 by ctype.h */ @@ -114,6 +212,35 @@ EXT char Error[1]; # include #endif /* STANDARD_C */ +/* This comes after 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 +# endif +# ifdef EMBEDMYMALLOC +# define malloc Perl_malloc +# define calloc Perl_calloc +# define realloc Perl_realloc +# define free Perl_free +# endif + +# undef safemalloc +# undef safecalloc +# undef saferealloc +# undef safefree +# define safemalloc malloc +# define safecalloc calloc +# define saferealloc realloc +# define safefree free + +#endif /* MYMALLOC */ + #define MEM_SIZE Size_t #if defined(I_STRING) || defined(__cplusplus) @@ -131,6 +258,10 @@ EXT char Error[1]; # undef HAS_MEMCMP #endif +#ifdef I_MEMORY +# include +#endif + #ifdef HAS_MEMCPY # if !defined(STANDARD_C) && !defined(I_STRING) && !defined(I_MEMORY) # ifndef memcpy @@ -172,17 +303,10 @@ EXT char Error[1]; # endif #else # ifndef memcmp -# define memcmp(s1,s2,l) my_memcmp(s1,s2,l) +# define memcmp my_memcmp # endif #endif /* HAS_MEMCMP */ -/* we prefer bcmp slightly for comparisons that don't care about ordering */ -#ifndef HAS_BCMP -# ifndef bcmp -# define bcmp(s1,s2,l) memcmp(s1,s2,l) -# endif -#endif /* HAS_BCMP */ - #if !defined(HAS_MEMMOVE) && !defined(memmove) # if defined(HAS_BCOPY) && defined(HAS_SAFE_BCOPY) # define memmove(d,s,l) bcopy(s,d,l) @@ -195,17 +319,13 @@ EXT char Error[1]; # endif #endif -#ifndef _TYPES_ /* If types.h defines this it's easy. */ -# ifndef major /* Does everyone's types.h define this? */ -# include -# endif -#endif - #ifdef I_NETINET_IN # include #endif +#ifdef I_SYS_STAT #include +#endif /* The stat macros for Amdahl UTS, Unisoft System V/88 (and derivatives like UTekV) are broken, sometimes giving false positives. Undefine @@ -239,10 +359,8 @@ EXT char Error[1]; # endif #endif -#ifndef MSDOS -# if defined(HAS_TIMES) && defined(I_SYS_TIMES) +#if defined(HAS_TIMES) && defined(I_SYS_TIMES) # include -# endif #endif #if defined(HAS_STRERROR) && (!defined(HAS_MKDIR) || !defined(HAS_RMDIR)) @@ -261,11 +379,18 @@ EXT char Error[1]; # include # endif #endif +#ifndef VMS +# define FIXSTATUS(sts) (U_L((sts) & 0xffff)) +# define SHIFTSTATUS(sts) ((sts) >> 8) +# define SETERRNO(errcode,vmserrcode) errno = (errcode) +#else +# define FIXSTATUS(sts) (U_L(sts)) +# define SHIFTSTATUS(sts) (sts) +# define SETERRNO(errcode,vmserrcode) STMT_START {set_errno(errcode); set_vaxc_errno(vmserrcode);} STMT_END +#endif -#ifndef MSDOS -# ifndef errno +#ifndef errno extern int errno; /* ANSI allows errno to be an lvalue expr */ -# endif #endif #ifdef HAS_STRERROR @@ -329,7 +454,7 @@ EXT char Error[1]; # endif # endif # endif -#endif +#endif #ifdef FPUTS_BOTCH /* work around botch in SunOS 4.0.1 and 4.0.2 */ @@ -446,50 +571,231 @@ EXT char Error[1]; # define SLOPPYDIVIDE #endif -#if defined(cray) || defined(convex) || defined (uts) || BYTEORDER > 0xffff -# define QUAD +#if defined(cray) || defined(convex) || BYTEORDER > 0xffff +# define HAS_QUAD #endif -#ifdef QUAD +#ifdef UV +#undef UV +#endif + +/* XXX QUAD stuff is not currently supported on most systems. + Specifically, perl internals don't support long long. Among + the many problems is that some compilers support long long, + but the underlying library functions (such as sprintf) don't. + Some things do work (such as quad pack/unpack on convex); + also some systems use long long for the fpos_t typedef. That + seems to work too. + + The IV type is supposed to be long enough to hold any integral + value or a pointer. + --Andy Dougherty August 1996 +*/ + +#ifdef HAS_QUAD # ifdef cray -# define quad int +# define Quad_t int # else -# if defined(convex) || defined (uts) -# define quad long long +# if defined(convex) +# define Quad_t long long # else -# define quad long +# define Quad_t long # endif # endif + typedef Quad_t IV; + typedef unsigned Quad_t UV; +# define IV_MAX PERL_QUAD_MAX +# define IV_MIN PERL_QUAD_MIN +# define UV_MAX PERL_UQUAD_MAX +# define UV_MIN PERL_UQUAD_MIN +#else + typedef long IV; + typedef unsigned long UV; +# define IV_MAX PERL_LONG_MAX +# define IV_MIN PERL_LONG_MIN +# define UV_MAX PERL_ULONG_MAX +# define UV_MIN PERL_ULONG_MIN +#endif + +/* Previously these definitions used hardcoded figures. + * It is hoped these formula are more portable, although + * no data one way or another is presently known to me. + * The "PERL_" names are used because these calculated constants + * do not meet the ANSI requirements for LONG_MAX, etc., which + * need to be constants acceptable to #if - kja + * define PERL_LONG_MAX 2147483647L + * define PERL_LONG_MIN (-LONG_MAX - 1) + * define PERL ULONG_MAX 4294967295L + */ + +#ifdef I_LIMITS /* Needed for cast_xxx() functions below. */ +# include +#else +#ifdef I_VALUES +# include +#endif #endif -#ifdef VOIDSIG -# define VOIDRET void +/* + * 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_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. + * _MAX: () (U_MAX >> 1) + * _MIN: -_MAX - . + * 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 -# define VOIDRET int +# 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 + */ -#ifdef DOSISH -# include "dosish.h" +#define PERL_USHORT_MIN ((unsigned short)0) + +#ifdef USHORT_MAX +# define PERL_USHORT_MAX ((unsigned short)USHORT_MAX) #else -# if defined(VMS) -# include "vmsish.h" -# else -# include "unixish.h" -# endif +# ifdef MAXUSHORT +# define PERL_USHORT_MAX ((unsigned short)MAXUSHORT) +# else +# define PERL_USHORT_MAX ((unsigned short)~(unsigned)0) +# endif #endif -#ifndef HAS_PAUSE -#define pause() sleep((32767<<16)+32767) +#ifdef SHORT_MAX +# define PERL_SHORT_MAX ((short)SHORT_MAX) +#else +# ifdef MAXSHORT /* Often used in */ +# define PERL_SHORT_MAX ((short)MAXSHORT) +# else +# define PERL_SHORT_MAX ((short) (PERL_USHORT_MAX >> 1)) +# endif #endif -#ifndef IOCPARM_LEN -# ifdef IOCPARM_MASK - /* on BSDish systes we're safe */ -# define IOCPARM_LEN(x) (((x) >> 16) & IOCPARM_MASK) -# else - /* otherwise guess at what's safe */ -# define IOCPARM_LEN(x) 256 -# endif +#ifdef SHORT_MIN +# define PERL_SHORT_MIN ((short)SHORT_MIN) +#else +# ifdef MINSHORT +# define PERL_SHORT_MIN ((short)MINSHORT) +# else +# define PERL_SHORT_MIN (-PERL_SHORT_MAX - ((3 & -1) == 3)) +# 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 */ +# 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 */ +# 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; @@ -505,11 +811,9 @@ typedef struct pmop PMOP; typedef struct svop SVOP; typedef struct gvop GVOP; typedef struct pvop PVOP; -typedef struct cvop CVOP; typedef struct loop LOOP; typedef struct Outrec Outrec; -typedef struct lstring Lstring; typedef struct interpreter PerlInterpreter; typedef struct ff FF; typedef struct sv SV; @@ -518,7 +822,7 @@ typedef struct hv HV; typedef struct cv CV; typedef struct regexp REGEXP; typedef struct gp GP; -typedef struct sv GV; +typedef struct gv GV; typedef struct io IO; typedef struct context CONTEXT; typedef struct block BLOCK; @@ -540,14 +844,49 @@ 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; +typedef I32 (*filter_t) _((int, SV *, int)); +#define FILTER_READ(idx, sv, len) filter_read(idx, sv, len) +#define FILTER_DATA(idx) (AvARRAY(rsfp_filters)[idx]) +#define FILTER_ISREADER(idx) (idx >= AvFILL(rsfp_filters)) + +#ifdef DOSISH +# if defined(OS2) +# include "os2ish.h" +# else +# include "dosish.h" +# endif #else -typedef long IV; +# if defined(VMS) +# include "vmsish.h" +# else +# if defined(PLAN9) +# include "./plan9/plan9ish.h" +# else +# include "unixish.h" +# endif +# endif +#endif + +/* Some unistd.h's give a prototype for pause() even though + HAS_PAUSE ends up undefined. This causes the #define + below to be rejected by the compmiler. Sigh. +*/ +#ifdef HAS_PAUSE +#define Pause pause +#else +#define Pause() sleep((32767<<16)+32767) +#endif + +#ifndef IOCPARM_LEN +# ifdef IOCPARM_MASK + /* on BSDish systes we're safe */ +# define IOCPARM_LEN(x) (((x) >> 16) & IOCPARM_MASK) +# else + /* otherwise guess at what's safe */ +# define IOCPARM_LEN(x) 256 +# endif #endif union any { @@ -572,16 +911,13 @@ union any { #include "mg.h" #include "scope.h" -#if defined(iAPX286) || defined(M_I286) || defined(I80286) -# define I286 +/* work around some libPW problems */ +#ifdef DOINIT +EXT char Error[1]; #endif -#ifndef STANDARD_C -# ifdef CHARSPRINTF - char *sprintf _((char *, const char *, ...)); -# else - int sprintf _((char *, const char *, ...)); -# endif +#if defined(iAPX286) || defined(M_I286) || defined(I80286) +# define I286 #endif #if defined(htonl) && !defined(HAS_HTONL) @@ -643,20 +979,35 @@ union any { #define U_I(what) ((unsigned int)(what)) #define U_L(what) ((U32)(what)) #else +# ifdef __cplusplus + extern "C" { +# endif 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)) +# ifdef __cplusplus + } +# endif +#define U_S(what) ((U16)cast_ulong((double)(what))) +#define U_I(what) ((unsigned int)cast_ulong((double)(what))) +#define U_L(what) (cast_ulong((double)(what))) #endif #ifdef CASTI32 #define I_32(what) ((I32)(what)) #define I_V(what) ((IV)(what)) +#define U_V(what) ((UV)(what)) #else +# ifdef __cplusplus + extern "C" { +# endif I32 cast_i32 _((double)); -#define I_32(what) (cast_i32(what)) IV cast_iv _((double)); -#define I_V(what) (cast_iv(what)) +UV cast_uv _((double)); +# ifdef __cplusplus + } +# endif +#define I_32(what) (cast_i32((double)(what))) +#define I_V(what) (cast_iv((double)(what))) +#define U_V(what) (cast_uv((double)(what))) #endif struct Outrec { @@ -669,14 +1020,8 @@ struct Outrec { # define MAXSYSFD 2 #endif -#ifdef DOSISH -#define TMPPATH "plXXXXXX" -#else -#ifdef VMS -#define TMPPATH "/sys$scratch/perl-eXXXXXX" -#else -#define TMPPATH "/tmp/perl-eXXXXXX" -#endif +#ifndef TMPPATH +# define TMPPATH "/tmp/perl-eXXXXXX" #endif #ifndef __cplusplus @@ -687,6 +1032,9 @@ Gid_t getegid _((void)); #endif #ifdef DEBUGGING +#ifndef Perl_debug_log +#define Perl_debug_log PerlIO_stderr() +#endif #define YYDEBUG 1 #define DEB(a) a #define DEBUG(a) if (debug) a @@ -697,7 +1045,7 @@ Gid_t getegid _((void)); #define DEBUG_o(a) if (debug & 16) a #define DEBUG_c(a) if (debug & 32) a #define DEBUG_P(a) if (debug & 64) a -#define DEBUG_m(a) if (debug & 128) a +#define DEBUG_m(a) if (curinterp && debug & 128) a #define DEBUG_f(a) if (debug & 256) a #define DEBUG_r(a) if (debug & 512) a #define DEBUG_x(a) if (debug & 1024) a @@ -728,12 +1076,14 @@ Gid_t getegid _((void)); #endif #define YYMAXDEPTH 300 +#ifndef assert /* might have been included somehow */ #define assert(what) DEB( { \ if (!(what)) { \ croak("Assertion failed: file \"%s\", line %d", \ __FILE__, __LINE__); \ exit(1); \ }}) +#endif struct ufuncs { I32 (*uf_val)_((IV, SV*)); @@ -763,7 +1113,6 @@ char *strcpy(), *strcat(); extern "C" { # endif double exp _((double)); - double fmod _((double,double)); double log _((double)); double sqrt _((double)); double modf _((double,double*)); @@ -776,18 +1125,18 @@ char *strcpy(), *strcat(); # endif #endif -#if !defined(HAS_FMOD) && defined(HAS_DREM) -#define fmod(x,y) drem((x),(y)) -#endif - #ifndef __cplusplus +#ifdef __NeXT__ /* or whatever catches all NeXTs */ +char *crypt (); /* Maybe more hosts will need the unprototyped version */ +#else char *crypt _((const char*, const char*)); +#endif char *getenv _((const char*)); Off_t lseek _((int,Off_t,int)); char *getlogin _((void)); #endif -#ifdef EUNICE +#ifdef UNLINK_ALL_VERSIONS /* Currently only makes sense for VMS */ #define UNLINK unlnk I32 unlnk _((char*)); #else @@ -812,9 +1161,14 @@ I32 unlnk _((char*)); #define SCAN_REPL 2 #ifdef DEBUGGING -# ifndef register +# ifndef register # define register # endif +# ifdef MYMALLOC +# ifndef DEBUGGING_MSTATS +# define DEBUGGING_MSTATS +# endif +# endif # define PAD_SV(po) pad_sv(po) #else # define PAD_SV(po) curpad[po] @@ -826,9 +1180,19 @@ I32 unlnk _((char*)); /* global state */ EXT PerlInterpreter * curinterp; /* currently running interpreter */ -#ifndef VMS /* VMS doesn't use environ array */ +/* VMS doesn't use environ array and NeXT has problems with crt0.o globals */ +#if !defined(VMS) && !(defined(NeXT) && defined(__DYNAMIC__)) extern char ** environ; /* environment variables supplied via exec */ -#endif +#else +# if defined(NeXT) && defined(__DYNAMIC__) + +# include +EXT char *** environ_pointer; +# define environ (*environ_pointer) +# endif +#endif /* environ processing */ + +EXT int lc_collate_active; EXT int uid; /* current real user id */ EXT int euid; /* current effective user id */ EXT int gid; /* current real group id */ @@ -836,18 +1200,23 @@ 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 U16 op_seqmax; /* op sequence number */ EXT U32 evalseq; /* eval sequence number */ EXT U32 sub_generation; /* inc to force methods to be looked up again */ EXT char ** origenviron; EXT U32 origalen; EXT U32 * profiledata; +EXT int maxo INIT(MAXO);/* Number of ops */ +EXT char * osname; /* operating system */ EXT XPV* xiv_arenaroot; /* list of allocated xiv areas */ EXT IV ** xiv_root; /* free xiv list--shared by interpreters */ EXT double * xnv_root; /* free xnv list--shared by interpreters */ EXT XRV * xrv_root; /* free xrv list--shared by interpreters */ EXT XPV * xpv_root; /* free xpv list--shared by interpreters */ +EXT HE * he_root; /* free he list--shared by interpreters */ +EXT char * nice_chunk; /* a nice chunk of memory to reuse */ +EXT U32 nice_chunk_size;/* how nice the chunk of memory is */ /* Stack for currently executing thread--context switch must handle this. */ EXT SV ** stack_base; /* stack->array_ary */ @@ -878,11 +1247,12 @@ EXT SV ** curpad; /* temp space */ EXT SV * Sv; +EXT HE He; EXT XPV * Xpv; -EXT char buf[1024]; +EXT char buf[2048]; /* should be longer than PATH_MAX */ EXT char tokenbuf[256]; EXT struct stat statbuf; -#ifndef MSDOS +#ifdef HAS_TIMES EXT struct tms timesbuf; #endif EXT STRLEN na; /* for use in SvPV when length is Not Applicable */ @@ -910,7 +1280,7 @@ EXT char warn_nl[] 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"); + INIT("Can't use string (\"%.32s\") as %s ref while \"strict refs\" in use"); EXT char no_usym[] INIT("Can't use an undefined value as %s reference"); EXT char no_aelem[] @@ -929,6 +1299,8 @@ EXT char no_dir_func[] INIT("Unsupported directory function \"%s\" called"); EXT char no_func[] INIT("The %s function is unimplemented"); +EXT char no_myglob[] + INIT("\"my\" variable %s can't be in a package"); EXT SV sv_undef; EXT SV sv_no; @@ -939,11 +1311,15 @@ EXT SV sv_yes; #endif #ifdef DOINIT -EXT char *sig_name[] = { - SIG_NAME,0 -}; +EXT char *sig_name[] = { SIG_NAME }; +EXT int sig_num[] = { SIG_NUM }; +EXT SV * psig_ptr[sizeof(sig_num)/sizeof(*sig_num)]; +EXT SV * psig_name[sizeof(sig_num)/sizeof(*sig_num)]; #else EXT char *sig_name[]; +EXT int sig_num[]; +EXT SV * psig_ptr[]; +EXT SV * psig_name[]; #endif #ifdef DOINIT @@ -1077,14 +1453,14 @@ 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 PerlIO * VOL rsfp INIT(Nullfp); EXT SV * linestr; EXT char * bufptr; EXT char * oldbufptr; EXT char * oldoldbufptr; EXT char * bufend; EXT expectation expect INIT(XSTATE); /* how to interpret ambiguous tokens */ -EXT char * autoboot_preamble INIT(Nullch); +EXT AV * rsfp_filters; EXT I32 multi_start; /* 1st line of multi-line string */ EXT I32 multi_end; /* last line of multi-line string */ @@ -1096,14 +1472,16 @@ EXT I32 error_count; /* how many errors so far, max 10 */ EXT I32 subline; /* line this subroutine began on */ EXT SV * subname; /* name of current subroutine */ +EXT CV * compcv; /* currently compiling subroutine */ EXT AV * comppad; /* storage for lexically scoped temporaries */ EXT AV * comppad_name; /* variable names for "my" variables */ EXT I32 comppad_name_fill;/* last "introduced" variable offset */ +EXT I32 comppad_name_floor;/* start of vars in innermost block */ EXT I32 min_intro_pending;/* start of vars to introduce */ EXT I32 max_intro_pending;/* end of vars to introduce */ EXT I32 padix; /* max used index in current "register" pad */ EXT I32 padix_floor; /* how low may inner block reset padix */ -EXT bool pad_reset_pending; /* reset pad on next attempted alloc */ +EXT I32 pad_reset_pending; /* reset pad on next attempted alloc */ EXT COP compiling; EXT I32 thisexpr; /* name id for nothing_in_common() */ @@ -1149,6 +1527,9 @@ EXT char * regtill; /* How far we are required to go. */ EXT U16 regflags; /* are we folding, multilining? */ EXT char regprev; /* char before regbol, \n if none */ +EXT bool do_undump; /* -u or dump seen? */ +EXT VOL U32 debug; + /***********************************************/ /* Global only to current interpreter instance */ /***********************************************/ @@ -1169,14 +1550,21 @@ IEXT GV * Ienvgv; IEXT GV * Isiggv; IEXT GV * Iincgv; IEXT char * Iorigfilename; +IEXT SV * Idiehook; +IEXT SV * Iwarnhook; +IEXT SV * Iparsehook; + +/* Various states of an input record separator SV (rs, nrs) */ +#define RsSNARF(sv) (! SvOK(sv)) +#define RsSIMPLE(sv) (SvOK(sv) && SvCUR(sv)) +#define RsPARA(sv) (SvOK(sv) && ! SvCUR(sv)) /* switches */ IEXT char * Icddir; IEXT bool Iminus_c; -IEXT char Ipatchlevel[6]; -IEXT char * Inrs IINIT("\n"); -IEXT U32 Inrschar IINIT('\n'); /* final char of rs, or 0777 if none */ -IEXT I32 Inrslen IINIT(1); +IEXT char Ipatchlevel[10]; +IEXT char ** Ilocalpatches; +IEXT SV * Inrs; IEXT char * Isplitstr IINIT(" "); IEXT bool Ipreprocess; IEXT bool Iminus_n; @@ -1192,21 +1580,18 @@ IEXT bool Isawstudy; /* do fbm_instr on all strings */ IEXT bool Isawi; /* study must assume case insensitive */ IEXT bool Isawvec; IEXT bool Iunsafe; -IEXT bool Ido_undump; /* -u or dump seen? */ IEXT char * Iinplace; IEXT char * Ie_tmpname; -IEXT FILE * Ie_fp; -IEXT VOL U32 Idebug; +IEXT PerlIO * Ie_fp; IEXT U32 Iperldb; + /* This value may be raised by extensions for testing purposes */ +IEXT int Iperl_destruct_level; /* 0=none, 1=full, 2=full with checks */ /* magical thingies */ IEXT Time_t Ibasetime; /* $^T */ IEXT 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 STRLEN Irslen IINIT(1); -IEXT bool Irspara; +IEXT SV * Irs; /* $/ */ IEXT char * Iofs; /* $, */ IEXT STRLEN Iofslen; IEXT char * Iors; /* $\ */ @@ -1214,7 +1599,7 @@ IEXT STRLEN Iorslen; IEXT char * Iofmt; /* $# */ IEXT I32 Imaxsysfd IINIT(MAXSYSFD); /* top fd to pass to subprocesses */ IEXT int Imultiline; /* $*--do strings hold >1 line? */ -IEXT U16 Istatusvalue; /* $? */ +IEXT U32 Istatusvalue; /* $? */ IEXT struct stat Istatcache; /* _ */ IEXT GV * Istatgv; @@ -1238,6 +1623,9 @@ IEXT I32 * Iscreamnext; IEXT I32 Imaxscream IINIT(-1); IEXT SV * Ilastscream; +/* shortcuts to misc objects */ +IEXT GV * Ierrgv; + /* shortcuts to debugging objects */ IEXT GV * IDBgv; IEXT GV * IDBline; @@ -1255,8 +1643,7 @@ IEXT HV * Idebstash; /* symbol table for perldb package */ IEXT SV * Icurstname; /* name of current package */ IEXT AV * Ibeginav; /* names of BEGIN subroutines */ IEXT AV * Iendav; /* names of END subroutines */ -IEXT AV * Ipad; /* storage for lexically scoped temporaries */ -IEXT AV * Ipadname; /* variable names for "my" variables */ +IEXT HV * Istrtab; /* shared string table */ /* memory management */ IEXT SV ** Itmps_stack; @@ -1282,9 +1669,10 @@ IEXT VOL int Iin_eval; /* trap "fatal" errors? */ IEXT OP * Irestartop; /* Are we propagating an error from croak? */ IEXT int Idelaymagic; /* ($<,$>) = ... */ IEXT bool Idirty; /* In the middle of tearing things down? */ -IEXT bool Ilocalizing; /* are we processing a local() list? */ +IEXT U8 Ilocalizing; /* are we processing a local() list? */ IEXT bool Itainted; /* using variables controlled by $< */ IEXT bool Itainting; /* doing taint checks */ +IEXT char * Iop_mask IINIT(NULL); /* masked operations for safe evals */ /* trace state */ IEXT I32 Idlevel; @@ -1293,6 +1681,7 @@ IEXT char * Idebname; IEXT char * Idebdelim; /* current interpreter roots */ +IEXT CV * Imain_cv; IEXT OP * Imain_root; IEXT OP * Imain_start; IEXT OP * Ieval_root; @@ -1300,15 +1689,16 @@ IEXT OP * Ieval_start; /* runtime control stuff */ IEXT COP * VOL Icurcop IINIT(&compiling); +IEXT COP * Icurcopdb IINIT(NULL); IEXT line_t Icopline IINIT(NOLINE); IEXT CONTEXT * Icxstack; IEXT I32 Icxstack_ix IINIT(-1); IEXT I32 Icxstack_max IINIT(128); -IEXT jmp_buf Itop_env; +IEXT Sigjmp_buf Itop_env; IEXT I32 Irunlevel; /* stack stuff */ -IEXT AV * Istack; /* THE STACK */ +IEXT AV * Icurstack; /* THE STACK */ IEXT AV * Imainstack; /* the stack when nothing funny is happening */ IEXT SV ** Imystack_base; /* stack->array_ary */ IEXT SV ** Imystack_sp; /* stack pointer now */ @@ -1337,6 +1727,7 @@ IEXT I32 Idumplvl; /* indentation level on syntax tree dump */ IEXT PMOP * Ioldlastpm; /* for saving regexp context during debugger */ IEXT I32 Igensym; /* next symbol for getsym() to define */ IEXT bool Ipreambled; +IEXT AV * Ipreambleav; IEXT int Ilaststatval IINIT(-1); IEXT I32 Ilaststype IINIT(OP_STAT); @@ -1357,20 +1748,6 @@ struct interpreter { extern "C" { #endif -#ifdef __cplusplus -# ifndef I_STDARG -# define I_STDARG 1 -# endif -#endif - -#ifdef I_STDARG -# include -#else -# ifdef I_VARARGS -# include -# endif -#endif - #include "proto.h" #ifdef EMBED @@ -1388,57 +1765,63 @@ extern "C" { /* The following must follow proto.h */ #ifdef DOINIT -MGVTBL vtbl_sv = {magic_get, +EXT 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, +EXT MGVTBL vtbl_env = {0, 0, 0, 0, 0}; +EXT 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, +EXT MGVTBL vtbl_sig = {0, 0, 0, 0, 0}; +EXT MGVTBL vtbl_sigelem = {magic_getsig, + magic_setsig, + 0, magic_clearsig, 0}; -MGVTBL vtbl_packelem = {magic_getpack, +EXT MGVTBL vtbl_pack = {0, 0, 0, magic_wipepack, + 0}; +EXT MGVTBL vtbl_packelem = {magic_getpack, magic_setpack, 0, magic_clearpack, 0}; -MGVTBL vtbl_dbline = {0, magic_setdbline, +EXT MGVTBL vtbl_dbline = {0, magic_setdbline, 0, 0, 0}; -MGVTBL vtbl_isa = {0, magic_setisa, +EXT MGVTBL vtbl_isa = {0, magic_setisa, 0, 0, 0}; -MGVTBL vtbl_isaelem = {0, magic_setisa, +EXT MGVTBL vtbl_isaelem = {0, magic_setisa, 0, 0, 0}; -MGVTBL vtbl_arylen = {magic_getarylen, +EXT MGVTBL vtbl_arylen = {magic_getarylen, magic_setarylen, 0, 0, 0}; -MGVTBL vtbl_glob = {magic_getglob, +EXT MGVTBL vtbl_glob = {magic_getglob, magic_setglob, 0, 0, 0}; -MGVTBL vtbl_mglob = {0, magic_setmglob, +EXT MGVTBL vtbl_mglob = {0, magic_setmglob, + 0, 0, 0}; +EXT MGVTBL vtbl_nkeys = {0, magic_setnkeys, 0, 0, 0}; -MGVTBL vtbl_taint = {magic_gettaint,magic_settaint, +EXT MGVTBL vtbl_taint = {magic_gettaint,magic_settaint, 0, 0, 0}; -MGVTBL vtbl_substr = {0, magic_setsubstr, +EXT MGVTBL vtbl_substr = {0, magic_setsubstr, 0, 0, 0}; -MGVTBL vtbl_vec = {0, magic_setvec, +EXT MGVTBL vtbl_vec = {0, magic_setvec, 0, 0, 0}; -MGVTBL vtbl_pos = {magic_getpos, +EXT MGVTBL vtbl_pos = {magic_getpos, magic_setpos, 0, 0, 0}; -MGVTBL vtbl_bm = {0, magic_setbm, +EXT MGVTBL vtbl_bm = {0, magic_setbm, 0, 0, 0}; -MGVTBL vtbl_uvar = {magic_getuvar, +EXT MGVTBL vtbl_fm = {0, magic_setfm, + 0, 0, 0}; +EXT 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}; +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 @@ -1455,11 +1838,13 @@ 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 OVERLOAD @@ -1472,7 +1857,7 @@ EXT MGVTBL vtbl_amagicelem; #ifdef OVERLOAD EXT long amagic_generation; -#define NofAMmeth 27 +#define NofAMmeth 29 #ifdef DOINIT EXT char * AMG_names[NofAMmeth][2] = { {"fallback","abs"}, @@ -1486,6 +1871,9 @@ EXT char * AMG_names[NofAMmeth][2] = { {"**", "**="}, {"<<", "<<="}, {">>", ">>="}, + {"&", "&="}, + {"|", "|="}, + {"^", "^="}, {"<", "<="}, {">", ">="}, {"==", "!="}, @@ -1493,15 +1881,14 @@ EXT char * AMG_names[NofAMmeth][2] = { {"lt", "le"}, {"gt", "ge"}, {"eq", "ne"}, - {"&", "^"}, - {"|", "neg"}, {"!", "~"}, {"++", "--"}, {"atan2", "cos"}, {"sin", "exp"}, {"log", "sqrt"}, {"x","x="}, - {".",".="} + {".",".="}, + {"=","neg"} }; #else EXT char * AMG_names[NofAMmeth][2]; @@ -1531,6 +1918,9 @@ enum { 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, @@ -1538,16 +1928,24 @@ enum { 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 + concat_amg, concat_ass_amg, + copy_amg, neg_amg }; #endif /* OVERLOAD */ +#if !defined(PERLIO_IS_STDIO) && defined(HAS_ATTRIBUTE) +/* + * Now we have __attribute__ out of the way + * Remap printf + */ +#define printf PerlIO_stdoutf +#endif + #endif /* Include guard */ +