#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 START_EXTERN_C
+# define END_EXTERN_C
+# define EXTERN_C
+#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
+
/*
* STMT_START { statements; } STMT_END;
* can be used as a single statement, as in
# endif
#endif
+#define NOOP (void)0
+
+#define WITH_THR(s) do { dTHR; s; } while (0)
+
/*
* 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.
# define STANDARD_C 1
#endif
-#if defined(__cplusplus) || defined(WIN32)
+#if defined(__cplusplus) || defined(WIN32) || defined(__sgi)
# define DONT_DECLARE_STD 1
#endif
# define SETERRNO(errcode,vmserrcode) errno = (errcode)
#endif
+#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("_"))
+#else
+# define ERRSV GvSV(errgv)
+# define ERRHV GvHV(errgv)
+# define DEFSV GvSV(defgv)
+# define SAVE_DEFSV SAVESPTR(GvSV(defgv))
+#endif /* USE_THREADS */
+
#ifndef errno
extern int errno; /* ANSI allows errno to be an lvalue expr */
#endif
typedef struct gp GP;
typedef struct gv GV;
typedef struct io IO;
-typedef struct context CONTEXT;
+typedef struct context PERL_CONTEXT;
typedef struct block BLOCK;
typedef struct magic MAGIC;
# include "unixish.h"
# endif
# 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
+# include <pthread.h>
+typedef pthread_mutex_t perl_mutex;
+typedef pthread_cond_t perl_cond;
+typedef pthread_key_t perl_key;
+# endif /* WIN32 */
+# endif /* FAKE_THREADS */
+#endif /* USE_THREADS */
+
+
#ifdef VMS
# define STATUS_NATIVE statusvalue_vms
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"
#define U_I(what) ((unsigned int)(what))
#define U_L(what) ((U32)(what))
#else
-# ifdef __cplusplus
- extern "C" {
-# endif
-U32 cast_ulong _((double));
-# ifdef __cplusplus
- }
-# endif
+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)))
#define I_V(what) ((IV)(what))
#define U_V(what) ((UV)(what))
#else
-# ifdef __cplusplus
- extern "C" {
-# endif
+START_EXTERN_C
I32 cast_i32 _((double));
IV cast_iv _((double));
UV cast_uv _((double));
-# ifdef __cplusplus
- }
-# endif
+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)))
#ifdef I_MATH
# include <math.h>
#else
-# ifdef __cplusplus
- extern "C" {
-# endif
+START_EXTERN_C
double exp _((double));
double log _((double));
double log10 _((double));
double cos _((double));
double atan2 _((double,double));
double pow _((double,double));
-# ifdef __cplusplus
- };
-# endif
+END_EXTERN_C
#endif
#ifndef __cplusplus
# define register
# endif
# define PAD_SV(po) pad_sv(po)
+# define RUNOPS_DEFAULT runops_debug
#else
# 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.
+ */
+
+int runops_standard _((void));
+#ifdef DEBUGGING
+int runops_debug _((void));
+#endif
+
+#define THREADSV_NAMES "_123456789&`'+/.,\\\";^-%=|~:\001\005!@"
+
/****************/
/* Truly global */
/****************/
/* global state */
EXT PerlInterpreter * curinterp; /* currently running interpreter */
+#ifdef USE_THREADS
+EXT perl_key thr_key; /* For per-thread struct perl_thread* */
+EXT perl_mutex sv_mutex; /* Mutex for allocating SVs in sv.c */
+EXT perl_mutex malloc_mutex; /* Mutex for malloc */
+EXT perl_mutex eval_mutex; /* Mutex for doeval */
+EXT perl_cond eval_cond; /* Condition variable for doeval */
+EXT struct perl_thread * eval_owner; /* Owner thread for doeval */
+EXT int nthreads; /* Number of threads currently */
+EXT perl_mutex threads_mutex; /* Mutex for nthreads and thread list */
+EXT perl_cond nthreads_cond; /* Condition variable for nthreads */
+EXT char * threadsv_names INIT(THREADSV_NAMES);
+#ifdef FAKE_THREADS
+EXT struct perl_thread * thr; /* Currently executing (fake) thread */
+#endif
+#endif /* USE_THREADS */
+
/* VMS doesn't use environ array and NeXT has problems with crt0.o globals */
#if !defined(VMS) && !(defined(NeXT) && defined(__DYNAMIC__))
-#ifndef DONT_DECLARE_STD
+#if !defined(DONT_DECLARE_STD) || (defined(__svr4__) && defined(__GNUC__) && defined(sun)) || defined(__sgi)
extern char ** environ; /* environment variables supplied via exec */
#endif
#else
EXT int maxo INIT(MAXO);/* Number of ops */
EXT char * osname; /* operating system */
EXT char * sh_path INIT(SH_PATH); /* full path of shell */
+EXT Sighandler_t sighandlerp;
EXT XPV* xiv_arenaroot; /* list of allocated xiv areas */
EXT IV ** xiv_root; /* free xiv list--shared by interpreters */
/* likewise for these */
-EXT OP * op; /* current op--oughta be in a global register */
-
+#ifdef OP_IN_REGISTER
+EXT OP * opsave; /* save current op register across longjmps */
+#else
+EXT OP * op; /* current op--when not in a global register */
+#endif
+EXT int (*runops) _((void)) INIT(RUNOPS_DEFAULT);
EXT I32 * scopestack; /* blocks we've entered */
EXT I32 scopestack_ix;
EXT I32 scopestack_max;
EXT char * last_lop; /* position of last list operator */
EXT OPCODE last_lop_op; /* last list operator */
EXT bool in_my; /* we're compiling a "my" declaration */
+EXT HV * in_my_stash; /* declared class of this "my" declaration */
#ifdef FCRYPT
EXT I32 cryptseen; /* has fast crypt() been initialized? */
#endif
#define HINT_STRICT_VARS 0x00000400
#define HINT_LOCALE 0x00000800
-/**************************************************************************/
-/* This regexp stuff is global since it always happens within 1 expr eval */
-/**************************************************************************/
-
-EXT char * regprecomp; /* uncompiled string. */
-EXT char * regparse; /* Input-scan pointer. */
-EXT char * regxend; /* End of input for compile */
-EXT I32 regnpar; /* () count. */
-EXT char * regcode; /* Code-emit pointer; ®dummy = don't. */
-EXT I32 regsize; /* Code size. */
-EXT I32 regnaughty; /* How bad is this pattern? */
-EXT I32 regsawback; /* Did we see \1, ...? */
-
-EXT char * reginput; /* String-input pointer. */
-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 U32 * reglastparen; /* Similarly for lastparen. */
-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;
IEXT HV * Idefstash; /* main symbol table */
IEXT HV * Icurstash; /* symbol table for current package */
IEXT HV * Idebstash; /* symbol table for perldb package */
+IEXT HV * Iglobalstash; /* global keyword overrides imported here */
IEXT SV * Icurstname; /* name of current package */
IEXT AV * Ibeginav; /* names of BEGIN subroutines */
IEXT AV * Iendav; /* names of END subroutines */
+IEXT AV * Iinitav; /* names of INIT subroutines */
IEXT HV * Istrtab; /* shared string table */
/* memory management */
IEXT COP * VOL Icurcop IINIT(&compiling);
IEXT COP * Icurcopdb IINIT(NULL);
IEXT line_t Icopline IINIT(NOLINE);
-IEXT CONTEXT * Icxstack;
+IEXT PERL_CONTEXT * Icxstack;
IEXT I32 Icxstack_ix IINIT(-1);
IEXT I32 Icxstack_max IINIT(128);
IEXT JMPENV Istart_env; /* empty startup sigjmp() environment */
IEXT JMPENV * Itop_env; /* ptr. to current sigjmp() environment */
-IEXT I32 Irunlevel;
/* stack stuff */
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 */
-IEXT SV ** Imystack_max; /* stack->array_ary + stack->array_max */
/* format accumulators */
IEXT SV * Iformtarget;
IEXT I32 Ilaststype IINIT(OP_STAT);
IEXT SV * Imess_sv;
+#ifdef USE_THREADS
+/* threads stuff */
+IEXT SV * Ithrsv; /* holds struct perl_thread for main thread */
+#endif /* USE_THREADS */
+
#undef IEXT
#undef IINIT
};
#endif
+#include "thread.h"
#include "pp.h"
-#ifdef __cplusplus
-extern "C" {
-#endif
-
+START_EXTERN_C
#include "proto.h"
#ifdef EMBED
#define sv_setptrref(rv,ptr) sv_setref_iv(rv,Nullch,(IV)ptr)
#endif
-#ifdef __cplusplus
-};
-#endif
+END_EXTERN_C
/* The following must follow proto.h */
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,
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;
#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 { \
+ MUTEX_LOCK(&sv_mutex); \
+ if (!nice_chunk) { \
+ nice_chunk = (char*)(chunk); \
+ nice_chunk_size = (chunk_size); \
+ } \
+ MUTEX_UNLOCK(&sv_mutex); \
+ } while (0)
+
#endif /* Include guard */