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 ipdir.h for
-information on this).
+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.
#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 */
#define SOFT_CAST(type) (type)
#endif
-#ifndef BYTEORDER
+#ifndef BYTEORDER /* Should never happen -- byteorder is in config.h */
# define BYTEORDER 0x1234
#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;
#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))
*/
#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 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*));
#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
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
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 */
-