1/* This file is Based on output from
2 * Perl/Pollution/Portability Version 2.0000 */
3
4#ifndef _P_P_PORTABILITY_H_
5#define _P_P_PORTABILITY_H_
6
7#ifndef PERL_REVISION
8#   ifndef __PATCHLEVEL_H_INCLUDED__
9#       include "patchlevel.h"
10#   endif
11#   ifndef PERL_REVISION
12#	define PERL_REVISION	(5)
13        /* Replace: 1 */
14#       define PERL_VERSION	PATCHLEVEL
15#       define PERL_SUBVERSION	SUBVERSION
16        /* Replace PERL_PATCHLEVEL with PERL_VERSION */
17        /* Replace: 0 */
18#   endif
19#endif
20
21#define PERL_BCDVERSION ((PERL_REVISION * 0x1000000L) + (PERL_VERSION * 0x1000L) + PERL_SUBVERSION)
22
23#ifndef ERRSV
24#	define ERRSV perl_get_sv("@",FALSE)
25#endif
26
27#if (PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION <= 5))
28/* Replace: 1 */
29#	define PL_Sv		Sv
30#	define PL_compiling	compiling
31#	define PL_copline	copline
32#	define PL_curcop	curcop
33#	define PL_curstash	curstash
34#	define PL_defgv		defgv
35#	define PL_dirty		dirty
36#	define PL_hints		hints
37#	define PL_na		na
38#	define PL_perldb	perldb
39#	define PL_rsfp_filters	rsfp_filters
40#	define PL_rsfp		rsfp
41#	define PL_stdingv	stdingv
42#	define PL_sv_no		sv_no
43#	define PL_sv_undef	sv_undef
44#	define PL_sv_yes	sv_yes
45/* Replace: 0 */
46#endif
47
48#ifndef pTHX
49#    define pTHX
50#    define pTHX_
51#    define aTHX
52#    define aTHX_
53#endif
54
55#ifndef PTR2IV
56#    define PTR2IV(d)   (IV)(d)
57#endif
58
59#ifndef INT2PTR
60#    define INT2PTR(any,d)      (any)(d)
61#endif
62
63#ifndef dTHR
64#  ifdef WIN32
65#	define dTHR extern int Perl___notused
66#  else
67#	define dTHR extern int errno
68#  endif
69#endif
70
71#ifndef boolSV
72#	define boolSV(b) ((b) ? &PL_sv_yes : &PL_sv_no)
73#endif
74
75#ifndef gv_stashpvn
76#	define gv_stashpvn(str,len,flags) gv_stashpv(str,flags)
77#endif
78
79#ifndef newSVpvn
80#	define newSVpvn(data,len) ((len) ? newSVpv ((data), (len)) : newSVpv ("", 0))
81#endif
82
83#ifndef newRV_inc
84/* Replace: 1 */
85#	define newRV_inc(sv) newRV(sv)
86/* Replace: 0 */
87#endif
88
89#ifndef SvGETMAGIC
90#  define SvGETMAGIC(x)                  STMT_START { if (SvGMAGICAL(x)) mg_get(x); } STMT_END
91#endif
92
93
94/* DEFSV appears first in 5.004_56 */
95#ifndef DEFSV
96#  define DEFSV	GvSV(PL_defgv)
97#endif
98
99#ifndef SAVE_DEFSV
100#    define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv))
101#endif
102
103#ifndef newRV_noinc
104#  ifdef __GNUC__
105#    define newRV_noinc(sv)               \
106      ({                                  \
107          SV *nsv = (SV*)newRV(sv);       \
108          SvREFCNT_dec(sv);               \
109          nsv;                            \
110      })
111#  else
112#    if defined(CRIPPLED_CC) || defined(USE_THREADS)
113static SV * newRV_noinc (SV * sv)
114{
115          SV *nsv = (SV*)newRV(sv);
116          SvREFCNT_dec(sv);
117          return nsv;
118}
119#    else
120#      define newRV_noinc(sv)    \
121        ((PL_Sv=(SV*)newRV(sv), SvREFCNT_dec(sv), (SV*)PL_Sv)
122#    endif
123#  endif
124#endif
125
126/* Provide: newCONSTSUB */
127
128/* newCONSTSUB from IO.xs is in the core starting with 5.004_63 */
129#if (PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION < 63))
130
131#if defined(NEED_newCONSTSUB)
132static
133#else
134extern void newCONSTSUB _((HV * stash, char * name, SV *sv));
135#endif
136
137#if defined(NEED_newCONSTSUB) || defined(NEED_newCONSTSUB_GLOBAL)
138void
139newCONSTSUB(stash,name,sv)
140HV *stash;
141char *name;
142SV *sv;
143{
144	U32 oldhints = PL_hints;
145	HV *old_cop_stash = PL_curcop->cop_stash;
146	HV *old_curstash = PL_curstash;
147	line_t oldline = PL_curcop->cop_line;
148	PL_curcop->cop_line = PL_copline;
149
150	PL_hints &= ~HINT_BLOCK_SCOPE;
151	if (stash)
152		PL_curstash = PL_curcop->cop_stash = stash;
153
154	newSUB(
155
156#if (PERL_VERSION < 3) || ((PERL_VERSION == 3) && (PERL_SUBVERSION < 22))
157     /* before 5.003_22 */
158		start_subparse(),
159#else
160#  if (PERL_VERSION == 3) && (PERL_SUBVERSION == 22)
161     /* 5.003_22 */
162     		start_subparse(0),
163#  else
164     /* 5.003_23  onwards */
165     		start_subparse(FALSE, 0),
166#  endif
167#endif
168
169		newSVOP(OP_CONST, 0, newSVpv(name,0)),
170		newSVOP(OP_CONST, 0, &PL_sv_no),   /* SvPV(&PL_sv_no) == "" -- GMB */
171		newSTATEOP(0, Nullch, newSVOP(OP_CONST, 0, sv))
172	);
173
174	PL_hints = oldhints;
175	PL_curcop->cop_stash = old_cop_stash;
176	PL_curstash = old_curstash;
177	PL_curcop->cop_line = oldline;
178}
179#endif
180
181#endif /* newCONSTSUB */
182
183
184#ifndef START_MY_CXT
185
186/*
187 * Boilerplate macros for initializing and accessing interpreter-local
188 * data from C.  All statics in extensions should be reworked to use
189 * this, if you want to make the extension thread-safe.  See ext/re/re.xs
190 * for an example of the use of these macros.
191 *
192 * Code that uses these macros is responsible for the following:
193 * 1. #define MY_CXT_KEY to a unique string, e.g. "DynaLoader_guts"
194 * 2. Declare a typedef named my_cxt_t that is a structure that contains
195 *    all the data that needs to be interpreter-local.
196 * 3. Use the START_MY_CXT macro after the declaration of my_cxt_t.
197 * 4. Use the MY_CXT_INIT macro such that it is called exactly once
198 *    (typically put in the BOOT: section).
199 * 5. Use the members of the my_cxt_t structure everywhere as
200 *    MY_CXT.member.
201 * 6. Use the dMY_CXT macro (a declaration) in all the functions that
202 *    access MY_CXT.
203 */
204
205#if defined(MULTIPLICITY) || defined(PERL_OBJECT) || \
206    defined(PERL_CAPI)    || defined(PERL_IMPLICIT_CONTEXT)
207
208/* This must appear in all extensions that define a my_cxt_t structure,
209 * right after the definition (i.e. at file scope).  The non-threads
210 * case below uses it to declare the data as static. */
211#define START_MY_CXT
212
213#if PERL_REVISION == 5 && \
214    (PERL_VERSION < 4 || (PERL_VERSION == 4 && PERL_SUBVERSION < 68 ))
215/* Fetches the SV that keeps the per-interpreter data. */
216#define dMY_CXT_SV \
217	SV *my_cxt_sv = perl_get_sv(MY_CXT_KEY, FALSE)
218#else /* >= perl5.004_68 */
219#define dMY_CXT_SV \
220	SV *my_cxt_sv = *hv_fetch(PL_modglobal, MY_CXT_KEY,		\
221				  sizeof(MY_CXT_KEY)-1, TRUE)
222#endif /* < perl5.004_68 */
223
224/* This declaration should be used within all functions that use the
225 * interpreter-local data. */
226#define dMY_CXT	\
227	dMY_CXT_SV;							\
228	my_cxt_t *my_cxtp = INT2PTR(my_cxt_t*,SvUV(my_cxt_sv))
229
230/* Creates and zeroes the per-interpreter data.
231 * (We allocate my_cxtp in a Perl SV so that it will be released when
232 * the interpreter goes away.) */
233#define MY_CXT_INIT \
234	dMY_CXT_SV;							\
235	/* newSV() allocates one more than needed */			\
236	my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\
237	Zero(my_cxtp, 1, my_cxt_t);					\
238	sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
239
240/* This macro must be used to access members of the my_cxt_t structure.
241 * e.g. MYCXT.some_data */
242#define MY_CXT		(*my_cxtp)
243
244/* Judicious use of these macros can reduce the number of times dMY_CXT
245 * is used.  Use is similar to pTHX, aTHX etc. */
246#define pMY_CXT		my_cxt_t *my_cxtp
247#define pMY_CXT_	pMY_CXT,
248#define _pMY_CXT	,pMY_CXT
249#define aMY_CXT		my_cxtp
250#define aMY_CXT_	aMY_CXT,
251#define _aMY_CXT	,aMY_CXT
252
253#else /* single interpreter */
254
255#ifndef NOOP
256#  define NOOP (void)0
257#endif
258
259#ifdef HASATTRIBUTE
260#  define PERL_UNUSED_DECL __attribute__((unused))
261#else
262#  define PERL_UNUSED_DECL
263#endif
264
265#ifndef dNOOP
266#  define dNOOP extern int Perl___notused PERL_UNUSED_DECL
267#endif
268
269#define START_MY_CXT	static my_cxt_t my_cxt;
270#define dMY_CXT_SV	dNOOP
271#define dMY_CXT		dNOOP
272#define MY_CXT_INIT	NOOP
273#define MY_CXT		my_cxt
274
275#define pMY_CXT		void
276#define pMY_CXT_
277#define _pMY_CXT
278#define aMY_CXT
279#define aMY_CXT_
280#define _aMY_CXT
281
282#endif
283
284#endif /* START_MY_CXT */
285
286
287#if 1
288#ifdef DBM_setFilter
289#undef DBM_setFilter
290#undef DBM_ckFilter
291#endif
292#endif
293
294#ifndef DBM_setFilter
295
296/*
297   The DBM_setFilter & DBM_ckFilter macros are only used by
298   the *DB*_File modules
299*/
300
301#define DBM_setFilter(db_type,code)				\
302	{							\
303	    if (db_type)					\
304	        RETVAL = sv_mortalcopy(db_type) ;		\
305	    ST(0) = RETVAL ;					\
306	    if (db_type && (code == &PL_sv_undef)) {		\
307                SvREFCNT_dec(db_type) ;				\
308	        db_type = NULL ;				\
309	    }							\
310	    else if (code) {					\
311	        if (db_type)					\
312	            sv_setsv(db_type, code) ;			\
313	        else						\
314	            db_type = newSVsv(code) ;			\
315	    }	    						\
316	}
317
318#define DBM_ckFilter(arg,type,name)				\
319	if (db->type) {						\
320	    /* printf("Filtering %s\n", name); */		\
321	    if (db->filtering) {				\
322	        croak("recursion detected in %s", name) ;	\
323	    }                     				\
324	    ENTER ;						\
325	    SAVETMPS ;						\
326	    SAVEINT(db->filtering) ;				\
327	    db->filtering = TRUE ;				\
328	    SAVESPTR(DEFSV) ;					\
329	    if (name[7] == 's')  				\
330	        arg = newSVsv(arg);				\
331	    DEFSV = arg ;					\
332	    SvTEMP_off(arg) ;					\
333	    PUSHMARK(SP) ;					\
334	    PUTBACK ;						\
335	    (void) perl_call_sv(db->type, G_DISCARD); 		\
336	    arg = DEFSV ;					\
337	    SPAGAIN ;						\
338	    PUTBACK ;						\
339	    FREETMPS ;						\
340	    LEAVE ;						\
341	    if (name[7] == 's'){ 				\
342	        arg = sv_2mortal(arg);				\
343	    }							\
344	    SvOKp(arg);						\
345	}
346
347#endif /* DBM_setFilter */
348
349#endif /* _P_P_PORTABILITY_H_ */
350