#endif /* PERL_FOR_X2P */
#ifdef PERL_OBJECT
+
+/* PERL_OBJECT explained - DickH and DougL @ ActiveState.com
+
+Defining PERL_OBJECT turns on creation of a C++ object that
+contains all writable core perl global variables and functions.
+Stated another way, all necessary global variables and functions
+are members of a big C++ object. This object's class is CPerlObj.
+This allows a Perl Host to have multiple, independent perl
+interpreters in the same process space. This is very important on
+Win32 systems as the overhead of process creation is quite high --
+this could be even higher than the script compile and execute time
+for small scripts.
+
+The perl executable implementation on Win32 is composed of perl.exe
+(the Perl Host) and perlX.dll. (the Perl Core). This allows the
+same Perl Core to easily be embedded in other applications that use
+the perl interpreter.
+
++-----------+
+| Perl Host |
++-----------+
+ ^
+ |
+ v
++-----------+ +-----------+
+| Perl Core |<->| Extension |
++-----------+ +-----------+ ...
+
+Defining PERL_OBJECT has the following effects:
+
+PERL CORE
+1. CPerlObj is defined (this is the PERL_OBJECT)
+2. all static functions that needed to access either global
+variables or functions needed are made member functions
+3. all writable static variables are made member variables
+4. all global variables and functions are defined as:
+ #define var CPerlObj::Perl_var
+ #define func CPerlObj::Perl_func
+ * these are in objpp.h
+This necessitated renaming some local variables and functions that
+had the same name as a global variable or function. This was
+probably a _good_ thing anyway.
+
+
+EXTENSIONS
+1. Access to global variables and perl functions is through a
+pointer to the PERL_OBJECT. This pointer type is CPerlObj*. This is
+made transparent to extension developers by the following macros:
+ #define var pPerl->Perl_var
+ #define func pPerl->Perl_func
+ * these are done in ObjXSub.h
+This requires that the extension be compiled as C++, which means
+that the code must be ANSI C and not K&R C. For K&R extensions,
+please see the C API notes located in Win32/GenCAPI.pl. This script
+creates a PerlCAPI.lib that provides a K & R compatible C interface
+to the PERL_OBJECT.
+2. Local variables and functions cannot have the same name as perl's
+variables or functions since the macros will redefine these. Look for
+this if you get some strange error message and it does not look like
+the code that you had written. This often happens with variables that
+are local to a function.
+
+PERL HOST
+1. The perl host is linked with perlX.lib to get perl_alloc. This
+function will return a pointer to CPerlObj (the PERL_OBJECT). It
+takes pointers to the various PerlXXX_YYY interfaces (see iperlsys.h
+for more information on this).
+2. The perl host calls the same functions as normally would be
+called in setting up and running a perl script, except that the
+functions are now member functions of the PERL_OBJECT.
+
+*/
+
+
class CPerlObj;
#define STATIC
#define CPERLscope(x) CPerlObj::x
#define CPERLproto CPerlObj *
-#define CPERLproto_ CPERLproto,
+#define _CPERLproto ,CPERLproto
#define CPERLarg CPerlObj *pPerl
#define CPERLarg_ CPERLarg,
-#define THIS this
-#define THIS_ this,
+#define _CPERLarg ,CPERLarg
+#define PERL_OBJECT_THIS this
+#define _PERL_OBJECT_THIS ,this
+#define PERL_OBJECT_THIS_ this,
#define CALLRUNOPS (this->*runops)
#else /* !PERL_OBJECT */
#define STATIC static
#define CPERLscope(x) x
#define CPERLproto
-#define CPERLproto_
+#define _CPERLproto
#define CPERLarg void
#define CPERLarg_
-#define THIS
-#define THIS_
+#define _CPERLarg
+#define PERL_OBJECT_THIS
+#define _PERL_OBJECT_THIS
+#define PERL_OBJECT_THIS_
#define CALLRUNOPS runops
#endif /* PERL_OBJECT */
# 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 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) || defined(OS2) \
- || defined(__DGUX)
+#if defined(__cplusplus) || defined(WIN32) || defined(__sgi) || defined(OS2) || defined(__DGUX)
# define DONT_DECLARE_STD 1
#endif
# endif
#endif
-#include "perlio.h"
-#include "perlmem.h"
-#include "perllio.h"
-#include "perlsock.h"
-#include "perlproc.h"
-#include "perlenv.h"
-#include "perldir.h"
+#include "iperlsys.h"
#ifdef USE_NEXT_CTYPE
# ifdef HIDEMYMALLOC
# define malloc Mymalloc
# define calloc Mycalloc
-# define realloc Myremalloc
+# define realloc Myrealloc
# define free Myfree
Malloc_t Mymalloc _((MEM_SIZE nbytes));
Malloc_t Mycalloc _((MEM_SIZE elements, MEM_SIZE size));
# define malloc Perl_malloc
# define calloc Perl_calloc
# define realloc Perl_realloc
+/* VMS' external symbols are case-insensitive, and there's already a */
+/* perl_free in perl.h */
+#ifdef VMS
+# define free Perl_myfree
+#else
# define free Perl_free
+#endif
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));
+#ifdef VMS
+Free_t Perl_myfree _((Malloc_t where));
+#else
Free_t Perl_free _((Malloc_t where));
+#endif
# endif
# undef safemalloc
# undef HAS_STRERROR
#endif
-#ifndef HAS_MKFIFO
-# ifndef mkfifo
-# define mkfifo(path, mode) (mknod((path), (mode) | S_IFIFO, 0))
-# endif
-#endif /* !HAS_MKFIFO */
-
#include <errno.h>
#ifdef HAS_SOCKET
# ifdef I_NET_ERRNO
# 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
#include "handy.h"
+#ifdef PERL_OBJECT
+typedef I32 (*filter_t) _((CPerlObj*, int, SV *, int));
+#else
typedef I32 (*filter_t) _((int, SV *, int));
+#endif
+
#define FILTER_READ(idx, sv, len) filter_read(idx, sv, len)
#define FILTER_DATA(idx) (AvARRAY(rsfp_filters)[idx])
#define FILTER_ISREADER(idx) (idx >= AvFILLp(rsfp_filters))
# endif
#endif
+#ifndef FUNC_NAME_TO_PTR
+#define FUNC_NAME_TO_PTR(name) name
+#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>
*/
#ifdef USE_THREADS
+ /* pending resolution of licensing issues, we avoid the erstwhile
+ * atomic.h everywhere */
+# define EMULATE_ATOMIC_REFCOUNTS
+
# ifdef FAKE_THREADS
# include "fakethr.h"
# else
# endif
#endif
+#ifdef UNION_ANY_DEFINITION
+UNION_ANY_DEFINITION;
+#else
union any {
void* any_ptr;
I32 any_i32;
long any_long;
void (CPERLscope(*any_dptr)) _((void*));
};
+#endif
#ifdef USE_THREADS
#define ARGSproto struct perl_thread *thr
#define HINT_STRICT_VARS 0x00000400
#define HINT_LOCALE 0x00000800
+#define HINT_NEW_INTEGER 0x00001000
+#define HINT_NEW_FLOAT 0x00002000
+#define HINT_NEW_BINARY 0x00004000
+#define HINT_NEW_STRING 0x00008000
+#define HINT_NEW_RE 0x00010000
+#define HINT_LOCALIZE_HH 0x00020000 /* %^H needs to be copied */
+
+#define HINT_RE_TAINT 0x00100000
+#define HINT_RE_EVAL 0x00200000
+
/* 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))
+#define RsRECORD(sv) (SvROK(sv) && (SvIV(SvRV(sv)) > 0))
+
+/* Enable variables which are pointers to functions */
+typedef regexp*(*regcomp_t) _((char* exp, char* xend, PMOP* pm));
+typedef I32 (*regexec_t) _((regexp* prog, char* stringarg, char* strend, char*
+ strbeg, I32 minend, SV* screamer, void* data,
+ U32 flags));
/* 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 {
+#ifdef PERL_OBJECT
+ void (*fn) _((CPerlObj*, void*));
+#else
+ void (*fn) _((void*));
+#endif
+ void *ptr;
+} PerlExitListEntry;
+
#ifdef PERL_OBJECT
extern "C" CPerlObj* perl_alloc _((IPerlMem*, IPerlEnv*, IPerlStdIO*, IPerlLIO*, IPerlDir*, IPerlSock*, IPerlProc*));
#ifndef MULTIPLICITY
-#ifndef USE_THREADS
-#include "thrdvar.h"
-#endif
+# include "intrpvar.h"
+# ifndef USE_THREADS
+# include "thrdvar.h"
+# endif
-#include "intrpvar.h"
#endif
#ifdef PERL_OBJECT
-#if defined(WIN32)
-char** environ;
-#endif
};
#include "objpp.h"
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
nice_chunk = (char*)(chunk); \
nice_chunk_size = (chunk_size); \
} \
+ else { \
+ Safefree(chunk); \
+ } \
UNLOCK_SV_MUTEX; \
} while (0)
+#ifdef HAS_SEM
+# include <sys/ipc.h>
+# include <sys/sem.h>
+# ifndef HAS_UNION_SEMUN /* Provide the union semun. */
+ union semun {
+ int val;
+ struct semid_ds *buf;
+ unsigned short *array;
+ };
+# endif
+# ifdef USE_SEMCTL_SEMUN
+# define Semctl(id, num, cmd, semun) semctl(id, num, cmd, semun)
+# else
+# ifdef USE_SEMCTL_SEMID_DS
+# define Semctl(id, num, cmd, semun) semctl(id, num, cmd, semun.buf)
+# endif
+# endif
+# ifndef Semctl /* Place our bets on the semun horse. */
+# define Semctl(id, num, cmd, semun) semctl(id, num, cmd, semun)
+# endif
+#endif
#endif /* Include guard */
-
projects / p5sagit/p5-mst-13.2.git / blobdiff