X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl.h;h=c8a33a0ab14308fab1e874d5569eb89d029a3917;hb=f6d98b14fd224d7fe398ef16332eaa45bf13b92f;hp=e33122ad90448a4285fd47b716dada4a624d9977;hpb=8490252049bf42d3d2f75d89178a8682bf22ba74;p=p5sagit%2Fp5-mst-13.2.git diff --git a/perl.h b/perl.h index e33122a..c8a33a0 100644 --- a/perl.h +++ b/perl.h @@ -29,6 +29,14 @@ #include "embed.h" +#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 @@ -52,6 +60,25 @@ # endif #endif +#define NOOP (void)0 + +#define WITH_THR(s) do { dTHR; s; } while (0) + +#ifdef USE_THREADS +# ifdef FAKE_THREADS +# include "fakethr.h" +# else +# ifdef WIN32 +# include "win32/win32thread.h" +# else +# include +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 */ + /* * 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. @@ -845,6 +872,11 @@ #endif +/* Digital UNIX defines a typedef CONTEXT when pthreads is in use */ +#if defined(__osf__) +# define CONTEXT PERL_CONTEXT +#endif + typedef MEM_SIZE STRLEN; typedef struct op OP; @@ -996,6 +1028,12 @@ union any { void (*any_dptr) _((void*)); }; +#ifdef USE_THREADS +#define ARGSproto struct thread * +#else +#define ARGSproto void +#endif /* USE_THREADS */ + /* Work around some cygwin32 problems with importing global symbols */ #if defined(CYGWIN32) && defined(DLLIMPORT) # include "cw32imp.h" @@ -1284,8 +1322,20 @@ typedef Sighandler_t Sigsave_t; # 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 + +/* + * These need prototyping here because isn't + * included until after runops is initialised. + */ + +int runops_standard _((void)); +#ifdef DEBUGGING +int runops_debug _((void)); #endif /****************/ @@ -1294,6 +1344,21 @@ typedef Sighandler_t Sigsave_t; /* global state */ EXT PerlInterpreter * curinterp; /* currently running interpreter */ +#ifdef USE_THREADS +EXT perl_key thr_key; /* For per-thread struct thread ptr */ +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 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 */ +#ifdef FAKE_THREADS +EXT struct 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 @@ -1325,6 +1390,7 @@ EXT U32 * profiledata; 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 */ @@ -1342,8 +1408,12 @@ EXT SV ** stack_max; /* stack->array_ary + stack->array_max */ /* 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; @@ -1578,6 +1648,8 @@ EXTCONST char* block_type[]; #include "perly.h" +#define LEX_NOTPARSING 11 /* borrowed from toke.c */ + typedef enum { XOPERATOR, XTERM, @@ -1645,6 +1717,7 @@ EXT char * last_uni; /* position of last named-unary operator */ 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 @@ -1802,6 +1875,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 * Iinitav; /* names of INIT subroutines */ IEXT HV * Istrtab; /* shared string table */ /* memory management */ @@ -1859,9 +1933,6 @@ 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; @@ -1891,6 +1962,11 @@ IEXT int Ilaststatval IINIT(-1); IEXT I32 Ilaststype IINIT(OP_STAT); IEXT SV * Imess_sv; +#ifdef USE_THREADS +/* threads stuff */ +IEXT SV * Ithrsv; /* holds struct thread for main thread */ +#endif /* USE_THREADS */ + #undef IEXT #undef IINIT @@ -1902,6 +1978,7 @@ struct interpreter { }; #endif +#include "thread.h" #include "pp.h" #ifdef __cplusplus @@ -1930,7 +2007,8 @@ EXT MGVTBL vtbl_sv = {magic_get, magic_set, magic_len, 0, 0}; -EXT MGVTBL vtbl_env = {0, 0, 0, magic_clear_all_env, +EXT MGVTBL vtbl_env = {0, magic_set_all_env, + 0, magic_clear_all_env, 0}; EXT MGVTBL vtbl_envelem = {0, magic_setenv, 0, magic_clearenv, @@ -1949,7 +2027,8 @@ EXT MGVTBL vtbl_packelem = {magic_getpack, EXT MGVTBL vtbl_dbline = {0, magic_setdbline, 0, 0, 0}; EXT MGVTBL vtbl_isa = {0, magic_setisa, - 0, 0, 0}; + 0, magic_setisa, + 0}; EXT MGVTBL vtbl_isaelem = {0, magic_setisa, 0, 0, 0}; EXT MGVTBL vtbl_arylen = {magic_getarylen, @@ -1978,6 +2057,9 @@ EXT MGVTBL vtbl_fm = {0, magic_setfm, 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}; @@ -2017,6 +2099,11 @@ EXT MGVTBL vtbl_pos; 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; #ifdef USE_LOCALE_COLLATE @@ -2217,5 +2304,18 @@ EXT bool numeric_local INIT(TRUE); /* Assume local numerics */ #define printf PerlIO_stdoutf #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 */