serious bug introduced by G_VOID changes in 5.003_96: scalar
[p5sagit/p5-mst-13.2.git] / XSUB.h
CommitLineData
b4ba0ab9 1#ifndef _INC_PERL_XSUB_H
2#define _INC_PERL_XSUB_H 1
3
3280af22 4#define ST(off) PL_stack_base[ax + (off)]
a0d0e21e 5
873b149f 6#if defined(CYGWIN) && defined(USE_DYNAMIC_LOADING)
0cb96387 7# define XS(name) __declspec(dllexport) void name(pTHXo_ CV* cv)
cea2e8a9 8#else
0cb96387 9# define XS(name) void name(pTHXo_ CV* cv)
a0d0e21e 10#endif
11
12#define dXSARGS \
3c78fafa 13 dSP; dMARK; \
3280af22 14 I32 ax = mark - PL_stack_base + 1; \
a0d0e21e 15 I32 items = sp - mark
16
8a7fc0dc 17#define dXSTARG SV * targ = ((PL_op->op_private & OPpENTERSUB_HASTARG) \
18 ? PAD_SV(PL_op->op_targ) : sv_newmortal())
19
a0d0e21e 20#define XSANY CvXSUBANY(cv)
21
22#define dXSI32 I32 ix = XSANY.any_i32
23
cfc02341 24#ifdef __cplusplus
25# define XSINTERFACE_CVT(ret,name) ret (*name)(...)
26#else
27# define XSINTERFACE_CVT(ret,name) ret (*name)()
28#endif
29#define dXSFUNCTION(ret) XSINTERFACE_CVT(ret,XSFUNCTION)
73c4f7a1 30#define XSINTERFACE_FUNC(ret,cv,f) ((XSINTERFACE_CVT(ret,cv))(f))
cfc02341 31#define XSINTERFACE_FUNC_SET(cv,f) \
51371543 32 CvXSUBANY(cv).any_dptr = (void (*) (pTHXo_ void*))(f)
cfc02341 33
0e4ced38 34#define XSRETURN(off) \
35 STMT_START { \
3280af22 36 PL_stack_sp = PL_stack_base + ax + ((off) - 1); \
0e4ced38 37 return; \
38 } STMT_END
a0d0e21e 39
748a9306 40/* Simple macros to put new mortal values onto the stack. */
41/* Typically used to return values from XS functions. */
4633a7c4 42#define XST_mIV(i,v) (ST(i) = sv_2mortal(newSViv(v)) )
43#define XST_mNV(i,v) (ST(i) = sv_2mortal(newSVnv(v)) )
44#define XST_mPV(i,v) (ST(i) = sv_2mortal(newSVpv(v,0)))
79cb57f6 45#define XST_mPVN(i,v,n) (ST(i) = sv_2mortal(newSVpvn(v,n)))
3280af22 46#define XST_mNO(i) (ST(i) = &PL_sv_no )
47#define XST_mYES(i) (ST(i) = &PL_sv_yes )
48#define XST_mUNDEF(i) (ST(i) = &PL_sv_undef)
748a9306 49
80b92232 50#define XSRETURN_IV(v) STMT_START { XST_mIV(0,v); XSRETURN(1); } STMT_END
51#define XSRETURN_NV(v) STMT_START { XST_mNV(0,v); XSRETURN(1); } STMT_END
52#define XSRETURN_PV(v) STMT_START { XST_mPV(0,v); XSRETURN(1); } STMT_END
79cb57f6 53#define XSRETURN_PVN(v) STMT_START { XST_mPVN(0,v,n); XSRETURN(1); } STMT_END
80b92232 54#define XSRETURN_NO STMT_START { XST_mNO(0); XSRETURN(1); } STMT_END
55#define XSRETURN_YES STMT_START { XST_mYES(0); XSRETURN(1); } STMT_END
56#define XSRETURN_UNDEF STMT_START { XST_mUNDEF(0); XSRETURN(1); } STMT_END
57#define XSRETURN_EMPTY STMT_START { XSRETURN(0); } STMT_END
382b8d97 58
37120919 59#define newXSproto(a,b,c,d) sv_setpv((SV*)newXS(a,b,c), d)
720fb644 60
61#ifdef XS_VERSION
c6af7a1a 62# define XS_VERSION_BOOTCHECK \
774d564b 63 STMT_START { \
2d8e6c8d 64 SV *tmpsv; STRLEN n_a; \
65 char *vn = Nullch, *module = SvPV(ST(0),n_a); \
774d564b 66 if (items >= 2) /* version supplied as bootstrap arg */ \
6b88bc9c 67 tmpsv = ST(1); \
774d564b 68 else { \
46fc3d4c 69 /* XXX GV_ADDWARN */ \
cea2e8a9 70 tmpsv = get_sv(Perl_form(aTHX_ "%s::%s", module, \
864dbfa3 71 vn = "XS_VERSION"), FALSE); \
6b88bc9c 72 if (!tmpsv || !SvOK(tmpsv)) \
cea2e8a9 73 tmpsv = get_sv(Perl_form(aTHX_ "%s::%s", module, \
864dbfa3 74 vn = "VERSION"), FALSE); \
774d564b 75 } \
2d8e6c8d 76 if (tmpsv && (!SvOK(tmpsv) || strNE(XS_VERSION, SvPV(tmpsv, n_a)))) \
cea2e8a9 77 Perl_croak(aTHX_ "%s object version %s does not match %s%s%s%s %_", \
ae66e5c8 78 module, XS_VERSION, \
79 vn ? "$" : "", vn ? module : "", vn ? "::" : "", \
6b88bc9c 80 vn ? vn : "bootstrap parameter", tmpsv); \
80b92232 81 } STMT_END
720fb644 82#else
c6af7a1a 83# define XS_VERSION_BOOTCHECK
720fb644 84#endif
76e3520e 85
51371543 86#if 1 /* for compatibility */
dc9e4912 87# define VTBL_sv &PL_vtbl_sv
88# define VTBL_env &PL_vtbl_env
89# define VTBL_envelem &PL_vtbl_envelem
90# define VTBL_sig &PL_vtbl_sig
91# define VTBL_sigelem &PL_vtbl_sigelem
92# define VTBL_pack &PL_vtbl_pack
93# define VTBL_packelem &PL_vtbl_packelem
94# define VTBL_dbline &PL_vtbl_dbline
95# define VTBL_isa &PL_vtbl_isa
96# define VTBL_isaelem &PL_vtbl_isaelem
97# define VTBL_arylen &PL_vtbl_arylen
98# define VTBL_glob &PL_vtbl_glob
99# define VTBL_mglob &PL_vtbl_mglob
100# define VTBL_nkeys &PL_vtbl_nkeys
101# define VTBL_taint &PL_vtbl_taint
102# define VTBL_substr &PL_vtbl_substr
103# define VTBL_vec &PL_vtbl_vec
104# define VTBL_pos &PL_vtbl_pos
105# define VTBL_bm &PL_vtbl_bm
106# define VTBL_fm &PL_vtbl_fm
107# define VTBL_uvar &PL_vtbl_uvar
108# define VTBL_defelem &PL_vtbl_defelem
109# define VTBL_regexp &PL_vtbl_regexp
110# define VTBL_regdata &PL_vtbl_regdata
111# define VTBL_regdatum &PL_vtbl_regdatum
112# ifdef USE_LOCALE_COLLATE
113# define VTBL_collxfrm &PL_vtbl_collxfrm
114# endif
9e7bc3e8 115# define VTBL_amagic &PL_vtbl_amagic
116# define VTBL_amagicelem &PL_vtbl_amagicelem
dc9e4912 117#endif
118
c5be433b 119#if defined(PERL_OBJECT) || defined(PERL_CAPI)
51371543 120# include "perlapi.h"
c6af7a1a 121# include "objXSUB.h"
c5be433b 122#endif /* PERL_OBJECT || PERL_CAPI */
c6af7a1a 123
e8ee3774 124#if defined(PERL_IMPLICIT_CONTEXT) && !defined(PERL_NO_GET_CONTEXT) && !defined(PERL_CORE)
c5be433b 125# undef aTHX
126# undef aTHX_
54aff467 127# define aTHX PERL_GET_THX
128# define aTHX_ aTHX,
54aff467 129#endif
130
131#if defined(PERL_CAPI)
c6af7a1a 132# ifndef NO_XSLOCKS
133# undef closedir
134# undef opendir
135# undef stdin
136# undef stdout
137# undef stderr
138# undef feof
139# undef ferror
140# undef fgetpos
141# undef ioctl
142# undef getlogin
143# undef setjmp
144# undef getc
145# undef ungetc
146# undef fileno
147
148# define mkdir PerlDir_mkdir
149# define chdir PerlDir_chdir
150# define rmdir PerlDir_rmdir
151# define closedir PerlDir_close
152# define opendir PerlDir_open
153# define readdir PerlDir_read
154# define rewinddir PerlDir_rewind
155# define seekdir PerlDir_seek
156# define telldir PerlDir_tell
157# define putenv PerlEnv_putenv
158# define getenv PerlEnv_getenv
b2af26b1 159# define uname PerlEnv_uname
c6af7a1a 160# define stdin PerlIO_stdin()
161# define stdout PerlIO_stdout()
162# define stderr PerlIO_stderr()
163# define fopen PerlIO_open
164# define fclose PerlIO_close
165# define feof PerlIO_eof
166# define ferror PerlIO_error
167# define fclearerr PerlIO_clearerr
168# define getc PerlIO_getc
169# define fputc(c, f) PerlIO_putc(f,c)
170# define fputs(s, f) PerlIO_puts(f,s)
171# define fflush PerlIO_flush
172# define ungetc(c, f) PerlIO_ungetc((f),(c))
173# define fileno PerlIO_fileno
174# define fdopen PerlIO_fdopen
175# define freopen PerlIO_reopen
176# define fread(b,s,c,f) PerlIO_read((f),(b),(s*c))
177# define fwrite(b,s,c,f) PerlIO_write((f),(b),(s*c))
178# define setbuf PerlIO_setbuf
179# define setvbuf PerlIO_setvbuf
180# define setlinebuf PerlIO_setlinebuf
181# define stdoutf PerlIO_stdoutf
182# define vfprintf PerlIO_vprintf
183# define ftell PerlIO_tell
184# define fseek PerlIO_seek
185# define fgetpos PerlIO_getpos
186# define fsetpos PerlIO_setpos
187# define frewind PerlIO_rewind
188# define tmpfile PerlIO_tmpfile
189# define access PerlLIO_access
190# define chmod PerlLIO_chmod
191# define chsize PerlLIO_chsize
192# define close PerlLIO_close
193# define dup PerlLIO_dup
194# define dup2 PerlLIO_dup2
195# define flock PerlLIO_flock
196# define fstat PerlLIO_fstat
197# define ioctl PerlLIO_ioctl
198# define isatty PerlLIO_isatty
199# define lseek PerlLIO_lseek
200# define lstat PerlLIO_lstat
201# define mktemp PerlLIO_mktemp
202# define open PerlLIO_open
203# define read PerlLIO_read
204# define rename PerlLIO_rename
205# define setmode PerlLIO_setmode
4f49e16e 206# define stat(buf,sb) PerlLIO_stat(buf,sb)
c6af7a1a 207# define tmpnam PerlLIO_tmpnam
208# define umask PerlLIO_umask
209# define unlink PerlLIO_unlink
210# define utime PerlLIO_utime
211# define write PerlLIO_write
212# define malloc PerlMem_malloc
213# define realloc PerlMem_realloc
214# define free PerlMem_free
215# define abort PerlProc_abort
216# define exit PerlProc_exit
217# define _exit PerlProc__exit
218# define execl PerlProc_execl
219# define execv PerlProc_execv
220# define execvp PerlProc_execvp
221# define getuid PerlProc_getuid
222# define geteuid PerlProc_geteuid
223# define getgid PerlProc_getgid
224# define getegid PerlProc_getegid
225# define getlogin PerlProc_getlogin
226# define kill PerlProc_kill
227# define killpg PerlProc_killpg
228# define pause PerlProc_pause
229# define popen PerlProc_popen
230# define pclose PerlProc_pclose
231# define pipe PerlProc_pipe
232# define setuid PerlProc_setuid
233# define setgid PerlProc_setgid
234# define sleep PerlProc_sleep
235# define times PerlProc_times
236# define wait PerlProc_wait
237# define setjmp PerlProc_setjmp
238# define longjmp PerlProc_longjmp
239# define signal PerlProc_signal
240# define htonl PerlSock_htonl
241# define htons PerlSock_htons
242# define ntohl PerlSock_ntohl
243# define ntohs PerlSock_ntohs
244# define accept PerlSock_accept
245# define bind PerlSock_bind
246# define connect PerlSock_connect
247# define endhostent PerlSock_endhostent
248# define endnetent PerlSock_endnetent
249# define endprotoent PerlSock_endprotoent
250# define endservent PerlSock_endservent
251# define gethostbyaddr PerlSock_gethostbyaddr
252# define gethostbyname PerlSock_gethostbyname
253# define gethostent PerlSock_gethostent
254# define gethostname PerlSock_gethostname
255# define getnetbyaddr PerlSock_getnetbyaddr
256# define getnetbyname PerlSock_getnetbyname
257# define getnetent PerlSock_getnetent
258# define getpeername PerlSock_getpeername
259# define getprotobyname PerlSock_getprotobyname
260# define getprotobynumber PerlSock_getprotobynumber
261# define getprotoent PerlSock_getprotoent
262# define getservbyname PerlSock_getservbyname
263# define getservbyport PerlSock_getservbyport
264# define getservent PerlSock_getservent
265# define getsockname PerlSock_getsockname
266# define getsockopt PerlSock_getsockopt
267# define inet_addr PerlSock_inet_addr
268# define inet_ntoa PerlSock_inet_ntoa
269# define listen PerlSock_listen
270# define recv PerlSock_recv
271# define recvfrom PerlSock_recvfrom
272# define select PerlSock_select
273# define send PerlSock_send
274# define sendto PerlSock_sendto
275# define sethostent PerlSock_sethostent
276# define setnetent PerlSock_setnetent
277# define setprotoent PerlSock_setprotoent
278# define setservent PerlSock_setservent
279# define setsockopt PerlSock_setsockopt
280# define shutdown PerlSock_shutdown
281# define socket PerlSock_socket
282# define socketpair PerlSock_socketpair
c6af7a1a 283# endif /* NO_XSLOCKS */
c5be433b 284#endif /* PERL_CAPI */
b4ba0ab9 285
cfeeb022 286#endif /* _INC_PERL_XSUB_H */ /* include guard */