# ifdef __GNUC__
# define stringify_immed(s) #s
# define stringify(s) stringify_immed(s)
+#ifdef EMBED
+register struct op *Perl_op asm(stringify(OP_IN_REGISTER));
+#else
register struct op *op asm(stringify(OP_IN_REGISTER));
+#endif
# endif
#endif
#define NOOP (void)0
-#define WITH_THR(s) do { dTHR; s; } while (0)
+#define WITH_THR(s) STMT_START { dTHR; s; } STMT_END
/*
* SOFT_CAST can be used for args to prototyped functions to retain some
#define SOFT_CAST(type) (type)
#endif
-#ifndef BYTEORDER
+#ifndef BYTEORDER /* Should never happen -- byteorder is in config.h */
# define BYTEORDER 0x1234
#endif
# define STANDARD_C 1
#endif
-#if defined(__cplusplus) || defined(WIN32) || defined(__sgi)
+#if defined(__cplusplus) || defined(WIN32) || defined(__sgi) || defined(OS2) || defined(__DGUX)
# define DONT_DECLARE_STD 1
#endif
#endif
#include "perlio.h"
+#include "perllio.h"
+#include "perlsock.h"
+#include "perlproc.h"
+#include "perlenv.h"
+#include "perldir.h"
#ifdef USE_NEXT_CTYPE
#ifdef USE_THREADS
# define ERRSV (thr->errsv)
# define ERRHV (thr->errhv)
-# define DEFSV *av_fetch(thr->threadsv, find_threadsv("_"), FALSE)
-# define SAVE_DEFSV save_threadsv(find_threadsv("_"))
+# define DEFSV THREADSV(0)
+# define SAVE_DEFSV save_threadsv(0)
#else
# define ERRSV GvSV(errgv)
# define ERRHV GvHV(errgv)
# ifdef convex
# define Quad_t long long
# else
-# if BYTEORDER > 0xFFFF
+# if LONGSIZE == 8
# define Quad_t long
# endif
# endif
#endif
+/* XXX Experimental set-up for long long. Just add -DUSE_LONG_LONG
+ to your ccflags. --Andy Dougherty 4/1998
+*/
+#ifdef USE_LONG_LONG
+# if defined(HAS_LONG_LONG) && LONGLONGSIZE == 8
+# define Quad_t long long
+# endif
+#endif
+
#ifdef Quad_t
# define HAS_QUAD
typedef Quad_t IV;
# ifdef MAXUSHORT
# define PERL_USHORT_MAX ((unsigned short)MAXUSHORT)
# else
-# define PERL_USHORT_MAX ((unsigned short)~(unsigned)0)
+# ifdef USHRT_MAX
+# define PERL_USHORT_MAX ((unsigned short)USHRT_MAX)
+# else
+# define PERL_USHORT_MAX ((unsigned short)~(unsigned)0)
+# endif
# endif
#endif
# ifdef MAXSHORT /* Often used in <values.h> */
# define PERL_SHORT_MAX ((short)MAXSHORT)
# else
-# define PERL_SHORT_MAX ((short) (PERL_USHORT_MAX >> 1))
+# ifdef SHRT_MAX
+# define PERL_SHORT_MAX ((short)SHRT_MAX)
+# else
+# define PERL_SHORT_MAX ((short) (PERL_USHORT_MAX >> 1))
+# endif
# endif
#endif
# ifdef MINSHORT
# define PERL_SHORT_MIN ((short)MINSHORT)
# else
-# define PERL_SHORT_MIN (-PERL_SHORT_MAX - ((3 & -1) == 3))
+# ifdef SHRT_MIN
+# define PERL_SHORT_MIN ((short)SHRT_MIN)
+# else
+# define PERL_SHORT_MIN (-PERL_SHORT_MAX - ((3 & -1) == 3))
+# endif
# endif
#endif
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))
+#define FILTER_ISREADER(idx) (idx >= AvFILLp(rsfp_filters))
#ifdef DOSISH
# if defined(OS2)
#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>
+ * 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 WIN32
# include <win32thread.h>
# else
-# include <pthread.h>
+# 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 */
#include "hv.h"
#include "mg.h"
#include "scope.h"
+#include "bytecode.h"
+#include "byterun.h"
/* work around some libPW problems */
#ifdef DOINIT
if (!(what)) { \
croak("Assertion failed: file \"%s\", line %d", \
__FILE__, __LINE__); \
- exit(1); \
+ PerlProc_exit(1); \
}})
#endif
#endif
#ifndef __cplusplus
-#ifdef __NeXT__ /* or whatever catches all NeXTs */
+# ifdef __NeXT__ /* or whatever catches all NeXTs */
char *crypt (); /* Maybe more hosts will need the unprototyped version */
-#else
+# else
+# if !defined(WIN32) || !defined(HAVE_DES_FCRYPT)
char *crypt _((const char*, const char*));
-#endif
-#ifndef DONT_DECLARE_STD
-#ifndef getenv
+# endif /* !WIN32 && !HAVE_CRYPT_SOURCE */
+# endif /* !__NeXT__ */
+# ifndef DONT_DECLARE_STD
+# ifndef getenv
char *getenv _((const char*));
-#endif
+# endif /* !getenv */
Off_t lseek _((int,Off_t,int));
-#endif
+# endif /* !DONT_DECLARE_STD */
char *getlogin _((void));
-#endif
+#endif /* !__cplusplus */
#ifdef UNLINK_ALL_VERSIONS /* Currently only makes sense for VMS */
#define UNLINK unlnk
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)
+#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
EXT char * dc;
/* handy constants */
-EXTCONST char * Yes INIT("1");
-EXTCONST char * No INIT("");
-EXTCONST char * hexdigit INIT("0123456789abcdef0123456789ABCDEFx");
-EXTCONST char * patleave INIT("\\.^$@dDwWsSbB+*?|()-nrtfeaxc0123456789[{]}");
-EXTCONST char * vert INIT("|");
-
EXTCONST char warn_uninit[]
INIT("Use of uninitialized value");
EXTCONST char warn_nosemi[]
/* 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;
+
+/* Interpreter exitlist entry */
+typedef struct exitlistentry {
+ void (*fn) _((void*));
+ void *ptr;
+} PerlExitListEntry;
#ifdef PERL_GLOBAL_STRUCT
struct perl_vars {
#include "thrdvar.h"
};
+typedef struct perl_thread *Thread;
+
+#else
+typedef void *Thread;
#endif
/* Done with PERLVAR macros for now ... */
#undef PERLVAR
#undef PERLVARI
-
-typedef struct perl_thread *Thread;
+#undef PERLVARIC
#include "thread.h"
#include "pp.h"
#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"
#undef PERLVAR
#undef PERLVARI
+#undef PERLVARIC
#if defined(HASATTRIBUTE) && defined(WIN32)
/*
magic_setsig,
0, magic_clearsig,
0};
-EXT MGVTBL vtbl_pack = {0, 0, 0, magic_wipepack,
+EXT MGVTBL vtbl_pack = {0, 0, magic_sizepack, magic_wipepack,
0};
EXT MGVTBL vtbl_packelem = {magic_getpack,
magic_setpack,
0, 0, 0};
EXT MGVTBL vtbl_mglob = {0, magic_setmglob,
0, 0, 0};
-EXT MGVTBL vtbl_nkeys = {0, magic_setnkeys,
+EXT MGVTBL vtbl_nkeys = {magic_getnkeys,
+ magic_setnkeys,
0, 0, 0};
EXT MGVTBL vtbl_taint = {magic_gettaint,magic_settaint,
0, 0, 0};
-EXT MGVTBL vtbl_substr = {0, magic_setsubstr,
+EXT MGVTBL vtbl_substr = {magic_getsubstr, magic_setsubstr,
0, 0, 0};
-EXT MGVTBL vtbl_vec = {0, magic_setvec,
+EXT MGVTBL vtbl_vec = {magic_getvec,
+ magic_setvec,
0, 0, 0};
EXT MGVTBL vtbl_pos = {magic_getpos,
magic_setpos,
#endif /* OVERLOAD */
-#define PERLDB_ALL 0xff
+#define PERLDB_ALL 0x3f /* No _NONAME, _GOTO */
#define PERLDBf_SUB 0x01 /* Debug sub enter/exit. */
#define PERLDBf_LINE 0x02 /* Keep line #. */
#define PERLDBf_NOOPT 0x04 /* Switch off optimizations. */
later inspections. */
#define PERLDBf_SUBLINE 0x10 /* Keep subr source lines. */
#define PERLDBf_SINGLE 0x20 /* Start with single-step on. */
+#define PERLDBf_NONAME 0x40 /* For _SUB: no name of the subr. */
+#define PERLDBf_GOTO 0x80 /* Report goto: call DB::goto. */
#define PERLDB_SUB (perldb && (perldb & PERLDBf_SUB))
#define PERLDB_LINE (perldb && (perldb & PERLDBf_LINE))
#define PERLDB_INTER (perldb && (perldb & PERLDBf_INTER))
#define PERLDB_SUBLINE (perldb && (perldb & PERLDBf_SUBLINE))
#define PERLDB_SINGLE (perldb && (perldb & PERLDBf_SINGLE))
+#define PERLDB_SUB_NN (perldb && (perldb & (PERLDBf_NONAME)))
+#define PERLDB_GOTO (perldb && (perldb & PERLDBf_GOTO))
#ifdef USE_LOCALE_NUMERIC
#endif /* !USE_LOCALE_NUMERIC */
-#if !defined(PERLIO_IS_STDIO) && defined(HAS_ATTRIBUTE)
+#if !defined(PERLIO_IS_STDIO) && defined(HASATTRIBUTE)
/*
* Now we have __attribute__ out of the way
* Remap printf
* and queried under the protection of sv_mutex
*/
#define offer_nice_chunk(chunk, chunk_size) do { \
- MUTEX_LOCK(&sv_mutex); \
+ LOCK_SV_MUTEX; \
if (!nice_chunk) { \
nice_chunk = (char*)(chunk); \
nice_chunk_size = (chunk_size); \
} \
- MUTEX_UNLOCK(&sv_mutex); \
+ else { \
+ Safefree(chunk); \
+ } \
+ UNLOCK_SV_MUTEX; \
} while (0)
projects / p5sagit/p5-mst-13.2.git / blobdiff