/* perl.h
*
- * Copyright (c) 1987-2001, Larry Wall
+ * Copyright (c) 1987-2002, 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.
*
*/
+
#ifndef H_PERL
#define H_PERL 1
-#define PL_OP_SLAB_ALLOC
-
#ifdef PERL_FOR_X2P
/*
* This file is being used for x2p stuff.
#define USE_STDIO
#endif /* PERL_FOR_X2P */
+#if defined(DGUX)
+#include <sys/fcntl.h>
+#endif
+
+#ifdef VOIDUSED
+# undef VOIDUSED
+#endif
#define VOIDUSED 1
+
#ifdef PERL_MICRO
# include "uconfig.h"
#else
/* See L<perlguts/"The Perl API"> for detailed notes on
* PERL_IMPLICIT_CONTEXT and PERL_IMPLICIT_SYS */
+/* Note that from here --> to <-- the same logic is
+ * repeated in makedef.pl, so be certain to update
+ * both places when editing. */
+
+#ifdef PERL_IMPLICIT_SYS
+/* PERL_IMPLICIT_SYS implies PerlMemShared != PerlMem
+ so use slab allocator to avoid lots of MUTEX overhead
+ */
+# ifndef PL_OP_SLAB_ALLOC
+# define PL_OP_SLAB_ALLOC
+# endif
+#endif
+
#ifdef USE_ITHREADS
# if !defined(MULTIPLICITY)
# define MULTIPLICITY
# endif
#endif
+/* undef WIN32 when building on Cygwin (for libwin32) - gph */
+#ifdef __CYGWIN__
+# undef WIN32
+# undef _WIN32
+#endif
+
+/* Use the reentrant APIs like localtime_r and getpwent_r */
+/* Win32 has naturally threadsafe libraries, no need to use any _r variants. */
+#if defined(USE_ITHREADS) && !defined(USE_REENTRANT_API) && !defined(NETWARE) && !defined(WIN32) && !defined(__APPLE__)
+# define USE_REENTRANT_API
+#endif
+
+/* <--- here ends the logic shared by perl.h and makedef.pl */
+
#ifdef PERL_IMPLICIT_CONTEXT
# ifdef USE_5005THREADS
struct perl_thread;
#endif
#ifdef HASATTRIBUTE
-# define PERL_UNUSED_DECL __attribute__((unused))
+# if defined(__GNUC__) && defined(__cplusplus)
+# define PERL_UNUSED_DECL
+# else
+# define PERL_UNUSED_DECL __attribute__((unused))
+# endif
#else
# define PERL_UNUSED_DECL
#endif
# endif
#endif
-/* Use the reentrant APIs like localtime_r and getpwent_r */
-/* Win32 has naturally threadsafe libraries, no need to use any _r variants. */
-#if defined(USE_ITHREADS) && !defined(USE_REENTRANT_API) && !defined(WIN32)
-# define USE_REENTRANT_API
-#endif
-
/* HP-UX 10.X CMA (Common Multithreaded Architecure) insists that
pthread.h must be included before all other header files.
*/
# define MYSWAP
#endif
-/* Cannot include embed.h here on Win32 as win32.h has not
+/* Cannot include embed.h here on Win32 as win32.h has not
yet been included and defines some config variables e.g. HAVE_INTERP_INTERN
*/
#if !defined(PERL_FOR_X2P) && !(defined(WIN32)||defined(VMS))
# else
# define EMBEDMYMALLOC /* for compatibility */
# endif
+START_EXTERN_C
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);
/* 'mfree' rather than 'free', since there is already a 'perl_free'
* that causes clashes with case-insensitive linkers */
Free_t Perl_mfree (Malloc_t where);
+END_EXTERN_C
typedef struct perl_mstats perl_mstats_t;
# else
# define Perl_frexp(x,y) ((long double)frexp((double)(x),y))
# endif
-# ifndef Perl_isinf
+# ifndef Perl_isnan
# ifdef HAS_ISNANL
# define Perl_isnan(x) isnanl(x)
# endif
#if !defined(Perl_fp_class) && defined(HAS_FPCLASSIFY)
# include <math.h>
# define Perl_fp_class(x) fpclassify(x)
-# define Perl_fp_class_nan(x) (fp_classify(x)==FP_SNAN|FP|_fp_classify(x)==QNAN)
+# define Perl_fp_class_nan(x) (fp_classify(x)==FP_SNAN||fp_classify(x)==FP_QNAN)
# define Perl_fp_class_inf(x) (fp_classify(x)==FP_INFINITE)
# define Perl_fp_class_norm(x) (fp_classify(x)==FP_NORMAL)
# define Perl_fp_class_denorm(x) (fp_classify(x)==FP_SUBNORMAL)
# endif
#endif
-#define Perl_atof(s) Perl_my_atof(s)
-#define Perl_atof2(s, np) Perl_my_atof2(s, np)
+/* The default is to use Perl's own atof() implementation (in numeric.c).
+ * Usually that is the one to use but for some platforms (e.g. UNICOS)
+ * it is however best to use the native implementation of atof.
+ * You can experiment with using your native one by -DUSE_PERL_ATOF=0.
+ * Some good tests to try out with either setting are t/base/num.t,
+ * t/op/numconvert.t, and t/op/pack.t. */
+
+#ifndef USE_PERL_ATOF
+# ifndef _UNICOS
+# define USE_PERL_ATOF
+# endif
+#else
+# if USE_PERL_ATOF == 0
+# undef USE_PERL_ATOF
+# endif
+#endif
+
+#ifdef USE_PERL_ATOF
+# define Perl_atof(s) Perl_my_atof(s)
+# define Perl_atof2(s, n) Perl_my_atof2(aTHX_ (s), &(n))
+#else
+# define Perl_atof(s) (NV)atof(s)
+# define Perl_atof2(s, n) ((n) = atof(s))
+#endif
/* Previously these definitions used hardcoded figures.
* It is hoped these formula are more portable, although
#define FILTER_DATA(idx) (AvARRAY(PL_rsfp_filters)[idx])
#define FILTER_ISREADER(idx) (idx >= AvFILLp(PL_rsfp_filters))
+#if defined(_AIX) && !defined(_AIX43)
+#if defined(USE_REENTRANT) || defined(_REENTRANT) || defined(_THREAD_SAFE)
+/* We cannot include <crypt.h> to get the struct crypt_data
+ * because of setkey prototype problems when threading */
+typedef struct crypt_data { /* straight from /usr/include/crypt.h */
+ /* From OSF, Not needed in AIX
+ char C[28], D[28];
+ */
+ char E[48];
+ char KS[16][48];
+ char block[66];
+ char iobuf[16];
+} CRYPTD;
+#endif /* threading */
+#endif /* AIX */
+
#if !defined(OS2) && !defined(MACOS_TRADITIONAL)
# include "iperlsys.h"
#endif
#include "scope.h"
#include "warnings.h"
#include "utf8.h"
-#include "sharedsv.h"
/* Current curly descriptor */
typedef struct curcur CURCUR;
# define htovs(x) vtohs(x)
# endif
/* otherwise default to functions in util.c */
+#ifndef htovs
+short htovs(short n);
+short vtohs(short n);
+long htovl(long n);
+long vtohl(long n);
+#endif
#endif
/* *MAX Plus 1. A floating point value.
#define DEBUG_S_FLAG 0x00010000 /* 65536 */
#define DEBUG_T_FLAG 0x00020000 /* 131072 */
#define DEBUG_R_FLAG 0x00040000 /* 262144 */
-#define DEBUG_MASK 0x0007FFFF /* mask of all the standard flags */
+#define DEBUG_J_FLAG 0x00080000 /* 524288 */
+#define DEBUG_MASK 0x000FFFFF /* mask of all the standard flags */
#define DEBUG_DB_RECURSE_FLAG 0x40000000
-#define DEBUG_TOP_FLAG 0x80000000 /* XXX what's this for ??? */
-
+#define DEBUG_TOP_FLAG 0x80000000 /* XXX what's this for ??? Signal
+ that something was done? */
# define DEBUG_p_TEST_ (PL_debug & DEBUG_p_FLAG)
# define DEBUG_s_TEST_ (PL_debug & DEBUG_s_FLAG)
# define DEBUG_S_TEST_ (PL_debug & DEBUG_S_FLAG)
# define DEBUG_T_TEST_ (PL_debug & DEBUG_T_FLAG)
# define DEBUG_R_TEST_ (PL_debug & DEBUG_R_FLAG)
+# define DEBUG_J_TEST_ (PL_debug & DEBUG_J_FLAG)
#ifdef DEBUGGING
# define DEBUG_S_TEST DEBUG_S_TEST_
# define DEBUG_T_TEST DEBUG_T_TEST_
# define DEBUG_R_TEST DEBUG_R_TEST_
+# define DEBUG_J_TEST DEBUG_J_TEST_
# define DEB(a) a
# define DEBUG(a) if (PL_debug) a
# define DEBUG_S_TEST (0)
# define DEBUG_T_TEST (0)
# define DEBUG_R_TEST (0)
+# define DEBUG_J_TEST (0)
# define DEB(a)
# define DEBUG(a)
#define PERL_MAGIC_nkeys 'k' /* scalar(keys()) lvalue */
#define PERL_MAGIC_dbfile 'L' /* Debugger %_<filename */
#define PERL_MAGIC_dbline 'l' /* Debugger %_<filename element */
-#define PERL_MAGIC_mutex 'm' /* ??? */
+#define PERL_MAGIC_mutex 'm' /* for lock op */
+#define PERL_MAGIC_shared 'N' /* Shared between threads */
+#define PERL_MAGIC_shared_scalar 'n' /* Shared between threads */
#define PERL_MAGIC_collxfrm 'o' /* Locale transformation */
#define PERL_MAGIC_tied 'P' /* Tied array or hash */
#define PERL_MAGIC_tiedelem 'p' /* Tied array or hash element */
#define PERL_MAGIC_sigelem 's' /* %SIG hash element */
#define PERL_MAGIC_taint 't' /* Taintedness */
#define PERL_MAGIC_uvar 'U' /* Available for use by extensions */
+#define PERL_MAGIC_uvar_elem 'u' /* Reserved for use by extensions */
#define PERL_MAGIC_vec 'v' /* vec() lvalue */
#define PERL_MAGIC_substr 'x' /* substr() lvalue */
#define PERL_MAGIC_defelem 'y' /* Shadow "foreach" iterator variable /
#define PERL_MAGIC_glob '*' /* GV (typeglob) */
#define PERL_MAGIC_arylen '#' /* Array length ($#ary) */
#define PERL_MAGIC_pos '.' /* pos() lvalue */
-#define PERL_MAGIC_backref '<' /* ??? */
+#define PERL_MAGIC_backref '<' /* for weak ref data */
#define PERL_MAGIC_ext '~' /* Available for use by extensions */
#define YYMAXDEPTH 300
#ifndef assert /* <assert.h> might have been included somehow */
+#ifdef DEBUGGING
+#define assert(what) DEB( { \
+ if (!(what)) { \
+ Perl_croak(aTHX_ "Assertion " STRINGIFY(what) " failed: file \"%s\", line %d", \
+ __FILE__, __LINE__); \
+ PerlProc_exit(1); \
+ }})
+#else
#define assert(what) DEB( { \
if (!(what)) { \
Perl_croak(aTHX_ "Assertion failed: file \"%s\", line %d", \
PerlProc_exit(1); \
}})
#endif
+#endif
struct ufuncs {
I32 (*uf_val)(pTHX_ IV, SV*);
char *crypt (); /* Maybe more hosts will need the unprototyped version */
# else
# if !defined(WIN32) && !defined(VMS)
+#ifndef crypt
char *crypt (const char*, const char*);
+#endif
# endif /* !WIN32 */
# endif /* !NeXT && !__NeXT__ */
# ifndef DONT_DECLARE_STD
# endif
# endif
# endif /* !DONT_DECLARE_STD */
+#ifndef getlogin
char *getlogin (void);
+#endif
#endif /* !__cplusplus */
#ifdef UNLINK_ALL_VERSIONS /* Currently only makes sense for VMS */
typedef int (CPERLscope(*runops_proc_t)) (pTHX);
+typedef void (CPERLscope(*share_proc_t)) (pTHX_ SV *sv);
+typedef int (CPERLscope(*thrhook_proc_t)) (pTHX);
typedef OP* (CPERLscope(*PPADDR_t)[]) (pTHX);
/* _ (for $_) must be first in the following list (DEFSV requires it) */
};
#define PERL_DEBUG_PAD(i) &(PL_debug_pad.pad[i])
-#define PERL_DEBUG_PAD_ZERO(i) (sv_setpvn(PERL_DEBUG_PAD(i), "", 0), PERL_DEBUG_PAD(i))
+#define PERL_DEBUG_PAD_ZERO(i) (SvPVX(PERL_DEBUG_PAD(i))[0] = 0, SvCUR(PERL_DEBUG_PAD(i)) = 0, PERL_DEBUG_PAD(i))
/* Enable variables which are pointers to functions */
typedef void (CPERLscope(*peep_t))(pTHX_ OP* o);
#ifdef DOINIT
-EXT MGVTBL PL_vtbl_sv = {MEMBER_TO_FPTR(Perl_magic_get),
+EXT MGVTBL PL_vtbl_sv = {MEMBER_TO_FPTR(Perl_magic_get),
MEMBER_TO_FPTR(Perl_magic_set),
MEMBER_TO_FPTR(Perl_magic_len),
0, 0};
0, MEMBER_TO_FPTR(Perl_magic_clearsig),
0};
#endif
-EXT MGVTBL PL_vtbl_pack = {0, 0, MEMBER_TO_FPTR(Perl_magic_sizepack), MEMBER_TO_FPTR(Perl_magic_wipepack),
+EXT MGVTBL PL_vtbl_pack = {0, 0,
+ MEMBER_TO_FPTR(Perl_magic_sizepack),
+ MEMBER_TO_FPTR(Perl_magic_wipepack),
0};
EXT MGVTBL PL_vtbl_packelem = {MEMBER_TO_FPTR(Perl_magic_getpack),
- MEMBER_TO_FPTR(Perl_magic_setpack),
+ MEMBER_TO_FPTR(Perl_magic_setpack),
0, MEMBER_TO_FPTR(Perl_magic_clearpack),
0};
EXT MGVTBL PL_vtbl_dbline = {0, MEMBER_TO_FPTR(Perl_magic_setdbline),
EXT MGVTBL PL_vtbl_nkeys = {MEMBER_TO_FPTR(Perl_magic_getnkeys),
MEMBER_TO_FPTR(Perl_magic_setnkeys),
0, 0, 0};
-EXT MGVTBL PL_vtbl_taint = {MEMBER_TO_FPTR(Perl_magic_gettaint),MEMBER_TO_FPTR(Perl_magic_settaint),
+EXT MGVTBL PL_vtbl_taint = {MEMBER_TO_FPTR(Perl_magic_gettaint),
+ MEMBER_TO_FPTR(Perl_magic_settaint),
0, 0, 0};
-EXT MGVTBL PL_vtbl_substr = {MEMBER_TO_FPTR(Perl_magic_getsubstr), MEMBER_TO_FPTR(Perl_magic_setsubstr),
+EXT MGVTBL PL_vtbl_substr = {MEMBER_TO_FPTR(Perl_magic_getsubstr),
+ MEMBER_TO_FPTR(Perl_magic_setsubstr),
0, 0, 0};
EXT MGVTBL PL_vtbl_vec = {MEMBER_TO_FPTR(Perl_magic_getvec),
- MEMBER_TO_FPTR(Perl_magic_setvec),
+ MEMBER_TO_FPTR(Perl_magic_setvec),
0, 0, 0};
EXT MGVTBL PL_vtbl_pos = {MEMBER_TO_FPTR(Perl_magic_getpos),
MEMBER_TO_FPTR(Perl_magic_setpos),
MEMBER_TO_FPTR(Perl_magic_setuvar),
0, 0, 0};
#ifdef USE_5005THREADS
-EXT MGVTBL PL_vtbl_mutex = {0, 0, 0, 0, MEMBER_TO_FPTR(Perl_magic_mutexfree)};
+EXT MGVTBL PL_vtbl_mutex = {0, 0, 0, 0,
+ MEMBER_TO_FPTR(Perl_magic_mutexfree)};
#endif /* USE_5005THREADS */
-EXT MGVTBL PL_vtbl_defelem = {MEMBER_TO_FPTR(Perl_magic_getdefelem),MEMBER_TO_FPTR(Perl_magic_setdefelem),
+EXT MGVTBL PL_vtbl_defelem = {MEMBER_TO_FPTR(Perl_magic_getdefelem),
+ MEMBER_TO_FPTR(Perl_magic_setdefelem),
0, 0, 0};
EXT MGVTBL PL_vtbl_regexp = {0,0,0,0, MEMBER_TO_FPTR(Perl_magic_freeregexp)};
END_EXTERN_C
struct am_table {
- long was_ok_sub;
+ U32 was_ok_sub;
long was_ok_am;
U32 flags;
CV* table[NofAMmeth];
long fallback;
};
struct am_table_short {
- long was_ok_sub;
+ U32 was_ok_sub;
long was_ok_am;
U32 flags;
};
#define STORE_NUMERIC_STANDARD_SET_LOCAL() /**/
#define RESTORE_NUMERIC_LOCAL() /**/
#define RESTORE_NUMERIC_STANDARD() /**/
-#define Atof Perl_atof
+#define Atof my_atof
#define IN_LOCALE_RUNTIME 0
#endif /* !USE_LOCALE_NUMERIC */
# ifdef __hpux
# define strtoll __strtoll /* secret handshake */
# endif
+# ifdef WIN64
+# define strtoll _strtoi64 /* secret handshake */
+# endif
# if !defined(Strtol) && defined(HAS_STRTOLL)
# define Strtol strtoll
# endif
* (as is done for Atoul(), see below) but for backward compatibility
* we just assume atol(). */
# if defined(USE_64_BIT_INT) && defined(IV_IS_QUAD) && QUADKIND == QUAD_IS_LONG_LONG && defined(HAS_ATOLL)
+# ifdef WIN64
+# define atoll _atoi64 /* secret handshake */
+# endif
# define Atol atoll
# else
# define Atol atol
# ifdef __hpux
# define strtoull __strtoull /* secret handshake */
# endif
+# ifdef WIN64
+# define strtoull _strtoui64 /* secret handshake */
+# endif
# if !defined(Strtoul) && defined(HAS_STRTOULL)
# define Strtoul strtoull
# endif
# define Atoul(s) Strtoul(s, (char **)NULL, 10)
#endif
-#if !defined(PERLIO_IS_STDIO) && defined(HASATTRIBUTE)
+#if !defined(PERLIO_IS_STDIO)
/*
- * Now we have __attribute__ out of the way
* Remap printf
*/
#undef printf
* Boilerplate macros for initializing and accessing interpreter-local
* data from C. All statics in extensions should be reworked to use
* this, if you want to make the extension thread-safe. See ext/re/re.xs
- * for an example of the use of these macros.
+ * for an example of the use of these macros, and perlxs.pod for more.
*
* Code that uses these macros is responsible for the following:
- * 1. #define MY_CXT_KEY to a unique string, e.g. "DynaLoader_guts"
+ * 1. #define MY_CXT_KEY to a unique string, e.g.
+ * "DynaLoader::_guts" XS_VERSION
* 2. Declare a typedef named my_cxt_t that is a structure that contains
* all the data that needs to be interpreter-local.
* 3. Use the START_MY_CXT macro after the declaration of my_cxt_t.