#define USE_STDIO
#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 CPERLarg CPerlObj *pPerl
+#define CPERLarg_ CPERLarg,
+#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 CPERLarg void
+#define CPERLarg_
+#define _CPERLarg
+#define PERL_OBJECT_THIS
+#define _PERL_OBJECT_THIS
+#define PERL_OBJECT_THIS_
+#define CALLRUNOPS runops
+
+#endif /* PERL_OBJECT */
+
#define VOIDUSED 1
#include "config.h"
# 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 "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 >= AvFILL(rsfp_filters))
+#define FILTER_ISREADER(idx) (idx >= AvFILLp(rsfp_filters))
#ifdef DOSISH
# if defined(OS2)
# 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>
# endif
#endif
+#ifdef UNION_ANY_DEFINITION
+UNION_ANY_DEFINITION;
+#else
union any {
void* any_ptr;
I32 any_i32;
IV any_iv;
long any_long;
- void (*any_dptr) _((void*));
+ void (CPERLscope(*any_dptr)) _((void*));
};
+#endif
#ifdef USE_THREADS
#define ARGSproto struct perl_thread *thr
#include "hv.h"
#include "mg.h"
#include "scope.h"
+#include "bytecode.h"
+#include "byterun.h"
+
+/* Current curly descriptor */
+typedef struct curcur CURCUR;
+struct curcur {
+ int parenfloor; /* how far back to strip paren data */
+ int cur; /* how many instances of scan we've matched */
+ int min; /* the minimal number of scans to match */
+ int max; /* the maximal number of scans to match */
+ int minmod; /* whether to work our way up or down */
+ regnode * scan; /* the thing to match */
+ regnode * next; /* what has to match after it */
+ char * lastloc; /* where we started matching this scan */
+ CURCUR * oldcc; /* current curly before we started this one */
+};
+
+typedef struct _sublex_info SUBLEXINFO;
+struct _sublex_info {
+ I32 super_state; /* lexer state to save */
+ I32 sub_inwhat; /* "lex_inwhat" to use */
+ OP *sub_op; /* "lex_op" to use */
+};
+
+#ifdef PERL_OBJECT
+struct magic_state {
+ SV* mgs_sv;
+ U32 mgs_flags;
+};
+typedef struct magic_state MGS;
+
+typedef struct {
+ I32 len_min;
+ I32 len_delta;
+ I32 pos_min;
+ I32 pos_delta;
+ SV *last_found;
+ I32 last_end; /* min value, <0 unless valid. */
+ I32 last_start_min;
+ I32 last_start_max;
+ SV **longest; /* Either &l_fixed, or &l_float. */
+ SV *longest_fixed;
+ I32 offset_fixed;
+ SV *longest_float;
+ I32 offset_float_min;
+ I32 offset_float_max;
+ I32 flags;
+} scan_data_t;
+
+typedef I32 CHECKPOINT;
+#endif /* PERL_OBJECT */
/* work around some libPW problems */
#ifdef DOINIT
if (!(what)) { \
croak("Assertion failed: file \"%s\", line %d", \
__FILE__, __LINE__); \
- exit(1); \
+ PerlProc_exit(1); \
}})
#endif
* included until after runops is initialised.
*/
+#ifndef PERL_OBJECT
typedef int runops_proc_t _((void));
int runops_standard _((void));
#ifdef DEBUGGING
int runops_debug _((void));
#endif
+#endif /* PERL_OBJECT */
/* _ (for $_) must be first in the following list (DEFSV requires it) */
#define THREADSV_NAMES "_123456789&`'+/.,\\\";^-%=|~:\001\005!@"
#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))
/* 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*));
+
+typedef int (CPerlObj::*runops_proc_t) _((void));
+#undef EXT
+#define EXT
+#undef EXTCONST
+#define EXTCONST
+#undef INIT
+#define INIT(x)
+
+class CPerlObj {
+public:
+ CPerlObj(IPerlMem*, IPerlEnv*, IPerlStdIO*, IPerlLIO*, IPerlDir*, IPerlSock*, IPerlProc*);
+ void Init(void);
+ void* operator new(size_t nSize, IPerlMem *pvtbl);
+#endif /* PERL_OBJECT */
+
#ifdef PERL_GLOBAL_STRUCT
struct perl_vars {
#include "perlvars.h"
#include "intrpvar.h"
#endif
+#ifdef PERL_OBJECT
+};
+
+#include "objpp.h"
+#ifdef DOINIT
+#include "INTERN.h"
+#else
+#include "EXTERN.h"
+#endif
+#endif /* PERL_OBJECT */
+
#undef PERLVAR
#undef PERLVARI
* It has to go here or #define of printf messes up __attribute__
* stuff in proto.h
*/
+#ifndef PERL_OBJECT
# include <win32iop.h>
+#endif /* PERL_OBJECT */
#endif /* WIN32 */
#ifdef DOINIT
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,
subtr_amg, subtr_ass_amg,
mult_amg, mult_ass_amg,
div_amg, div_ass_amg,
- mod_amg, mod_ass_amg,
+ modulo_amg, modulo_ass_amg,
pow_amg, pow_ass_amg,
lshift_amg, lshift_ass_amg,
rshift_amg, rshift_ass_amg,
#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 */
-
https://perl5.git.perl.org / perl5.git / blobdiff