X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl.h;h=9be32457dee11b8a51ce6672cc7336009fcd32f9;hb=a3cb178b0bad32fa8be934503d051b96a3cb1fea;hp=21bd42f4469bc716dc43a17c7af087a84a811c57;hpb=8206a063cdc1c193b12df1a45cb3a0ee430b5077;p=p5sagit%2Fp5-mst-13.2.git diff --git a/perl.h b/perl.h index 21bd42f..9be3245 100644 --- a/perl.h +++ b/perl.h @@ -29,11 +29,28 @@ #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) +#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 @@ -62,17 +79,7 @@ register struct op *op asm(stringify(OP_IN_REGISTER)); #define NOOP (void)0 -#define WITH_THR(s) do { dTHR; s; } while (0) -#ifdef USE_THREADS -#ifdef FAKE_THREADS -#include "fakethr.h" -#else -#include -typedef pthread_mutex_t perl_mutex; -typedef pthread_cond_t perl_cond; -typedef pthread_key_t perl_key; -#endif /* FAKE_THREADS */ -#endif /* USE_THREADS */ +#define WITH_THR(s) STMT_START { dTHR; s; } STMT_END /* * SOFT_CAST can be used for args to prototyped functions to retain some @@ -110,7 +117,7 @@ typedef pthread_key_t perl_key; # define STANDARD_C 1 #endif -#if defined(__cplusplus) || defined(WIN32) +#if defined(__cplusplus) || defined(WIN32) || defined(__sgi) || defined(OS2) || defined(__DGUX) # define DONT_DECLARE_STD 1 #endif @@ -201,6 +208,11 @@ typedef pthread_key_t perl_key; #endif #include "perlio.h" +#include "perllio.h" +#include "perlsock.h" +#include "perlproc.h" +#include "perlenv.h" +#include "perldir.h" #ifdef USE_NEXT_CTYPE @@ -251,6 +263,8 @@ typedef pthread_key_t perl_key; # include #endif +#define MEM_SIZE Size_t + /* This comes after so we don't try to change the standard * library prototypes; we'll use our own in proto.h instead. */ @@ -261,12 +275,20 @@ typedef pthread_key_t perl_key; # define calloc Mycalloc # define realloc Myremalloc # define free Myfree +Malloc_t Mymalloc _((MEM_SIZE nbytes)); +Malloc_t Mycalloc _((MEM_SIZE elements, MEM_SIZE size)); +Malloc_t Myrealloc _((Malloc_t where, MEM_SIZE nbytes)); +Free_t Myfree _((Malloc_t where)); # endif # ifdef EMBEDMYMALLOC # define malloc Perl_malloc # define calloc Perl_calloc # define realloc Perl_realloc # define free Perl_free +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)); +Free_t Perl_free _((Malloc_t where)); # endif # undef safemalloc @@ -280,8 +302,6 @@ typedef pthread_key_t perl_key; #endif /* MYMALLOC */ -#define MEM_SIZE Size_t - #if defined(STANDARD_C) && defined(I_STDDEF) # include # define STRUCT_OFFSET(s,m) offsetof(s,m) @@ -383,8 +403,14 @@ typedef pthread_key_t perl_key; # include #endif +#if defined(SF_APPEND) && defined(USE_SFIO) && defined(I_SFIO) +/* defines SF_APPEND and might define SF_APPEND + * (the neo-BSD seem to do this). */ +# undef SF_APPEND +#endif + #ifdef I_SYS_STAT -#include +# include #endif /* The stat macros for Amdahl UTS, Unisoft System V/88 (and derivatives @@ -450,6 +476,18 @@ typedef pthread_key_t perl_key; # define SETERRNO(errcode,vmserrcode) errno = (errcode) #endif +#ifdef USE_THREADS +# define ERRSV (thr->errsv) +# define ERRHV (thr->errhv) +# define DEFSV THREADSV(0) +# define SAVE_DEFSV save_threadsv(0) +#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 @@ -749,7 +787,11 @@ typedef pthread_key_t perl_key; # 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 @@ -759,7 +801,11 @@ typedef pthread_key_t perl_key; # ifdef MAXSHORT /* Often used in */ # 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 @@ -769,7 +815,11 @@ typedef pthread_key_t perl_key; # 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 @@ -861,11 +911,6 @@ typedef pthread_key_t perl_key; #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; @@ -894,7 +939,7 @@ typedef struct regexp REGEXP; 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; @@ -920,7 +965,7 @@ typedef union any ANY; 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) @@ -938,7 +983,36 @@ typedef I32 (*filter_t) _((int, SV *, int)); # include "unixish.h" # endif # endif -#endif +#endif + +/* + * USE_THREADS needs to be after unixish.h as includes + * which defines NSIG - which will stop inclusion of + * 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 +# else +# ifdef OS2 +# include "os2thread.h" +# else +# include +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 */ + + #ifdef VMS # define STATUS_NATIVE statusvalue_vms @@ -1018,7 +1092,7 @@ union any { }; #ifdef USE_THREADS -#define ARGSproto struct thread * +#define ARGSproto struct perl_thread *thr #else #define ARGSproto void #endif /* USE_THREADS */ @@ -1041,6 +1115,8 @@ union any { #include "hv.h" #include "mg.h" #include "scope.h" +#include "bytecode.h" +#include "byterun.h" /* work around some libPW problems */ #ifdef DOINIT @@ -1110,13 +1186,7 @@ EXT char Error[1]; #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))) @@ -1127,15 +1197,11 @@ U32 cast_ulong _((double)); #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))) @@ -1212,7 +1278,7 @@ Gid_t getegid _((void)); if (!(what)) { \ croak("Assertion failed: file \"%s\", line %d", \ __FILE__, __LINE__); \ - exit(1); \ + PerlProc_exit(1); \ }}) #endif @@ -1240,9 +1306,7 @@ char *strcpy(), *strcat(); #ifdef I_MATH # include #else -# ifdef __cplusplus - extern "C" { -# endif +START_EXTERN_C double exp _((double)); double log _((double)); double log10 _((double)); @@ -1254,25 +1318,25 @@ char *strcpy(), *strcat(); double cos _((double)); double atan2 _((double,double)); double pow _((double,double)); -# ifdef __cplusplus - }; -# endif +END_EXTERN_C #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 @@ -1310,11 +1374,6 @@ typedef Sighandler_t Sigsave_t; # ifndef register # define register # endif -# ifdef MYMALLOC -# ifndef DEBUGGING_MSTATS -# define DEBUGGING_MSTATS -# endif -# endif # define PAD_SV(po) pad_sv(po) # define RUNOPS_DEFAULT runops_debug #else @@ -1322,30 +1381,34 @@ typedef Sighandler_t Sigsave_t; # define RUNOPS_DEFAULT runops_standard #endif -/****************/ -/* Truly global */ -/****************/ +#ifdef MYMALLOC +# define MALLOC_INIT MUTEX_INIT(&malloc_mutex) +# define MALLOC_TERM MUTEX_DESTROY(&malloc_mutex) +#else +# define MALLOC_INIT +# define MALLOC_TERM +#endif -/* 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 nthreads_mutex; /* Mutex for nthreads */ -EXT perl_cond nthreads_cond; /* Condition variable for nthreads */ -#ifdef FAKE_THREADS -EXT struct thread * thr; /* Currently executing (fake) thread */ + +/* + * These need prototyping here because isn't + * included until after runops is initialised. + */ + +typedef int runops_proc_t _((void)); +int runops_standard _((void)); +#ifdef DEBUGGING +int runops_debug _((void)); #endif -#endif /* USE_THREADS */ + +/* _ (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__)) -#ifndef DONT_DECLARE_STD +#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 @@ -1357,73 +1420,6 @@ EXT char *** environ_pointer; # endif #endif /* environ processing */ -EXT int uid; /* current real user id */ -EXT int euid; /* current effective user id */ -EXT int gid; /* current real group id */ -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 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 HV * pidstatus; /* pid-to-status mappings for waitpid */ -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 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 */ -EXT SV ** stack_sp; /* stack pointer now */ -EXT SV ** stack_max; /* stack->array_ary + stack->array_max */ - -/* likewise for these */ - -#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 ANY* savestack; /* to save non-local values on */ -EXT I32 savestack_ix; -EXT I32 savestack_max; - -EXT OP ** retstack; /* returns we've pushed */ -EXT I32 retstack_ix; -EXT I32 retstack_max; - -EXT I32 * markstack; /* stackmarks we're remembering */ -EXT I32 * markstack_ptr; /* stackmarks we're remembering */ -EXT I32 * markstack_max; /* stackmarks we're remembering */ - -EXT SV ** curpad; - -/* temp space */ -EXT SV * Sv; -EXT XPV * Xpv; -EXT char tokenbuf[256]; -EXT struct stat statbuf; -#ifdef HAS_TIMES -EXT struct tms timesbuf; -#endif -EXT STRLEN na; /* for use in SvPV when length is Not Applicable */ /* for tmp use in stupid debuggers */ EXT int * di; @@ -1431,12 +1427,6 @@ EXT short * ds; 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[] @@ -1470,14 +1460,6 @@ EXTCONST char no_func[] EXTCONST char no_myglob[] INIT("\"my\" variable %s can't be in a package"); -EXT SV sv_undef; -EXT SV sv_no; -EXT SV sv_yes; -#ifdef CSH - EXT char * cshname INIT(CSH); - EXT I32 cshlen; -#endif - #ifdef DOINIT EXT char *sig_name[] = { SIG_NAME }; EXT int sig_num[] = { SIG_NUM }; @@ -1631,6 +1613,8 @@ EXTCONST char* block_type[]; #include "perly.h" +#define LEX_NOTPARSING 11 /* borrowed from toke.c */ + typedef enum { XOPERATOR, XTERM, @@ -1640,70 +1624,6 @@ typedef enum { XTERMBLOCK } expectation; -EXT U32 lex_state; /* next token is determined */ -EXT U32 lex_defer; /* state after determined token */ -EXT expectation lex_expect; /* expect after determined token */ -EXT I32 lex_brackets; /* bracket count */ -EXT I32 lex_formbrack; /* bracket count at outer format level */ -EXT I32 lex_fakebrack; /* outer bracket is mere delimiter */ -EXT I32 lex_casemods; /* casemod count */ -EXT I32 lex_dojoin; /* doing an array interpolation */ -EXT I32 lex_starts; /* how many interps done on level */ -EXT SV * lex_stuff; /* runtime pattern from m// or s/// */ -EXT SV * lex_repl; /* runtime replacement from s/// */ -EXT OP * lex_op; /* extra info to pass back on op */ -EXT OP * lex_inpat; /* in pattern $) and $| are special */ -EXT I32 lex_inwhat; /* what kind of quoting are we in */ -EXT char * lex_brackstack; /* what kind of brackets to pop */ -EXT char * lex_casestack; /* what kind of case mods in effect */ - -/* What we know when we're in LEX_KNOWNEXT state. */ -EXT YYSTYPE nextval[5]; /* value of next token, if any */ -EXT I32 nexttype[5]; /* type of next token */ -EXT I32 nexttoke; - -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 AV * rsfp_filters; - -EXT I32 multi_start; /* 1st line of multi-line string */ -EXT I32 multi_end; /* last line of multi-line string */ -EXT I32 multi_open; /* delimiter of said string */ -EXT I32 multi_close; /* delimiter of said string */ - -EXT GV * scrgv; -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 I32 pad_reset_pending; /* reset pad on next attempted alloc */ -EXT COP compiling; - -EXT I32 thisexpr; /* name id for nothing_in_common() */ -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 - -EXT U32 hints; /* various compilation flags */ /* Note: the lowest 8 bits are reserved for stuffing into op->op_private */ @@ -1715,257 +1635,82 @@ EXT U32 hints; /* various compilation flags */ #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; - -/***********************************************/ -/* Global only to current interpreter instance */ -/***********************************************/ - -#ifdef MULTIPLICITY -#define IEXT -#define IINIT(x) -struct interpreter { -#else -#define IEXT EXT -#define IINIT(x) INIT(x) -#endif - -/* pseudo environmental stuff */ -IEXT int Iorigargc; -IEXT char ** Iorigargv; -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[10]; -IEXT char ** Ilocalpatches; -IEXT SV * Inrs; -IEXT char * Isplitstr IINIT(" "); -IEXT bool Ipreprocess; -IEXT bool Iminus_n; -IEXT bool Iminus_p; -IEXT bool Iminus_l; -IEXT bool Iminus_a; -IEXT bool Iminus_F; -IEXT bool Idoswitches; -IEXT bool Idowarn; -IEXT bool Idoextract; -IEXT bool Isawampersand; /* must save all match strings */ -IEXT bool Isawstudy; /* do fbm_instr on all strings */ -IEXT bool Isawvec; -IEXT bool Iunsafe; -IEXT char * Iinplace; -IEXT char * Ie_tmpname; -IEXT PerlIO * Ie_fp; -IEXT U32 Iperldb; - /* This value may be raised by extensions for testing purposes */ -IEXT int Iperl_destruct_level IINIT(0); /* 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 SV * Irs; /* $/ */ -IEXT char * Iofs; /* $, */ -IEXT STRLEN Iofslen; -IEXT char * Iors; /* $\ */ -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 I32 Istatusvalue; /* $? */ -#ifdef VMS -IEXT U32 Istatusvalue_vms; -#endif - -IEXT struct stat Istatcache; /* _ */ -IEXT GV * Istatgv; -IEXT SV * Istatname IINIT(Nullsv); - -/* shortcuts to various I/O objects */ -IEXT GV * Istdingv; -IEXT GV * Ilast_in_gv; -IEXT GV * Idefgv; -IEXT GV * Iargvgv; -IEXT GV * Idefoutgv; -IEXT GV * Iargvoutgv; - -/* shortcuts to regexp stuff */ -IEXT GV * Ileftgv; -IEXT GV * Iampergv; -IEXT GV * Irightgv; -IEXT PMOP * Icurpm; /* what to do \ interps from */ -IEXT I32 * Iscreamfirst; -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; -IEXT GV * IDBsub; -IEXT SV * IDBsingle; -IEXT SV * IDBtrace; -IEXT SV * IDBsignal; -IEXT AV * Ilineary; /* lines of script for debugger */ -IEXT AV * Idbargs; /* args to call listed by caller function */ - -/* symbol tables */ -IEXT HV * Idefstash; /* main symbol table */ -IEXT HV * Icurstash; /* symbol table for current package */ -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 */ -IEXT SV ** Itmps_stack; -IEXT I32 Itmps_ix IINIT(-1); -IEXT I32 Itmps_floor IINIT(-1); -IEXT I32 Itmps_max; -IEXT I32 Isv_count; /* how many SV* are currently allocated */ -IEXT I32 Isv_objcount; /* how many objects are currently allocated */ -IEXT SV* Isv_root; /* storage for SVs belonging to interp */ -IEXT SV* Isv_arenaroot; /* list of areas for garbage collection */ - -/* funky return mechanisms */ -IEXT I32 Ilastspbase; -IEXT I32 Ilastsize; -IEXT int Iforkprocess; /* so do_open |- can return proc# */ - -/* subprocess state */ -IEXT AV * Ifdpid; /* keep fd-to-pid mappings for my_popen */ - -/* internal state */ -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 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; -IEXT I32 Idlmax IINIT(128); -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; -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 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 */ -#if 0 -IEXT SV ** Imystack_base; /* stack->array_ary */ -IEXT SV ** Imystack_sp; /* stack pointer now */ -IEXT SV ** Imystack_max; /* stack->array_ary + stack->array_max */ -#endif - -/* format accumulators */ -IEXT SV * Iformtarget; -IEXT SV * Ibodytarget; -IEXT SV * Itoptarget; - -/* statics moved here for shared library purposes */ -IEXT SV Istrchop; /* return value from chop */ -IEXT int Ifilemode; /* so nextargv() can preserve mode */ -IEXT int Ilastfd; /* what to preserve mode on */ -IEXT char * Ioldname; /* what to preserve mode on */ -IEXT char ** IArgv; /* stuff to free from do_aexec, vfork safe */ -IEXT char * ICmd; /* stuff to free from do_aexec, vfork safe */ -IEXT OP * Isortcop; /* user defined sort routine */ -IEXT HV * Isortstash; /* which is in some package or other */ -IEXT GV * Ifirstgv; /* $a */ -IEXT GV * Isecondgv; /* $b */ -IEXT AV * Isortstack; /* temp stack during pp_sort() */ -IEXT AV * Isignalstack; /* temp stack during sighandler() */ -IEXT SV * Imystrk; /* temp key string for do_each() */ -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); -IEXT SV * Imess_sv; - -#undef IEXT -#undef IINIT +/* 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 "perlvars.h" +}; + +#ifdef PERL_CORE +EXT struct perl_vars Perl_Vars; +EXT struct perl_vars *Perl_VarsPtr INIT(&Perl_Vars); +#else +#if !defined(__GNUC__) || !defined(WIN32) +EXT +#endif +struct perl_vars *Perl_VarsPtr; +#define Perl_Vars (*((Perl_VarsPtr) ? Perl_VarsPtr : (Perl_VarsPtr = Perl_GetVars()))) +#endif +#endif /* PERL_GLOBAL_STRUCT */ #ifdef MULTIPLICITY +/* If we have multiple interpreters define a struct + holding variables which must be per-interpreter + If we don't have threads anything that would have + be per-thread is per-interpreter. +*/ + +struct interpreter { +#ifndef USE_THREADS +#include "thrdvar.h" +#endif +#include "intrpvar.h" }; + #else struct interpreter { char broiled; }; #endif -#include "thread.h" -#include "pp.h" +#ifdef USE_THREADS +/* If we have threads define a struct with all the variables + * that have to be per-thread + */ -#ifdef __cplusplus -extern "C" { + +struct perl_thread { +#include "thrdvar.h" +}; + +typedef struct perl_thread *Thread; + +#else +typedef void *Thread; #endif +/* Done with PERLVAR macros for now ... */ +#undef PERLVAR +#undef PERLVARI +#undef PERLVARIC + +#include "thread.h" +#include "pp.h" #include "proto.h" #ifdef EMBED @@ -1976,11 +1721,46 @@ extern "C" { #define sv_setptrref(rv,ptr) sv_setref_iv(rv,Nullch,(IV)ptr) #endif -#ifdef __cplusplus -}; +/* The following must follow proto.h as #defines mess up syntax */ + +#include "embedvar.h" + +/* Now include all the 'global' variables + * If we don't have threads or multiple interpreters + * these include variables that would have been their struct-s + */ + +#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" +#endif + +#ifndef MULTIPLICITY + +#ifndef USE_THREADS +#include "thrdvar.h" +#endif + +#include "intrpvar.h" #endif -/* The following must follow proto.h */ + +#undef PERLVAR +#undef PERLVARI +#undef PERLVARIC + +#if defined(HASATTRIBUTE) && defined(WIN32) +/* + * This provides a layer of functions and macros to ensure extensions will + * get to use the same RTL functions as the core. + * It has to go here or #define of printf messes up __attribute__ + * stuff in proto.h + */ +# include +#endif /* WIN32 */ #ifdef DOINIT @@ -1988,7 +1768,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, @@ -1998,7 +1779,7 @@ EXT MGVTBL vtbl_sigelem = {magic_getsig, 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, @@ -2007,7 +1788,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, @@ -2042,6 +1824,8 @@ EXT MGVTBL vtbl_mutex = {0, 0, 0, 0, magic_mutexfree}; 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, @@ -2084,6 +1868,7 @@ EXT MGVTBL vtbl_mutex; #endif /* USE_THREADS */ EXT MGVTBL vtbl_defelem; +EXT MGVTBL vtbl_regexp; #ifdef USE_LOCALE_COLLATE EXT MGVTBL vtbl_collxfrm; @@ -2098,8 +1883,6 @@ EXT MGVTBL vtbl_amagicelem; #ifdef OVERLOAD -EXT long amagic_generation; - #define NofAMmeth 58 #ifdef DOINIT EXTCONST char * AMG_names[NofAMmeth] = { @@ -2226,19 +2009,24 @@ enum { #endif /* OVERLOAD */ -#ifdef USE_LOCALE_COLLATE -EXT U32 collation_ix; /* Collation generation index */ -EXT char * collation_name; /* Name of current collation */ -EXT bool collation_standard INIT(TRUE); /* Assume simple collation */ -EXT Size_t collxfrm_base; /* Basic overhead in *xfrm() */ -EXT Size_t collxfrm_mult INIT(2); /* Expansion factor in *xfrm() */ -#endif /* USE_LOCALE_COLLATE */ +#define PERLDB_ALL 0xff +#define PERLDBf_SUB 0x01 /* Debug sub enter/exit. */ +#define PERLDBf_LINE 0x02 /* Keep line #. */ +#define PERLDBf_NOOPT 0x04 /* Switch off optimizations. */ +#define PERLDBf_INTER 0x08 /* Preserve more data for + later inspections. */ +#define PERLDBf_SUBLINE 0x10 /* Keep subr source lines. */ +#define PERLDBf_SINGLE 0x20 /* Start with single-step on. */ + +#define PERLDB_SUB (perldb && (perldb & PERLDBf_SUB)) +#define PERLDB_LINE (perldb && (perldb & PERLDBf_LINE)) +#define PERLDB_NOOPT (perldb && (perldb & PERLDBf_NOOPT)) +#define PERLDB_INTER (perldb && (perldb & PERLDBf_INTER)) +#define PERLDB_SUBLINE (perldb && (perldb & PERLDBf_SUBLINE)) +#define PERLDB_SINGLE (perldb && (perldb & PERLDBf_SINGLE)) -#ifdef USE_LOCALE_NUMERIC -EXT char * numeric_name; /* Name of current numeric locale */ -EXT bool numeric_standard INIT(TRUE); /* Assume simple numerics */ -EXT bool numeric_local INIT(TRUE); /* Assume local numerics */ +#ifdef USE_LOCALE_NUMERIC #define SET_NUMERIC_STANDARD() \ STMT_START { \ @@ -2259,7 +2047,7 @@ EXT bool numeric_local INIT(TRUE); /* Assume local numerics */ #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 @@ -2267,5 +2055,26 @@ EXT bool numeric_local INIT(TRUE); /* Assume local numerics */ #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 { \ + LOCK_SV_MUTEX; \ + if (!nice_chunk) { \ + nice_chunk = (char*)(chunk); \ + nice_chunk_size = (chunk_size); \ + } \ + else { \ + Safefree(chunk); \ + } \ + UNLOCK_SV_MUTEX; \ + } while (0) + + #endif /* Include guard */