Commit | Line | Data |
---|---|---|
a0d0e21e | 1 | /* perl.h |
a687059c | 2 | * |
1129b882 | 3 | * Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001 |
5cd3f21a | 4 | * 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 by Larry Wall and others |
a687059c | 5 | * |
352d5a3a LW |
6 | * You may distribute under the terms of either the GNU General Public |
7 | * License or the Artistic License, as specified in the README file. | |
8d063cd8 | 8 | * |
8d063cd8 | 9 | */ |
d6376244 | 10 | |
85e6fe83 LW |
11 | #ifndef H_PERL |
12 | #define H_PERL 1 | |
8d063cd8 | 13 | |
760ac839 LW |
14 | #ifdef PERL_FOR_X2P |
15 | /* | |
d460ef45 | 16 | * This file is being used for x2p stuff. |
760ac839 | 17 | * Above symbol is defined via -D in 'x2p/Makefile.SH' |
d460ef45 | 18 | * Decouple x2p stuff from some of perls more extreme eccentricities. |
760ac839 | 19 | */ |
55497cff | 20 | #undef MULTIPLICITY |
760ac839 LW |
21 | #undef USE_STDIO |
22 | #define USE_STDIO | |
23 | #endif /* PERL_FOR_X2P */ | |
24 | ||
d460ef45 | 25 | #ifdef PERL_MICRO |
12ae5dfc JH |
26 | # include "uconfig.h" |
27 | #else | |
611cf957 | 28 | # include "config.h" |
12ae5dfc | 29 | #endif |
0cb96387 | 30 | |
70febf4f CB |
31 | /* this is used for functions which take a depth trailing |
32 | * argument under debugging */ | |
33 | #ifdef DEBUGGING | |
eb6cdcc1 KW |
34 | # define _pDEPTH ,U32 depth |
35 | # define _aDEPTH ,depth | |
70febf4f | 36 | #else |
eb6cdcc1 KW |
37 | # define _pDEPTH |
38 | # define _aDEPTH | |
70febf4f CB |
39 | #endif |
40 | ||
7dc3eb73 | 41 | /* NOTE 1: that with gcc -std=c89 the __STDC_VERSION__ is *not* defined |
9267464d | 42 | * because the __STDC_VERSION__ became a thing only with C90. Therefore, |
7dc3eb73 JH |
43 | * with gcc, HAS_C99 will never become true as long as we use -std=c89. |
44 | ||
45 | * NOTE 2: headers lie. Do not expect that if HAS_C99 gets to be true, | |
46 | * all the C99 features are there and are correct. */ | |
9267464d | 47 | #if (defined(__STDC_VERSION__) && __STDC_VERSION__ >= 199901L) || \ |
996959af | 48 | defined(_STDC_C99) || defined(__c99) |
86a3cabf | 49 | # define HAS_C99 1 |
86a3cabf JH |
50 | #endif |
51 | ||
2c2d71f5 JH |
52 | /* See L<perlguts/"The Perl API"> for detailed notes on |
53 | * PERL_IMPLICIT_CONTEXT and PERL_IMPLICIT_SYS */ | |
54 | ||
7ee02ac1 | 55 | /* XXX NOTE that from here --> to <-- the same logic is |
ac6bedea JH |
56 | * repeated in makedef.pl, so be certain to update |
57 | * both places when editing. */ | |
58 | ||
6f4183fe | 59 | #ifdef USE_ITHREADS |
acfe0abc | 60 | # if !defined(MULTIPLICITY) |
6f4183fe GS |
61 | # define MULTIPLICITY |
62 | # endif | |
63 | #endif | |
64 | ||
97aff369 JH |
65 | #ifdef MULTIPLICITY |
66 | # ifndef PERL_IMPLICIT_CONTEXT | |
67 | # define PERL_IMPLICIT_CONTEXT | |
68 | # endif | |
69 | #endif | |
70 | ||
026fd48b GH |
71 | /* undef WIN32 when building on Cygwin (for libwin32) - gph */ |
72 | #ifdef __CYGWIN__ | |
73 | # undef WIN32 | |
74 | # undef _WIN32 | |
75 | #endif | |
76 | ||
dd134d2c | 77 | /* Use the reentrant APIs like localtime_r and getpwent_r */ |
7ee02ac1 KW |
78 | /* Win32 has naturally threadsafe libraries, no need to use any _r variants. |
79 | * XXX KEEP makedef.pl copy of this code in sync */ | |
14795193 | 80 | #if defined(USE_ITHREADS) && !defined(USE_REENTRANT_API) && !defined(NETWARE) && !defined(WIN32) |
10bc17b6 JH |
81 | # define USE_REENTRANT_API |
82 | #endif | |
83 | ||
ac6bedea JH |
84 | /* <--- here ends the logic shared by perl.h and makedef.pl */ |
85 | ||
ea32afd3 | 86 | /* |
3f620621 | 87 | =for apidoc_section $directives |
ea32afd3 KW |
88 | =for apidoc AmnUu|void|EXTERN_C |
89 | When not compiling using C++, expands to nothing. | |
90 | Otherwise is used in a declaration of a function to indicate the function | |
91 | should have external C linkage. This is required for things to work for just | |
92 | about all functions with external linkage compiled into perl. | |
93 | Often, you can use C<L</START_EXTERN_C>> ... C<L</END_EXTERN_C>> blocks | |
94 | surrounding all your code that you need to have this linkage. | |
95 | ||
96 | Example usage: | |
97 | ||
98 | EXTERN_C int flock(int fd, int op); | |
99 | ||
100 | =for apidoc Amnu||START_EXTERN_C | |
101 | When not compiling using C++, expands to nothing. | |
102 | Otherwise begins a section of code in which every function will effectively | |
103 | have C<L</EXTERN_C>> applied to it, that is to have external C linkage. The | |
104 | section is ended by a C<L</END_EXTERN_C>>. | |
105 | ||
106 | =for apidoc Amnu||END_EXTERN_C | |
107 | When not compiling using C++, expands to nothing. | |
108 | Otherwise ends a section of code already begun by a C<L</START_EXTERN_C>>. | |
109 | ||
110 | =cut | |
111 | */ | |
112 | ||
cf5a8da6 MHM |
113 | #undef START_EXTERN_C |
114 | #undef END_EXTERN_C | |
115 | #undef EXTERN_C | |
116 | #ifdef __cplusplus | |
cf5a8da6 | 117 | # define EXTERN_C extern "C" |
2d69eaf3 KW |
118 | # define START_EXTERN_C EXTERN_C { |
119 | # define END_EXTERN_C } | |
cf5a8da6 MHM |
120 | #else |
121 | # define START_EXTERN_C | |
122 | # define END_EXTERN_C | |
123 | # define EXTERN_C extern | |
124 | #endif | |
125 | ||
17a6c8e3 AD |
126 | /* Fallback definitions in case we don't have definitions from config.h. |
127 | This should only matter for systems that don't use Configure and | |
128 | haven't been modified to define PERL_STATIC_INLINE yet. | |
129 | */ | |
130 | #if !defined(PERL_STATIC_INLINE) | |
131 | # ifdef HAS_STATIC_INLINE | |
132 | # define PERL_STATIC_INLINE static inline | |
133 | # else | |
134 | # define PERL_STATIC_INLINE static | |
135 | # endif | |
136 | #endif | |
137 | ||
6ad5d069 KW |
138 | /* |
139 | =for apidoc_section $concurrency | |
140 | =for apidoc AmU|void|dTHXa|PerlInterpreter * a | |
141 | On threaded perls, set C<pTHX> to C<a>; on unthreaded perls, do nothing | |
142 | ||
143 | =for apidoc AmU|void|dTHXoa|PerlInterpreter * a | |
144 | Now a synonym for C<L</dTHXa>>. | |
145 | ||
146 | =cut | |
147 | */ | |
148 | ||
c5be433b | 149 | #ifdef PERL_IMPLICIT_CONTEXT |
3db8f154 MB |
150 | # ifndef MULTIPLICITY |
151 | # define MULTIPLICITY | |
c5be433b | 152 | # endif |
e8dda941 | 153 | # define tTHX PerlInterpreter* |
5aaab254 | 154 | # define pTHX tTHX my_perl PERL_UNUSED_DECL |
3db8f154 | 155 | # define aTHX my_perl |
9399a70c | 156 | # define aTHXa(a) aTHX = (tTHX)a |
8c3a0f6c DIM |
157 | # define dTHXa(a) pTHX = (tTHX)a |
158 | # define dTHX pTHX = PERL_GET_THX | |
c5be433b | 159 | # define pTHX_ pTHX, |
c5be433b | 160 | # define aTHX_ aTHX, |
4373e329 | 161 | # define pTHX_1 2 |
894356b3 GS |
162 | # define pTHX_2 3 |
163 | # define pTHX_3 4 | |
164 | # define pTHX_4 5 | |
4373e329 AL |
165 | # define pTHX_5 6 |
166 | # define pTHX_6 7 | |
a3b680e6 AL |
167 | # define pTHX_7 8 |
168 | # define pTHX_8 9 | |
169 | # define pTHX_9 10 | |
a6fc70e5 | 170 | # define pTHX_12 13 |
e8dda941 JD |
171 | # if defined(DEBUGGING) && !defined(PERL_TRACK_MEMPOOL) |
172 | # define PERL_TRACK_MEMPOOL | |
173 | # endif | |
174 | #else | |
175 | # undef PERL_TRACK_MEMPOOL | |
c5be433b GS |
176 | #endif |
177 | ||
2d17fb74 KW |
178 | #ifdef DEBUGGING |
179 | # define dTHX_DEBUGGING dTHX | |
180 | #else | |
181 | # define dTHX_DEBUGGING dNOOP | |
182 | #endif | |
183 | ||
76e3520e | 184 | #define STATIC static |
16c91539 BM |
185 | |
186 | #ifndef PERL_CORE | |
187 | /* Do not use these macros. They were part of PERL_OBJECT, which was an | |
188 | * implementation of multiplicity using C++ objects. They have been left | |
189 | * here solely for the sake of XS code which has incorrectly | |
190 | * cargo-culted them. | |
9386405b KW |
191 | * |
192 | * The only one Devel::PPPort handles is this; list it as deprecated | |
193 | ||
3f620621 | 194 | =for apidoc_section $concurrency |
9386405b KW |
195 | =for apidoc AmD|void|CPERLscope|void x |
196 | Now a no-op. | |
197 | ||
198 | =cut | |
16c91539 | 199 | */ |
eb6cdcc1 KW |
200 | # define CPERLscope(x) x |
201 | # define CPERLarg void | |
202 | # define CPERLarg_ | |
203 | # define _CPERLarg | |
204 | # define PERL_OBJECT_THIS | |
205 | # define _PERL_OBJECT_THIS | |
206 | # define PERL_OBJECT_THIS_ | |
207 | # define CALL_FPTR(fptr) (*fptr) | |
208 | # define MEMBER_TO_FPTR(name) name | |
16c91539 | 209 | #endif /* !PERL_CORE */ |
76e3520e | 210 | |
16c91539 | 211 | #define CALLRUNOPS PL_runops |
f9f4320a | 212 | |
3ab4a224 | 213 | #define CALLREGCOMP(sv, flags) Perl_pregcomp(aTHX_ (sv),(flags)) |
f9f4320a | 214 | |
16c91539 | 215 | #define CALLREGCOMP_ENG(prog, sv, flags) (prog)->comp(aTHX_ sv, flags) |
a340edde | 216 | #define CALLREGEXEC(prog,stringarg,strend,strbeg,minend,sv,data,flags) \ |
16c91539 | 217 | RX_ENGINE(prog)->exec(aTHX_ (prog),(stringarg),(strend), \ |
a340edde | 218 | (strbeg),(minend),(sv),(data),(flags)) |
52a21eb3 DM |
219 | #define CALLREG_INTUIT_START(prog,sv,strbeg,strpos,strend,flags,data) \ |
220 | RX_ENGINE(prog)->intuit(aTHX_ (prog), (sv), (strbeg), (strpos), \ | |
f9f4320a YO |
221 | (strend),(flags),(data)) |
222 | #define CALLREG_INTUIT_STRING(prog) \ | |
16c91539 | 223 | RX_ENGINE(prog)->checkstr(aTHX_ (prog)) |
f8149455 | 224 | |
f8149455 YO |
225 | #define CALLREGFREE(prog) \ |
226 | Perl_pregfree(aTHX_ (prog)) | |
227 | ||
228 | #define CALLREGFREE_PVT(prog) \ | |
4c8117d3 | 229 | if(prog && RX_ENGINE(prog)) RX_ENGINE(prog)->rxfree(aTHX_ (prog)) |
f8149455 | 230 | |
2fdbfb4d | 231 | #define CALLREG_NUMBUF_FETCH(rx,paren,usesv) \ |
16c91539 | 232 | RX_ENGINE(rx)->numbered_buff_FETCH(aTHX_ (rx),(paren),(usesv)) |
93b32b6d | 233 | |
2fdbfb4d | 234 | #define CALLREG_NUMBUF_STORE(rx,paren,value) \ |
16c91539 | 235 | RX_ENGINE(rx)->numbered_buff_STORE(aTHX_ (rx),(paren),(value)) |
2fdbfb4d AB |
236 | |
237 | #define CALLREG_NUMBUF_LENGTH(rx,sv,paren) \ | |
16c91539 | 238 | RX_ENGINE(rx)->numbered_buff_LENGTH(aTHX_ (rx),(sv),(paren)) |
2fdbfb4d | 239 | |
192b9cd1 | 240 | #define CALLREG_NAMED_BUFF_FETCH(rx, key, flags) \ |
16c91539 | 241 | RX_ENGINE(rx)->named_buff(aTHX_ (rx), (key), NULL, ((flags) | RXapif_FETCH)) |
192b9cd1 AB |
242 | |
243 | #define CALLREG_NAMED_BUFF_STORE(rx, key, value, flags) \ | |
16c91539 | 244 | RX_ENGINE(rx)->named_buff(aTHX_ (rx), (key), (value), ((flags) | RXapif_STORE)) |
192b9cd1 AB |
245 | |
246 | #define CALLREG_NAMED_BUFF_DELETE(rx, key, flags) \ | |
16c91539 | 247 | RX_ENGINE(rx)->named_buff(aTHX_ (rx),(key), NULL, ((flags) | RXapif_DELETE)) |
192b9cd1 AB |
248 | |
249 | #define CALLREG_NAMED_BUFF_CLEAR(rx, flags) \ | |
16c91539 | 250 | RX_ENGINE(rx)->named_buff(aTHX_ (rx), NULL, NULL, ((flags) | RXapif_CLEAR)) |
192b9cd1 AB |
251 | |
252 | #define CALLREG_NAMED_BUFF_EXISTS(rx, key, flags) \ | |
16c91539 | 253 | RX_ENGINE(rx)->named_buff(aTHX_ (rx), (key), NULL, ((flags) | RXapif_EXISTS)) |
192b9cd1 AB |
254 | |
255 | #define CALLREG_NAMED_BUFF_FIRSTKEY(rx, flags) \ | |
16c91539 | 256 | RX_ENGINE(rx)->named_buff_iter(aTHX_ (rx), NULL, ((flags) | RXapif_FIRSTKEY)) |
192b9cd1 AB |
257 | |
258 | #define CALLREG_NAMED_BUFF_NEXTKEY(rx, lastkey, flags) \ | |
16c91539 | 259 | RX_ENGINE(rx)->named_buff_iter(aTHX_ (rx), (lastkey), ((flags) | RXapif_NEXTKEY)) |
192b9cd1 AB |
260 | |
261 | #define CALLREG_NAMED_BUFF_SCALAR(rx, flags) \ | |
16c91539 | 262 | RX_ENGINE(rx)->named_buff(aTHX_ (rx), NULL, NULL, ((flags) | RXapif_SCALAR)) |
192b9cd1 AB |
263 | |
264 | #define CALLREG_NAMED_BUFF_COUNT(rx) \ | |
16c91539 | 265 | RX_ENGINE(rx)->named_buff(aTHX_ (rx), NULL, NULL, RXapif_REGNAMES_COUNT) |
192b9cd1 AB |
266 | |
267 | #define CALLREG_NAMED_BUFF_ALL(rx, flags) \ | |
16c91539 | 268 | RX_ENGINE(rx)->named_buff(aTHX_ (rx), NULL, NULL, flags) |
93b32b6d | 269 | |
49d7dfbc | 270 | #define CALLREG_PACKAGE(rx) \ |
16c91539 | 271 | RX_ENGINE(rx)->qr_package(aTHX_ (rx)) |
93b32b6d | 272 | |
00f254e2 | 273 | #if defined(USE_ITHREADS) |
eb6cdcc1 | 274 | # define CALLREGDUPE(prog,param) \ |
f8149455 YO |
275 | Perl_re_dup(aTHX_ (prog),(param)) |
276 | ||
eb6cdcc1 | 277 | # define CALLREGDUPE_PVT(prog,param) \ |
16c91539 | 278 | (prog ? RX_ENGINE(prog)->dupe(aTHX_ (prog),(param)) \ |
00f254e2 | 279 | : (REGEXP *)NULL) |
f9f4320a | 280 | #endif |
14dd3ad8 | 281 | |
bfde97e0 TK |
282 | /* some compilers impersonate gcc */ |
283 | #if defined(__GNUC__) && !defined(__clang__) && !defined(__INTEL_COMPILER) | |
284 | # define PERL_IS_GCC 1 | |
285 | #endif | |
286 | ||
09f0a348 TK |
287 | /* In case Configure was not used (we are using a "canned config" |
288 | * such as Win32, or a cross-compilation setup, for example) try going | |
289 | * by the gcc major and minor versions. One useful URL is | |
290 | * http://www.ohse.de/uwe/articles/gcc-attributes.html, | |
291 | * but contrary to this information warn_unused_result seems | |
292 | * not to be in gcc 3.3.5, at least. --jhi | |
293 | * Also, when building extensions with an installed perl, this allows | |
294 | * the user to upgrade gcc and get the right attributes, rather than | |
295 | * relying on the list generated at Configure time. --AD | |
296 | * Set these up now otherwise we get confused when some of the <*thread.h> | |
297 | * includes below indirectly pull in <perlio.h> (which needs to know if we | |
298 | * have HASATTRIBUTE_FORMAT). | |
299 | */ | |
300 | ||
301 | #ifndef PERL_MICRO | |
eb6cdcc1 KW |
302 | # if defined __GNUC__ && !defined(__INTEL_COMPILER) |
303 | # if __GNUC__ == 3 && __GNUC_MINOR__ >= 1 || __GNUC__ > 3 /* 3.1 -> */ | |
304 | # define HASATTRIBUTE_DEPRECATED | |
305 | # endif | |
306 | # if __GNUC__ >= 3 /* 3.0 -> */ /* XXX Verify this version */ | |
307 | # define HASATTRIBUTE_FORMAT | |
308 | # if defined __MINGW32__ | |
309 | # define PRINTF_FORMAT_NULL_OK | |
310 | # endif | |
311 | # endif | |
312 | # if __GNUC__ >= 3 /* 3.0 -> */ | |
313 | # define HASATTRIBUTE_MALLOC | |
314 | # endif | |
315 | # if __GNUC__ == 3 && __GNUC_MINOR__ >= 3 || __GNUC__ > 3 /* 3.3 -> */ | |
316 | # define HASATTRIBUTE_NONNULL | |
317 | # endif | |
318 | # if __GNUC__ == 2 && __GNUC_MINOR__ >= 5 || __GNUC__ > 2 /* 2.5 -> */ | |
319 | # define HASATTRIBUTE_NORETURN | |
320 | # endif | |
321 | # if __GNUC__ >= 3 /* gcc 3.0 -> */ | |
322 | # define HASATTRIBUTE_PURE | |
323 | # endif | |
324 | # if __GNUC__ == 3 && __GNUC_MINOR__ >= 4 || __GNUC__ > 3 /* 3.4 -> */ | |
325 | # define HASATTRIBUTE_UNUSED | |
326 | # endif | |
327 | # if __GNUC__ == 3 && __GNUC_MINOR__ == 3 && !defined(__cplusplus) | |
328 | # define HASATTRIBUTE_UNUSED /* gcc-3.3, but not g++-3.3. */ | |
329 | # endif | |
330 | # if __GNUC__ == 3 && __GNUC_MINOR__ >= 4 || __GNUC__ > 3 /* 3.4 -> */ | |
331 | # define HASATTRIBUTE_WARN_UNUSED_RESULT | |
332 | # endif | |
333 | /* always_inline is buggy in gcc <= 4.6 and causes compilation errors */ | |
334 | # if __GNUC__ == 4 && __GNUC_MINOR__ >= 7 || __GNUC__ > 4 /* 4.7 -> */ | |
335 | # define HASATTRIBUTE_ALWAYS_INLINE | |
09f0a348 TK |
336 | # endif |
337 | # endif | |
09f0a348 | 338 | #endif /* #ifndef PERL_MICRO */ |
a20207d7 | 339 | |
09f0a348 TK |
340 | #ifdef HASATTRIBUTE_DEPRECATED |
341 | # define __attribute__deprecated__ __attribute__((deprecated)) | |
342 | #endif | |
343 | #ifdef HASATTRIBUTE_FORMAT | |
344 | # define __attribute__format__(x,y,z) __attribute__((format(x,y,z))) | |
345 | #endif | |
346 | #ifdef HASATTRIBUTE_MALLOC | |
347 | # define __attribute__malloc__ __attribute__((__malloc__)) | |
348 | #endif | |
349 | #ifdef HASATTRIBUTE_NONNULL | |
350 | # define __attribute__nonnull__(a) __attribute__((nonnull(a))) | |
351 | #endif | |
352 | #ifdef HASATTRIBUTE_NORETURN | |
353 | # define __attribute__noreturn__ __attribute__((noreturn)) | |
354 | #endif | |
355 | #ifdef HASATTRIBUTE_PURE | |
356 | # define __attribute__pure__ __attribute__((pure)) | |
357 | #endif | |
358 | #ifdef HASATTRIBUTE_UNUSED | |
359 | # define __attribute__unused__ __attribute__((unused)) | |
360 | #endif | |
361 | #ifdef HASATTRIBUTE_WARN_UNUSED_RESULT | |
362 | # define __attribute__warn_unused_result__ __attribute__((warn_unused_result)) | |
363 | #endif | |
f1e99d0d | 364 | #ifdef HASATTRIBUTE_ALWAYS_INLINE |
d7113604 | 365 | /* always_inline is buggy in gcc <= 4.6 and causes compilation errors */ |
bfde97e0 | 366 | # if !defined(PERL_IS_GCC) || (__GNUC__ == 4 && __GNUC_MINOR__ >= 7 || __GNUC__ > 4) |
d7113604 TK |
367 | # define __attribute__always_inline__ __attribute__((always_inline)) |
368 | # endif | |
f1e99d0d | 369 | #endif |
bcdf7404 | 370 | |
09f0a348 TK |
371 | /* If we haven't defined the attributes yet, define them to blank. */ |
372 | #ifndef __attribute__deprecated__ | |
373 | # define __attribute__deprecated__ | |
374 | #endif | |
375 | #ifndef __attribute__format__ | |
376 | # define __attribute__format__(x,y,z) | |
377 | #endif | |
378 | #ifndef __attribute__malloc__ | |
379 | # define __attribute__malloc__ | |
380 | #endif | |
381 | #ifndef __attribute__nonnull__ | |
382 | # define __attribute__nonnull__(a) | |
383 | #endif | |
384 | #ifndef __attribute__noreturn__ | |
385 | # define __attribute__noreturn__ | |
386 | #endif | |
387 | #ifndef __attribute__pure__ | |
388 | # define __attribute__pure__ | |
389 | #endif | |
390 | #ifndef __attribute__unused__ | |
391 | # define __attribute__unused__ | |
392 | #endif | |
393 | #ifndef __attribute__warn_unused_result__ | |
394 | # define __attribute__warn_unused_result__ | |
395 | #endif | |
f1e99d0d TK |
396 | #ifndef __attribute__always_inline__ |
397 | # define __attribute__always_inline__ | |
398 | #endif | |
a20207d7 | 399 | |
09f0a348 TK |
400 | /* Some OS warn on NULL format to printf */ |
401 | #ifdef PRINTF_FORMAT_NULL_OK | |
402 | # define __attribute__format__null_ok__(x,y,z) __attribute__format__(x,y,z) | |
403 | #else | |
404 | # define __attribute__format__null_ok__(x,y,z) | |
405 | #endif | |
a20207d7 | 406 | |
5ba4cab2 SH |
407 | /* |
408 | * Because of backward compatibility reasons the PERL_UNUSED_DECL | |
409 | * cannot be changed from postfix to PERL_UNUSED_DECL(x). Sigh. | |
410 | * | |
411 | * Note that there are C compilers such as MetroWerks CodeWarrior | |
1266ad8c | 412 | * which do not have an "inlined" way (like the gcc __attribute__) of |
5ba4cab2 SH |
413 | * marking unused variables (they need e.g. a #pragma) and therefore |
414 | * cpp macros like PERL_UNUSED_DECL cannot work for this purpose, even | |
415 | * if it were PERL_UNUSED_DECL(x), which it cannot be (see above). | |
90921203 | 416 | |
3f620621 | 417 | =for apidoc_section $directives |
90921203 KW |
418 | =for apidoc AmnU||PERL_UNUSED_DECL |
419 | Tells the compiler that the parameter in the function prototype just before it | |
420 | is not necessarily expected to be used in the function. Not that many | |
421 | compilers understand this, so this should only be used in cases where | |
422 | C<L</PERL_UNUSED_ARG>> can't conveniently be used. | |
423 | ||
424 | Example usage: | |
425 | ||
426 | =over | |
427 | ||
428 | Signal_t | |
429 | Perl_perly_sighandler(int sig, Siginfo_t *sip PERL_UNUSED_DECL, | |
430 | void *uap PERL_UNUSED_DECL, bool safe) | |
431 | ||
432 | =back | |
433 | ||
434 | =cut | |
5ba4cab2 | 435 | */ |
1266ad8c | 436 | |
5b2bd0a5 | 437 | #ifndef PERL_UNUSED_DECL |
09f0a348 | 438 | # define PERL_UNUSED_DECL __attribute__unused__ |
5b2bd0a5 | 439 | #endif |
00f254e2 | 440 | |
349b520e DM |
441 | /* gcc -Wall: |
442 | * for silencing unused variables that are actually used most of the time, | |
a730e3f2 JH |
443 | * but we cannot quite get rid of, such as "ax" in PPCODE+noargs xsubs, |
444 | * or variables/arguments that are used only in certain configurations. | |
fd2362a2 | 445 | |
4294a0ed | 446 | =for apidoc Ams||PERL_UNUSED_ARG|void x |
fd2362a2 KW |
447 | This is used to suppress compiler warnings that a parameter to a function is |
448 | not used. This situation can arise, for example, when a parameter is needed | |
449 | under some configuration conditions, but not others, so that C preprocessor | |
450 | conditional compilation causes it be used just some times. | |
451 | ||
4294a0ed | 452 | =for apidoc Amns||PERL_UNUSED_CONTEXT |
fd2362a2 KW |
453 | This is used to suppress compiler warnings that the thread context parameter to |
454 | a function is not used. This situation can arise, for example, when a | |
455 | C preprocessor conditional compilation causes it be used just some times. | |
456 | ||
4294a0ed | 457 | =for apidoc Ams||PERL_UNUSED_VAR|void x |
fd2362a2 KW |
458 | This is used to suppress compiler warnings that the variable I<x> is not used. |
459 | This situation can arise, for example, when a C preprocessor conditional | |
460 | compilation causes it be used just some times. | |
461 | ||
462 | =cut | |
349b520e | 463 | */ |
53c1dcc0 | 464 | #ifndef PERL_UNUSED_ARG |
c707756e | 465 | # define PERL_UNUSED_ARG(x) ((void)sizeof(x)) |
ad73156c | 466 | #endif |
53c1dcc0 | 467 | #ifndef PERL_UNUSED_VAR |
a730e3f2 | 468 | # define PERL_UNUSED_VAR(x) ((void)sizeof(x)) |
53c1dcc0 | 469 | #endif |
ad73156c | 470 | |
8c3a0f6c | 471 | #if defined(USE_ITHREADS) |
96a5add6 AL |
472 | # define PERL_UNUSED_CONTEXT PERL_UNUSED_ARG(my_perl) |
473 | #else | |
474 | # define PERL_UNUSED_CONTEXT | |
475 | #endif | |
476 | ||
24e7ff4e JH |
477 | /* gcc (-ansi) -pedantic doesn't allow gcc statement expressions, |
478 | * g++ allows them but seems to have problems with them | |
479 | * (insane errors ensue). | |
480 | * g++ does not give insane errors now (RMB 2008-01-30, gcc 4.2.2). | |
481 | */ | |
482 | #if defined(PERL_GCC_PEDANTIC) || \ | |
483 | (defined(__GNUC__) && defined(__cplusplus) && \ | |
484 | ((__GNUC__ < 4) || ((__GNUC__ == 4) && (__GNUC_MINOR__ < 2)))) | |
485 | # ifndef PERL_GCC_BRACE_GROUPS_FORBIDDEN | |
486 | # define PERL_GCC_BRACE_GROUPS_FORBIDDEN | |
487 | # endif | |
488 | #endif | |
489 | ||
fd2362a2 KW |
490 | /* |
491 | ||
492 | =for apidoc Am||PERL_UNUSED_RESULT|void x | |
493 | ||
494 | This macro indicates to discard the return value of the function call inside | |
00b72c9f | 495 | it, I<e.g.>, |
fd2362a2 KW |
496 | |
497 | PERL_UNUSED_RESULT(foo(a, b)) | |
498 | ||
00b72c9f KW |
499 | The main reason for this is that the combination of C<gcc -Wunused-result> |
500 | (part of C<-Wall>) and the C<__attribute__((warn_unused_result))> cannot | |
501 | be silenced with casting to C<void>. This causes trouble when the system | |
fd2362a2 KW |
502 | header files use the attribute. |
503 | ||
504 | Use C<PERL_UNUSED_RESULT> sparingly, though, since usually the warning | |
505 | is there for a good reason: you might lose success/failure information, | |
506 | or leak resources, or changes in resources. | |
507 | ||
00b72c9f | 508 | But sometimes you just want to ignore the return value, I<e.g.>, on |
fd2362a2 KW |
509 | codepaths soon ending up in abort, or in "best effort" attempts, |
510 | or in situations where there is no good way to handle failures. | |
511 | ||
512 | Sometimes C<PERL_UNUSED_RESULT> might not be the most natural way: | |
513 | another possibility is that you can capture the return value | |
514 | and use C<L</PERL_UNUSED_VAR>> on that. | |
515 | ||
516 | =cut | |
517 | ||
518 | The __typeof__() is used instead of typeof() since typeof() is not | |
519 | available under strict C89, and because of compilers masquerading | |
520 | as gcc (clang and icc), we want exactly the gcc extension | |
521 | __typeof__ and nothing else. | |
522 | ||
523 | */ | |
ffea512f | 524 | #ifndef PERL_UNUSED_RESULT |
b469f1e0 JH |
525 | # if defined(__GNUC__) && defined(HASATTRIBUTE_WARN_UNUSED_RESULT) |
526 | # define PERL_UNUSED_RESULT(v) STMT_START { __typeof__(v) z = (v); (void)sizeof(z); } STMT_END | |
ffea512f JH |
527 | # else |
528 | # define PERL_UNUSED_RESULT(v) ((void)(v)) | |
529 | # endif | |
530 | #endif | |
531 | ||
bc113a9f | 532 | #if defined(_MSC_VER) && _MSC_VER < 1400 |
e7ae132e | 533 | /* XXX older MSVC versions have a smallish macro buffer */ |
eb6cdcc1 | 534 | # define PERL_SMALL_MACRO_BUFFER |
e7ae132e KW |
535 | #endif |
536 | ||
b56aac20 DM |
537 | /* on gcc (and clang), specify that a warning should be temporarily |
538 | * ignored; e.g. | |
539 | * | |
7347ee54 | 540 | * GCC_DIAG_IGNORE_DECL(-Wmultichar); |
b56aac20 | 541 | * char b = 'ab'; |
7347ee54 | 542 | * GCC_DIAG_RESTORE_DECL; |
b56aac20 DM |
543 | * |
544 | * based on http://dbp-consulting.com/tutorials/SuppressingGCCWarnings.html | |
545 | * | |
546 | * Note that "pragma GCC diagnostic push/pop" was added in GCC 4.6, Mar 2011; | |
547 | * clang only pretends to be GCC 4.2, but still supports push/pop. | |
c1d6452f | 548 | * |
7347ee54 Z |
549 | * Note on usage: all macros must be used at a place where a declaration |
550 | * or statement can occur, i.e., not in the middle of an expression. | |
551 | * *_DIAG_IGNORE() and *_DIAG_RESTORE can be used in any such place, but | |
552 | * must be used without a following semicolon. *_DIAG_IGNORE_DECL() and | |
553 | * *_DIAG_RESTORE_DECL must be used with a following semicolon, and behave | |
554 | * syntactically as declarations (like dNOOP). *_DIAG_IGNORE_STMT() | |
555 | * and *_DIAG_RESTORE_STMT must be used with a following semicolon, | |
556 | * and behave syntactically as statements (like NOOP). | |
c1d6452f | 557 | * |
b56aac20 DM |
558 | */ |
559 | ||
57d4b8c5 | 560 | #if defined(__clang__) || defined(__clang) || \ |
d28ce8b4 | 561 | (defined( __GNUC__) && ((__GNUC__ * 100) + __GNUC_MINOR__) >= 406) |
c1d6452f JH |
562 | # define GCC_DIAG_PRAGMA(x) _Pragma (#x) |
563 | /* clang has "clang diagnostic" pragmas, but also understands gcc. */ | |
b56aac20 | 564 | # define GCC_DIAG_IGNORE(x) _Pragma("GCC diagnostic push") \ |
c1d6452f | 565 | GCC_DIAG_PRAGMA(GCC diagnostic ignored #x) |
b56aac20 DM |
566 | # define GCC_DIAG_RESTORE _Pragma("GCC diagnostic pop") |
567 | #else | |
8ce6f80a JH |
568 | # define GCC_DIAG_IGNORE(w) |
569 | # define GCC_DIAG_RESTORE | |
b56aac20 | 570 | #endif |
7347ee54 Z |
571 | #define GCC_DIAG_IGNORE_DECL(x) GCC_DIAG_IGNORE(x) dNOOP |
572 | #define GCC_DIAG_RESTORE_DECL GCC_DIAG_RESTORE dNOOP | |
573 | #define GCC_DIAG_IGNORE_STMT(x) GCC_DIAG_IGNORE(x) NOOP | |
574 | #define GCC_DIAG_RESTORE_STMT GCC_DIAG_RESTORE NOOP | |
337458b1 JH |
575 | /* for clang specific pragmas */ |
576 | #if defined(__clang__) || defined(__clang) | |
577 | # define CLANG_DIAG_PRAGMA(x) _Pragma (#x) | |
578 | # define CLANG_DIAG_IGNORE(x) _Pragma("clang diagnostic push") \ | |
579 | CLANG_DIAG_PRAGMA(clang diagnostic ignored #x) | |
580 | # define CLANG_DIAG_RESTORE _Pragma("clang diagnostic pop") | |
581 | #else | |
582 | # define CLANG_DIAG_IGNORE(w) | |
583 | # define CLANG_DIAG_RESTORE | |
584 | #endif | |
7347ee54 Z |
585 | #define CLANG_DIAG_IGNORE_DECL(x) CLANG_DIAG_IGNORE(x) dNOOP |
586 | #define CLANG_DIAG_RESTORE_DECL CLANG_DIAG_RESTORE dNOOP | |
587 | #define CLANG_DIAG_IGNORE_STMT(x) CLANG_DIAG_IGNORE(x) NOOP | |
588 | #define CLANG_DIAG_RESTORE_STMT CLANG_DIAG_RESTORE NOOP | |
b56aac20 | 589 | |
6879a07b TK |
590 | #if defined(_MSC_VER) && (_MSC_VER >= 1300) |
591 | # define MSVC_DIAG_IGNORE(x) __pragma(warning(push)) \ | |
592 | __pragma(warning(disable : x)) | |
593 | # define MSVC_DIAG_RESTORE __pragma(warning(pop)) | |
594 | #else | |
595 | # define MSVC_DIAG_IGNORE(x) | |
596 | # define MSVC_DIAG_RESTORE | |
597 | #endif | |
598 | #define MSVC_DIAG_IGNORE_DECL(x) MSVC_DIAG_IGNORE(x) dNOOP | |
599 | #define MSVC_DIAG_RESTORE_DECL MSVC_DIAG_RESTORE dNOOP | |
600 | #define MSVC_DIAG_IGNORE_STMT(x) MSVC_DIAG_IGNORE(x) NOOP | |
601 | #define MSVC_DIAG_RESTORE_STMT MSVC_DIAG_RESTORE NOOP | |
602 | ||
dc6dad9d KW |
603 | /* |
604 | =for apidoc Amns||NOOP | |
605 | Do nothing; typically used as a placeholder to replace something that used to | |
606 | do something. | |
607 | ||
608 | =for apidoc Amns||dNOOP | |
609 | Declare nothing; typically used as a placeholder to replace something that used | |
610 | to declare something. Works on compilers that require declarations before any | |
611 | code. | |
612 | ||
613 | =cut | |
614 | */ | |
6f207bd3 | 615 | #define NOOP /*EMPTY*/(void)0 |
91ca80c3 | 616 | #define dNOOP struct Perl___notused_struct |
71be2cbc | 617 | |
0cb96387 | 618 | #ifndef pTHX |
a78adc84 | 619 | /* Don't bother defining tTHX ; using it outside |
e8dda941 JD |
620 | * code guarded by PERL_IMPLICIT_CONTEXT is an error. |
621 | */ | |
0cb96387 GS |
622 | # define pTHX void |
623 | # define pTHX_ | |
0cb96387 GS |
624 | # define aTHX |
625 | # define aTHX_ | |
9399a70c | 626 | # define aTHXa(a) NOOP |
0cb96387 GS |
627 | # define dTHXa(a) dNOOP |
628 | # define dTHX dNOOP | |
894356b3 GS |
629 | # define pTHX_1 1 |
630 | # define pTHX_2 2 | |
631 | # define pTHX_3 3 | |
632 | # define pTHX_4 4 | |
3d42dc86 RGS |
633 | # define pTHX_5 5 |
634 | # define pTHX_6 6 | |
a3b680e6 AL |
635 | # define pTHX_7 7 |
636 | # define pTHX_8 8 | |
637 | # define pTHX_9 9 | |
a6fc70e5 | 638 | # define pTHX_12 12 |
0cb96387 GS |
639 | #endif |
640 | ||
dc6dad9d | 641 | /* |
3f620621 | 642 | =for apidoc_section $concurrency |
dc6dad9d KW |
643 | =for apidoc AmnU||dVAR |
644 | This is now a synonym for dNOOP: declare nothing | |
645 | ||
269cb1d3 KW |
646 | =for apidoc_section $XS |
647 | =for apidoc Amns||dMY_CXT_SV | |
648 | Now a placeholder that declares nothing | |
649 | ||
dc6dad9d KW |
650 | =cut |
651 | */ | |
652 | ||
c91f661c | 653 | #ifndef PERL_CORE |
dc6dad9d KW |
654 | /* Backwards compatibility macro for XS code. It used to be part of the |
655 | * PERL_GLOBAL_STRUCT(_PRIVATE) feature, which no longer exists */ | |
27da23d5 | 656 | # define dVAR dNOOP |
27da23d5 | 657 | |
dc6dad9d KW |
658 | /* these are only defined for compatibility; should not be used internally. |
659 | * */ | |
269cb1d3 | 660 | # define dMY_CXT_SV dNOOP |
dc6dad9d KW |
661 | # ifndef pTHXo |
662 | # define pTHXo pTHX | |
663 | # define pTHXo_ pTHX_ | |
664 | # define aTHXo aTHX | |
665 | # define aTHXo_ aTHX_ | |
666 | # define dTHXo dTHX | |
667 | # define dTHXoa(x) dTHXa(x) | |
668 | # endif | |
0cb96387 GS |
669 | #endif |
670 | ||
671 | #ifndef pTHXx | |
5aaab254 | 672 | # define pTHXx PerlInterpreter *my_perl |
0cb96387 | 673 | # define pTHXx_ pTHXx, |
0cb96387 GS |
674 | # define aTHXx my_perl |
675 | # define aTHXx_ aTHXx, | |
c5be433b | 676 | # define dTHXx dTHX |
22c35a8c | 677 | #endif |
71be2cbc | 678 | |
1de7c2ac GS |
679 | /* Under PERL_IMPLICIT_SYS (used in Windows for fork emulation) |
680 | * PerlIO_foo() expands to PL_StdIO->pFOO(PL_StdIO, ...). | |
681 | * dTHXs is therefore needed for all functions using PerlIO_foo(). */ | |
682 | #ifdef PERL_IMPLICIT_SYS | |
27da23d5 | 683 | # define dTHXs dTHX |
1de7c2ac | 684 | #else |
27da23d5 | 685 | # define dTHXs dNOOP |
1de7c2ac GS |
686 | #endif |
687 | ||
5b692037 JH |
688 | #if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) && !defined(__cplusplus) |
689 | # ifndef PERL_USE_GCC_BRACE_GROUPS | |
690 | # define PERL_USE_GCC_BRACE_GROUPS | |
691 | # endif | |
692 | #endif | |
693 | ||
728e2803 | 694 | /* |
3f620621 | 695 | =for apidoc_section $directives |
16a2918c | 696 | =for apidoc AmnUu|void|STMT_START |
6b30a08c | 697 | =for apidoc_item ||STMT_END |
16a2918c | 698 | |
6b30a08c KW |
699 | This allows a series of statements in a macro to be used as a single statement, |
700 | as in | |
16a2918c | 701 | |
6b30a08c | 702 | if (x) STMT_START { ... } STMT_END else ... |
16a2918c | 703 | |
6b30a08c KW |
704 | Note that you can't return a value out of them, which limits their utility. |
705 | But see C<L</PERL_USE_GCC_BRACE_GROUPS>>. | |
16a2918c | 706 | |
2ed33a45 KW |
707 | =for apidoc AmnuU|bool|PERL_USE_GCC_BRACE_GROUPS |
708 | ||
709 | This C pre-processor value, if defined, indicates that it is permissible to use | |
6b30a08c KW |
710 | the GCC brace groups extension. This extension, of the form |
711 | ||
712 | ({ statement ... }) | |
713 | ||
714 | turns the block consisting of I<statements ...> into an expression with a | |
715 | value, unlike plain C language blocks. This can present optimization | |
716 | possibilities, B<BUT> you generally need to specify an alternative in case this | |
717 | ability doesn't exist or has otherwise been forbidden. | |
718 | ||
719 | Example usage: | |
720 | ||
721 | =over | |
722 | ||
723 | #ifdef PERL_USE_GCC_BRACE_GROUPS | |
724 | ... | |
725 | #else | |
726 | ... | |
727 | #endif | |
728 | ||
729 | =back | |
2ed33a45 | 730 | |
16a2918c KW |
731 | =cut |
732 | ||
733 | Trying to select a version that gives no warnings... | |
734 | */ | |
728e2803 | 735 | #if !(defined(STMT_START) && defined(STMT_END)) |
5b692037 | 736 | # ifdef PERL_USE_GCC_BRACE_GROUPS |
a0288114 | 737 | # define STMT_START (void)( /* gcc supports "({ STATEMENTS; })" */ |
728e2803 PP |
738 | # define STMT_END ) |
739 | # else | |
728e2803 PP |
740 | # define STMT_START do |
741 | # define STMT_END while (0) | |
728e2803 PP |
742 | # endif |
743 | #endif | |
744 | ||
d6f9c181 JH |
745 | #ifndef BYTEORDER /* Should never happen -- byteorder is in config.h */ |
746 | # define BYTEORDER 0x1234 | |
79072805 LW |
747 | #endif |
748 | ||
8ada0baa JH |
749 | #if 'A' == 65 && 'I' == 73 && 'J' == 74 && 'Z' == 90 |
750 | #define ASCIIish | |
751 | #else | |
752 | #undef ASCIIish | |
753 | #endif | |
754 | ||
79072805 LW |
755 | /* |
756 | * The following contortions are brought to you on behalf of all the | |
757 | * standards, semi-standards, de facto standards, not-so-de-facto standards | |
758 | * of the world, as well as all the other botches anyone ever thought of. | |
759 | * The basic theory is that if we work hard enough here, the rest of the | |
760 | * code can be a lot prettier. Well, so much for theory. Sorry, Henry... | |
761 | */ | |
ac58e20f | 762 | |
ee0007ab | 763 | /* define this once if either system, instead of cluttering up the src */ |
7c458fae | 764 | #if defined(MSDOS) || defined(WIN32) || defined(NETWARE) |
ee0007ab LW |
765 | #define DOSISH 1 |
766 | #endif | |
767 | ||
3d97541c | 768 | /* These exist only for back-compat with XS modules. */ |
8162b70e | 769 | #ifndef PERL_CORE |
516e10a9 | 770 | #define VOL volatile |
3d97541c | 771 | #define CAN_PROTOTYPE |
ae75e3d0 | 772 | #define _(args) args |
6c2ae642 | 773 | #define I_LIMITS |
36a113ce | 774 | #define I_STDARG |
6c2ae642 | 775 | #define STANDARD_C |
8162b70e | 776 | #endif |
663a0e37 | 777 | |
284167a5 SM |
778 | /* By compiling a perl with -DNO_TAINT_SUPPORT or -DSILENT_NO_TAINT_SUPPORT, |
779 | * you get a perl without taint support, but doubtlessly with a lesser | |
780 | * degree of support. Do not do so unless you know exactly what it means | |
781 | * technically, have a good reason to do so, and know exactly how the | |
782 | * perl will be used. perls with -DSILENT_NO_TAINT_SUPPORT are considered | |
783 | * a potential security risk due to flat out ignoring the security-relevant | |
784 | * taint flags. This being said, a perl without taint support compiled in | |
785 | * has marginal run-time performance benefits. | |
786 | * SILENT_NO_TAINT_SUPPORT implies NO_TAINT_SUPPORT. | |
787 | * SILENT_NO_TAINT_SUPPORT is the same as NO_TAINT_SUPPORT except it | |
788 | * silently ignores -t/-T instead of throwing an exception. | |
053a3618 SM |
789 | * |
790 | * DANGER! Using NO_TAINT_SUPPORT or SILENT_NO_TAINT_SUPPORT | |
6ecb40c7 | 791 | * voids your nonexistent warranty! |
284167a5 | 792 | */ |
dc6d7f5c | 793 | #if defined(SILENT_NO_TAINT_SUPPORT) && !defined(NO_TAINT_SUPPORT) |
284167a5 SM |
794 | # define NO_TAINT_SUPPORT 1 |
795 | #endif | |
796 | ||
797 | /* NO_TAINT_SUPPORT can be set to transform virtually all taint-related | |
798 | * operations into no-ops for a very modest speed-up. Enable only if you | |
799 | * know what you're doing: tests and CPAN modules' tests are bound to fail. | |
800 | */ | |
dc6d7f5c | 801 | #ifdef NO_TAINT_SUPPORT |
284167a5 SM |
802 | # define TAINT NOOP |
803 | # define TAINT_NOT NOOP | |
804 | # define TAINT_IF(c) NOOP | |
805 | # define TAINT_ENV() NOOP | |
806 | # define TAINT_PROPER(s) NOOP | |
807 | # define TAINT_set(s) NOOP | |
808 | # define TAINT_get 0 | |
809 | # define TAINTING_get 0 | |
810 | # define TAINTING_set(s) NOOP | |
811 | # define TAINT_WARN_get 0 | |
812 | # define TAINT_WARN_set(s) NOOP | |
813 | #else | |
bc2f1ca1 | 814 | /* Set to tainted if we are running under tainting mode */ |
d48c660d | 815 | # define TAINT (PL_tainted = PL_tainting) |
bc2f1ca1 KW |
816 | |
817 | # define TAINT_NOT (PL_tainted = FALSE) /* Untaint */ | |
818 | # define TAINT_IF(c) if (UNLIKELY(c)) { TAINT; } /* Conditionally taint */ | |
2439e033 | 819 | # define TAINT_ENV() if (UNLIKELY(PL_tainting)) { taint_env(); } |
bc2f1ca1 KW |
820 | /* croak or warn if tainting */ |
821 | # define TAINT_PROPER(s) if (UNLIKELY(PL_tainting)) { \ | |
822 | taint_proper(NULL, s); \ | |
823 | } | |
284167a5 | 824 | # define TAINT_set(s) (PL_tainted = (s)) |
ea42b70b TC |
825 | # define TAINT_get (cBOOL(UNLIKELY(PL_tainted))) /* Is something tainted? */ |
826 | # define TAINTING_get (cBOOL(UNLIKELY(PL_tainting))) /* Is taint checking enabled? */ | |
284167a5 | 827 | # define TAINTING_set(s) (PL_tainting = (s)) |
bc2f1ca1 KW |
828 | # define TAINT_WARN_get (PL_taint_warn) /* FALSE => tainting violations |
829 | are fatal | |
830 | TRUE => they're just | |
831 | warnings */ | |
284167a5 SM |
832 | # define TAINT_WARN_set(s) (PL_taint_warn = (s)) |
833 | #endif | |
a687059c | 834 | |
20be6587 DM |
835 | /* flags used internally only within pp_subst and pp_substcont */ |
836 | #ifdef PERL_CORE | |
837 | # define SUBST_TAINT_STR 1 /* string tainted */ | |
838 | # define SUBST_TAINT_PAT 2 /* pattern tainted */ | |
839 | # define SUBST_TAINT_REPL 4 /* replacement tainted */ | |
840 | # define SUBST_TAINT_RETAINT 8 /* use re'taint' in scope */ | |
841 | # define SUBST_TAINT_BOOLRET 16 /* return is boolean (don't taint) */ | |
842 | #endif | |
843 | ||
d460ef45 | 844 | /* XXX All process group stuff is handled in pp_sys.c. Should these |
a6e633de PP |
845 | defines move there? If so, I could simplify this a lot. --AD 9/96. |
846 | */ | |
847 | /* Process group stuff changed from traditional BSD to POSIX. | |
848 | perlfunc.pod documents the traditional BSD-style syntax, so we'll | |
849 | try to preserve that, if possible. | |
850 | */ | |
851 | #ifdef HAS_SETPGID | |
852 | # define BSD_SETPGRP(pid, pgrp) setpgid((pid), (pgrp)) | |
da5fdda8 AC |
853 | #elif defined(HAS_SETPGRP) && defined(USE_BSD_SETPGRP) |
854 | # define BSD_SETPGRP(pid, pgrp) setpgrp((pid), (pgrp)) | |
855 | #elif defined(HAS_SETPGRP2) | |
856 | # define BSD_SETPGRP(pid, pgrp) setpgrp2((pid), (pgrp)) | |
a6e633de PP |
857 | #endif |
858 | #if defined(BSD_SETPGRP) && !defined(HAS_SETPGRP) | |
859 | # define HAS_SETPGRP /* Well, effectively it does . . . */ | |
860 | #endif | |
861 | ||
862 | /* getpgid isn't POSIX, but at least Solaris and Linux have it, and it makes | |
863 | our life easier :-) so we'll try it. | |
864 | */ | |
865 | #ifdef HAS_GETPGID | |
866 | # define BSD_GETPGRP(pid) getpgid((pid)) | |
da5fdda8 AC |
867 | #elif defined(HAS_GETPGRP) && defined(USE_BSD_GETPGRP) |
868 | # define BSD_GETPGRP(pid) getpgrp((pid)) | |
869 | #elif defined(HAS_GETPGRP2) | |
870 | # define BSD_GETPGRP(pid) getpgrp2((pid)) | |
a6e633de PP |
871 | #endif |
872 | #if defined(BSD_GETPGRP) && !defined(HAS_GETPGRP) | |
873 | # define HAS_GETPGRP /* Well, effectively it does . . . */ | |
874 | #endif | |
875 | ||
d460ef45 | 876 | /* These are not exact synonyms, since setpgrp() and getpgrp() may |
a6e633de PP |
877 | have different behaviors, but perl.h used to define USE_BSDPGRP |
878 | (prior to 5.003_05) so some extension might depend on it. | |
879 | */ | |
880 | #if defined(USE_BSD_SETPGRP) || defined(USE_BSD_GETPGRP) | |
881 | # ifndef USE_BSDPGRP | |
882 | # define USE_BSDPGRP | |
883 | # endif | |
663a0e37 LW |
884 | #endif |
885 | ||
486ec47a | 886 | /* HP-UX 10.X CMA (Common Multithreaded Architecture) insists that |
8ac5a1fe MH |
887 | pthread.h must be included before all other header files. |
888 | */ | |
3db8f154 | 889 | #if defined(USE_ITHREADS) && defined(PTHREAD_H_FIRST) && defined(I_PTHREAD) |
8ac5a1fe MH |
890 | # include <pthread.h> |
891 | #endif | |
892 | ||
58ab9e8b | 893 | #include <sys/types.h> |
663a0e37 | 894 | |
d2c9cb53 KW |
895 | # ifdef I_WCHAR |
896 | # include <wchar.h> | |
897 | # endif | |
898 | ||
9d82a2b7 | 899 | # include <stdarg.h> |
760ac839 | 900 | |
27db2737 JH |
901 | #ifdef I_STDINT |
902 | # include <stdint.h> | |
903 | #endif | |
904 | ||
fe14fcc3 | 905 | #include <ctype.h> |
63b481b9 AC |
906 | #include <float.h> |
907 | #include <limits.h> | |
a0d0e21e LW |
908 | |
909 | #ifdef METHOD /* Defined by OSF/1 v3.0 by ctype.h */ | |
910 | #undef METHOD | |
a0d0e21e LW |
911 | #endif |
912 | ||
12ae5dfc JH |
913 | #ifdef PERL_MICRO |
914 | # define NO_LOCALE | |
915 | #endif | |
916 | ||
4633a7c4 | 917 | #ifdef I_LOCALE |
36477c24 | 918 | # include <locale.h> |
4633a7c4 LW |
919 | #endif |
920 | ||
6ebbc862 KW |
921 | #ifdef I_XLOCALE |
922 | # include <xlocale.h> | |
923 | #endif | |
924 | ||
aa8a2baa KW |
925 | /* If not forbidden, we enable locale handling if either 1) the POSIX 2008 |
926 | * functions are available, or 2) just the setlocale() function. This logic is | |
927 | * repeated in t/loc_tools.pl and makedef.pl; The three should be kept in | |
928 | * sync. */ | |
929 | #if ! defined(NO_LOCALE) | |
930 | ||
931 | # if ! defined(NO_POSIX_2008_LOCALE) \ | |
932 | && defined(HAS_NEWLOCALE) \ | |
933 | && defined(HAS_USELOCALE) \ | |
934 | && defined(HAS_DUPLOCALE) \ | |
935 | && defined(HAS_FREELOCALE) \ | |
936 | && defined(LC_ALL_MASK) | |
937 | ||
938 | /* For simplicity, the code is written to assume that any platform advanced | |
939 | * enough to have the Posix 2008 locale functions has LC_ALL. The final | |
940 | * test above makes sure that assumption is valid */ | |
941 | ||
942 | # define HAS_POSIX_2008_LOCALE | |
943 | # define USE_LOCALE | |
944 | # elif defined(HAS_SETLOCALE) | |
945 | # define USE_LOCALE | |
946 | # endif | |
947 | #endif | |
948 | ||
949 | #ifdef USE_LOCALE | |
ccd65d51 | 950 | # define HAS_SKIP_LOCALE_INIT /* Solely for XS code to test for this |
af573503 | 951 | #define */ |
36477c24 PP |
952 | # if !defined(NO_LOCALE_COLLATE) && defined(LC_COLLATE) \ |
953 | && defined(HAS_STRXFRM) | |
954 | # define USE_LOCALE_COLLATE | |
955 | # endif | |
956 | # if !defined(NO_LOCALE_CTYPE) && defined(LC_CTYPE) | |
957 | # define USE_LOCALE_CTYPE | |
958 | # endif | |
959 | # if !defined(NO_LOCALE_NUMERIC) && defined(LC_NUMERIC) | |
960 | # define USE_LOCALE_NUMERIC | |
961 | # endif | |
fa9b773e KW |
962 | # if !defined(NO_LOCALE_MESSAGES) && defined(LC_MESSAGES) |
963 | # define USE_LOCALE_MESSAGES | |
964 | # endif | |
965 | # if !defined(NO_LOCALE_MONETARY) && defined(LC_MONETARY) | |
966 | # define USE_LOCALE_MONETARY | |
967 | # endif | |
56e45410 KW |
968 | # if !defined(NO_LOCALE_TIME) && defined(LC_TIME) |
969 | # define USE_LOCALE_TIME | |
970 | # endif | |
9821811f KW |
971 | # if !defined(NO_LOCALE_ADDRESS) && defined(LC_ADDRESS) |
972 | # define USE_LOCALE_ADDRESS | |
973 | # endif | |
974 | # if !defined(NO_LOCALE_IDENTIFICATION) && defined(LC_IDENTIFICATION) | |
975 | # define USE_LOCALE_IDENTIFICATION | |
976 | # endif | |
977 | # if !defined(NO_LOCALE_MEASUREMENT) && defined(LC_MEASUREMENT) | |
978 | # define USE_LOCALE_MEASUREMENT | |
979 | # endif | |
980 | # if !defined(NO_LOCALE_PAPER) && defined(LC_PAPER) | |
981 | # define USE_LOCALE_PAPER | |
982 | # endif | |
983 | # if !defined(NO_LOCALE_TELEPHONE) && defined(LC_TELEPHONE) | |
984 | # define USE_LOCALE_TELEPHONE | |
985 | # endif | |
36dbc955 KW |
986 | # if !defined(NO_LOCALE_SYNTAX) && defined(LC_SYNTAX) |
987 | # define USE_LOCALE_SYNTAX | |
988 | # endif | |
989 | # if !defined(NO_LOCALE_TOD) && defined(LC_TOD) | |
990 | # define USE_LOCALE_TOD | |
991 | # endif | |
a0d0e21e | 992 | |
5a53bf38 KW |
993 | /* XXX The next few defines are unfortunately duplicated in makedef.pl, and |
994 | * changes here MUST also be made there */ | |
995 | ||
aa8a2baa KW |
996 | # if ! defined(HAS_SETLOCALE) && defined(HAS_POSIX_2008_LOCALE) |
997 | # define USE_POSIX_2008_LOCALE | |
998 | # ifndef USE_THREAD_SAFE_LOCALE | |
999 | # define USE_THREAD_SAFE_LOCALE | |
1000 | # endif | |
e1895adc KW |
1001 | /* If compiled with |
1002 | * -DUSE_THREAD_SAFE_LOCALE, will do so even | |
1003 | * on unthreaded builds */ | |
aa8a2baa KW |
1004 | # elif (defined(USE_ITHREADS) || defined(USE_THREAD_SAFE_LOCALE)) \ |
1005 | && ( defined(HAS_POSIX_2008_LOCALE) \ | |
1006 | || (defined(WIN32) && defined(_MSC_VER) && _MSC_VER >= 1400)) \ | |
1007 | && ! defined(NO_THREAD_SAFE_LOCALE) | |
e1895adc KW |
1008 | # ifndef USE_THREAD_SAFE_LOCALE |
1009 | # define USE_THREAD_SAFE_LOCALE | |
1010 | # endif | |
e9bc6d6b KW |
1011 | # ifdef HAS_POSIX_2008_LOCALE |
1012 | # define USE_POSIX_2008_LOCALE | |
1013 | # endif | |
1014 | # endif | |
7f9e9632 KW |
1015 | #endif |
1016 | ||
69c5e0db KW |
1017 | /* Microsoft documentation reads in the change log for VS 2015: |
1018 | * "The localeconv function declared in locale.h now works correctly when | |
1019 | * per-thread locale is enabled. In previous versions of the library, this | |
1020 | * function would return the lconv data for the global locale, not the | |
1021 | * thread's locale." | |
1022 | */ | |
1023 | #if defined(WIN32) && defined(USE_THREAD_SAFE_LOCALE) && _MSC_VER < 1900 | |
1024 | # define TS_W32_BROKEN_LOCALECONV | |
1025 | #endif | |
1026 | ||
fe14fcc3 | 1027 | #include <setjmp.h> |
79072805 | 1028 | |
a0d0e21e | 1029 | #ifdef I_SYS_PARAM |
79072805 LW |
1030 | # ifdef PARAM_NEEDS_TYPES |
1031 | # include <sys/types.h> | |
1032 | # endif | |
1033 | # include <sys/param.h> | |
352d5a3a | 1034 | #endif |
79072805 | 1035 | |
ce3470dc AD |
1036 | /* On BSD-derived systems, <sys/param.h> defines BSD to a year-month |
1037 | value something like 199306. This may be useful if no more-specific | |
1038 | feature test is available. | |
1039 | */ | |
1040 | #if defined(BSD) | |
1041 | # ifndef BSDish | |
1042 | # define BSDish | |
1043 | # endif | |
1044 | #endif | |
1045 | ||
dd512de3 AC |
1046 | /* Use all the "standard" definitions */ |
1047 | #include <stdlib.h> | |
03a14243 | 1048 | |
3f270f98 JH |
1049 | /* If this causes problems, set i_unistd=undef in the hint file. */ |
1050 | #ifdef I_UNISTD | |
763ee752 AB |
1051 | # if defined(__amigaos4__) |
1052 | # ifdef I_NETINET_IN | |
1053 | # include <netinet/in.h> | |
1054 | # endif | |
1055 | # endif | |
3f270f98 | 1056 | # include <unistd.h> |
6e3136a6 AB |
1057 | # if defined(__amigaos4__) |
1058 | /* Under AmigaOS 4 newlib.library provides an environ. However using | |
1059 | * it doesn't give us enough control over inheritance of variables by | |
1060 | * subshells etc. so replace with custom version based on abc-shell | |
1061 | * code. */ | |
1062 | extern char **myenviron; | |
1063 | # undef environ | |
1064 | # define environ myenviron | |
1065 | # endif | |
3f270f98 JH |
1066 | #endif |
1067 | ||
de8ca8af NT |
1068 | /* for WCOREDUMP */ |
1069 | #ifdef I_SYS_WAIT | |
1070 | # include <sys/wait.h> | |
1071 | #endif | |
1072 | ||
21e89b5f | 1073 | #if defined(HAS_SYSCALL) && !defined(HAS_SYSCALL_PROTO) |
c45598c5 | 1074 | EXTERN_C int syscall(int, ...); |
2ef53570 JH |
1075 | #endif |
1076 | ||
21e89b5f | 1077 | #if defined(HAS_USLEEP) && !defined(HAS_USLEEP_PROTO) |
c45598c5 | 1078 | EXTERN_C int usleep(unsigned int); |
2ef53570 JH |
1079 | #endif |
1080 | ||
ca336c50 | 1081 | /* Macros for correct constant construction. These are in C99 <stdint.h> |
f2f9e01d | 1082 | * (so they will not be available in strict C89 mode), but they are nice, so |
ca336c50 | 1083 | * let's define them if necessary. |
3f620621 | 1084 | =for apidoc_section $integer |
ca336c50 KW |
1085 | =for apidoc Am|I16|INT16_C|number |
1086 | =for apidoc_item |I32|INT32_C|number | |
1087 | =for apidoc_item |I64|INT64_C|number | |
1088 | ||
1089 | Returns a token the C compiler recognizes for the constant C<number> of the | |
1090 | corresponding integer type on the machine. | |
1091 | ||
1092 | If the machine does not have a 64-bit type, C<INT64_C> is undefined. | |
23f5c29f | 1093 | Use C<L</INTMAX_C>> to get the largest type available on the platform. |
ca336c50 KW |
1094 | |
1095 | =for apidoc Am|U16|UINT16_C|number | |
1096 | =for apidoc_item |U32|UINT32_C|number | |
1097 | =for apidoc_item |U64|UINT64_C|number | |
1098 | ||
1099 | Returns a token the C compiler recognizes for the constant C<number> of the | |
1100 | corresponding unsigned integer type on the machine. | |
1101 | ||
1102 | If the machine does not have a 64-bit type, C<UINT64_C> is undefined. | |
23f5c29f | 1103 | Use C<L</UINTMAX_C>> to get the largest type available on the platform. |
ca336c50 KW |
1104 | |
1105 | ||
1106 | =cut | |
1107 | */ | |
f2f9e01d KW |
1108 | #ifndef UINT16_C |
1109 | # if INTSIZE >= 2 | |
1110 | # define UINT16_C(x) ((U16_TYPE)x##U) | |
1111 | # else | |
1112 | # define UINT16_C(x) ((U16_TYPE)x##UL) | |
1113 | # endif | |
1114 | #endif | |
1109a392 | 1115 | |
f2f9e01d KW |
1116 | #ifndef UINT32_C |
1117 | # if INTSIZE >= 4 | |
1118 | # define UINT32_C(x) ((U32_TYPE)x##U) | |
1119 | # else | |
1120 | # define UINT32_C(x) ((U32_TYPE)x##UL) | |
1121 | # endif | |
1122 | #endif | |
1109a392 | 1123 | |
f2f9e01d KW |
1124 | #ifdef I_STDINT |
1125 | typedef intmax_t PERL_INTMAX_T; | |
1126 | typedef uintmax_t PERL_UINTMAX_T; | |
1127 | #endif | |
1128 | ||
1129 | /* N.B. We use QUADKIND here instead of HAS_QUAD here, because that doesn't | |
1130 | * actually mean what it has always been documented to mean (see RT #119753) | |
1131 | * and is explicitly turned off outside of core with dire warnings about | |
1132 | * removing the undef. */ | |
1133 | ||
1134 | #if defined(QUADKIND) | |
1135 | # undef PeRl_INT64_C | |
1136 | # undef PeRl_UINT64_C | |
1137 | /* Prefer the native integer types (int and long) over long long | |
1138 | * (which is not C89) and Win32-specific __int64. */ | |
1139 | # if QUADKIND == QUAD_IS_INT && INTSIZE == 8 | |
1140 | # define PeRl_INT64_C(c) (c) | |
1141 | # define PeRl_UINT64_C(c) CAT2(c,U) | |
1142 | # endif | |
1143 | # if QUADKIND == QUAD_IS_LONG && LONGSIZE == 8 | |
1144 | # define PeRl_INT64_C(c) CAT2(c,L) | |
1145 | # define PeRl_UINT64_C(c) CAT2(c,UL) | |
1146 | # endif | |
1147 | # if QUADKIND == QUAD_IS_LONG_LONG && defined(HAS_LONG_LONG) | |
1148 | # define PeRl_INT64_C(c) CAT2(c,LL) | |
1149 | # define PeRl_UINT64_C(c) CAT2(c,ULL) | |
1150 | # endif | |
1151 | # if QUADKIND == QUAD_IS___INT64 | |
1152 | # define PeRl_INT64_C(c) CAT2(c,I64) | |
1153 | # define PeRl_UINT64_C(c) CAT2(c,UI64) | |
1154 | # endif | |
1155 | # ifndef PeRl_INT64_C | |
1156 | # define PeRl_INT64_C(c) ((I64)(c)) /* last resort */ | |
1157 | # define PeRl_UINT64_C(c) ((U64TYPE)(c)) | |
1158 | # endif | |
1159 | /* In OS X the INT64_C/UINT64_C are defined with LL/ULL, which will | |
1160 | * not fly with C89-pedantic gcc, so let's undefine them first so that | |
1161 | * we can redefine them with our native integer preferring versions. */ | |
1162 | # if defined(PERL_DARWIN) && defined(PERL_GCC_PEDANTIC) | |
1163 | # undef INT64_C | |
1164 | # undef UINT64_C | |
1165 | # endif | |
1166 | # ifndef INT64_C | |
1167 | # define INT64_C(c) PeRl_INT64_C(c) | |
1168 | # endif | |
1169 | # ifndef UINT64_C | |
1170 | # define UINT64_C(c) PeRl_UINT64_C(c) | |
1171 | # endif | |
1109a392 | 1172 | |
ebaa1d42 | 1173 | /* |
3f620621 | 1174 | =for apidoc_section $integer |
ebaa1d42 KW |
1175 | =for apidoc Am||INTMAX_C|number |
1176 | Returns a token the C compiler recognizes for the constant C<number> of the | |
1177 | widest integer type on the machine. For example, if the machine has C<long | |
1178 | long>s, C<INTMAX_C(-1)> would yield | |
1179 | ||
1180 | -1LL | |
1181 | ||
23f5c29f KW |
1182 | See also, for example, C<L</INT32_C>>. |
1183 | ||
1184 | Use L</IV> to declare variables of the maximum usable size on this platform. | |
1185 | ||
ebaa1d42 KW |
1186 | =for apidoc Am||UINTMAX_C|number |
1187 | Returns a token the C compiler recognizes for the constant C<number> of the | |
1188 | widest unsigned integer type on the machine. For example, if the machine has | |
1189 | C<long>s, C<UINTMAX_C(1)> would yield | |
1190 | ||
1191 | 1UL | |
1192 | ||
23f5c29f KW |
1193 | See also, for example, C<L</UINT32_C>>. |
1194 | ||
1195 | Use L</UV> to declare variables of the maximum usable size on this platform. | |
1196 | ||
ebaa1d42 KW |
1197 | =cut |
1198 | */ | |
1199 | ||
f2f9e01d KW |
1200 | # ifndef I_STDINT |
1201 | typedef I64TYPE PERL_INTMAX_T; | |
1202 | typedef U64TYPE PERL_UINTMAX_T; | |
1109a392 | 1203 | # endif |
f2f9e01d KW |
1204 | # ifndef INTMAX_C |
1205 | # define INTMAX_C(c) INT64_C(c) | |
1206 | # endif | |
1207 | # ifndef UINTMAX_C | |
1208 | # define UINTMAX_C(c) UINT64_C(c) | |
1209 | # endif | |
1210 | ||
1211 | #else /* below QUADKIND is undefined */ | |
1212 | ||
1213 | /* Perl doesn't work on 16 bit systems, so must be 32 bit */ | |
1214 | # ifndef I_STDINT | |
1215 | typedef I32TYPE PERL_INTMAX_T; | |
1216 | typedef U32TYPE PERL_UINTMAX_T; | |
1217 | # endif | |
1218 | # ifndef INTMAX_C | |
1219 | # define INTMAX_C(c) INT32_C(c) | |
1220 | # endif | |
1221 | # ifndef UINTMAX_C | |
1222 | # define UINTMAX_C(c) UINT32_C(c) | |
1223 | # endif | |
1224 | ||
1225 | #endif /* no QUADKIND */ | |
1226 | ||
1227 | #ifdef PERL_CORE | |
1109a392 MHM |
1228 | |
1229 | /* byte-swapping functions for big-/little-endian conversion */ | |
1230 | # define _swab_16_(x) ((U16)( \ | |
f2f9e01d KW |
1231 | (((U16)(x) & UINT16_C(0x00ff)) << 8) | \ |
1232 | (((U16)(x) & UINT16_C(0xff00)) >> 8) )) | |
1109a392 MHM |
1233 | |
1234 | # define _swab_32_(x) ((U32)( \ | |
f2f9e01d KW |
1235 | (((U32)(x) & UINT32_C(0x000000ff)) << 24) | \ |
1236 | (((U32)(x) & UINT32_C(0x0000ff00)) << 8) | \ | |
1237 | (((U32)(x) & UINT32_C(0x00ff0000)) >> 8) | \ | |
1238 | (((U32)(x) & UINT32_C(0xff000000)) >> 24) )) | |
1109a392 MHM |
1239 | |
1240 | # ifdef HAS_QUAD | |
1241 | # define _swab_64_(x) ((U64)( \ | |
f2f9e01d KW |
1242 | (((U64)(x) & UINT64_C(0x00000000000000ff)) << 56) | \ |
1243 | (((U64)(x) & UINT64_C(0x000000000000ff00)) << 40) | \ | |
1244 | (((U64)(x) & UINT64_C(0x0000000000ff0000)) << 24) | \ | |
1245 | (((U64)(x) & UINT64_C(0x00000000ff000000)) << 8) | \ | |
1246 | (((U64)(x) & UINT64_C(0x000000ff00000000)) >> 8) | \ | |
1247 | (((U64)(x) & UINT64_C(0x0000ff0000000000)) >> 24) | \ | |
1248 | (((U64)(x) & UINT64_C(0x00ff000000000000)) >> 40) | \ | |
1249 | (((U64)(x) & UINT64_C(0xff00000000000000)) >> 56) )) | |
1109a392 MHM |
1250 | # endif |
1251 | ||
9c17f24a NC |
1252 | /* The old value was hard coded at 1008. (4096-16) seems to be a bit faster, |
1253 | at least on FreeBSD. YMMV, so experiment. */ | |
1254 | #ifndef PERL_ARENA_SIZE | |
1255 | #define PERL_ARENA_SIZE 4080 | |
1256 | #endif | |
1257 | ||
ccb2c8b8 | 1258 | /* Maximum level of recursion */ |
2b9dff67 RGS |
1259 | #ifndef PERL_SUB_DEPTH_WARN |
1260 | #define PERL_SUB_DEPTH_WARN 100 | |
ccb2c8b8 RGS |
1261 | #endif |
1262 | ||
1109a392 MHM |
1263 | #endif /* PERL_CORE */ |
1264 | ||
e839e6ed DM |
1265 | /* Maximum number of args that may be passed to an OP_MULTICONCAT op. |
1266 | * It determines the size of local arrays in S_maybe_multiconcat() and | |
1267 | * pp_multiconcat(). | |
1268 | */ | |
1269 | #define PERL_MULTICONCAT_MAXARG 64 | |
1270 | ||
1271 | /* The indexes of fields of a multiconcat aux struct. | |
1272 | * The fixed fields are followed by nargs+1 const segment lengths, | |
1273 | * and if utf8 and non-utf8 differ, a second nargs+1 set for utf8. | |
1274 | */ | |
1275 | ||
1276 | #define PERL_MULTICONCAT_IX_NARGS 0 /* number of arguments */ | |
1277 | #define PERL_MULTICONCAT_IX_PLAIN_PV 1 /* non-utf8 constant string */ | |
1278 | #define PERL_MULTICONCAT_IX_PLAIN_LEN 2 /* non-utf8 constant string length */ | |
1279 | #define PERL_MULTICONCAT_IX_UTF8_PV 3 /* utf8 constant string */ | |
1280 | #define PERL_MULTICONCAT_IX_UTF8_LEN 4 /* utf8 constant string length */ | |
1281 | #define PERL_MULTICONCAT_IX_LENGTHS 5 /* first of nargs+1 const segment lens */ | |
1282 | #define PERL_MULTICONCAT_HEADER_SIZE 5 /* The number of fields of a | |
1283 | multiconcat header */ | |
1284 | ||
bdf3085f NC |
1285 | /* We no longer default to creating a new SV for GvSV. |
1286 | Do this before embed. */ | |
1287 | #ifndef PERL_CREATE_GVSV | |
7459f06b NC |
1288 | # ifndef PERL_DONT_CREATE_GVSV |
1289 | # define PERL_DONT_CREATE_GVSV | |
1290 | # endif | |
bdf3085f NC |
1291 | #endif |
1292 | ||
ca0c25f6 NC |
1293 | #if !defined(HAS_WAITPID) && !defined(HAS_WAIT4) || defined(HAS_WAITPID_RUNTIME) |
1294 | #define PERL_USES_PL_PIDSTATUS | |
1295 | #endif | |
1296 | ||
822c8b4d | 1297 | #if !defined(OS2) && !defined(WIN32) && !defined(DJGPP) |
a62746fa RGS |
1298 | #define PERL_DEFAULT_DO_EXEC3_IMPLEMENTATION |
1299 | #endif | |
1300 | ||
c31fac66 GS |
1301 | #define MEM_SIZE Size_t |
1302 | ||
1936d2a7 NC |
1303 | /* Round all values passed to malloc up, by default to a multiple of |
1304 | sizeof(size_t) | |
1305 | */ | |
1306 | #ifndef PERL_STRLEN_ROUNDUP_QUANTUM | |
1307 | #define PERL_STRLEN_ROUNDUP_QUANTUM Size_t_size | |
1308 | #endif | |
1309 | ||
f1200559 WH |
1310 | /* sv_grow() will expand strings by at least a certain percentage of |
1311 | the previously *used* length to avoid excessive calls to realloc(). | |
1312 | The default is 25% of the current length. | |
1313 | */ | |
1314 | #ifndef PERL_STRLEN_EXPAND_SHIFT | |
1315 | # define PERL_STRLEN_EXPAND_SHIFT 2 | |
1316 | #endif | |
1317 | ||
4bd4e933 SH |
1318 | /* This use of offsetof() requires /Zc:offsetof- for VS2017 (and presumably |
1319 | * onwards) when building Socket.xs, but we can just use a different definition | |
1320 | * for STRUCT_OFFSET instead. */ | |
1321 | #if defined(WIN32) && defined(_MSC_VER) && _MSC_VER >= 1910 | |
1322 | # define STRUCT_OFFSET(s,m) (Size_t)(&(((s *)0)->m)) | |
1323 | #else | |
1324 | # include <stddef.h> | |
1325 | # define STRUCT_OFFSET(s,m) offsetof(s,m) | |
1326 | #endif | |
d0b86e2f | 1327 | |
86477e89 KW |
1328 | /* ptrdiff_t is C11, so undef it under pedantic builds. (Actually it is |
1329 | * in C89, but apparently there are platforms where it doesn't exist. See | |
1330 | * thread beginning at http://nntp.perl.org/group/perl.perl5.porters/251541.) | |
1331 | * */ | |
d0b86e2f BF |
1332 | #ifdef PERL_GCC_PEDANTIC |
1333 | # undef HAS_PTRDIFF_T | |
51371543 GS |
1334 | #endif |
1335 | ||
86477e89 KW |
1336 | #ifdef HAS_PTRDIFF_T |
1337 | # define Ptrdiff_t ptrdiff_t | |
1338 | #else | |
1339 | # define Ptrdiff_t SSize_t | |
1340 | #endif | |
1341 | ||
d54fbe84 | 1342 | # include <string.h> |
51371543 | 1343 | |
55497cff PP |
1344 | /* This comes after <stdlib.h> so we don't try to change the standard |
1345 | * library prototypes; we'll use our own in proto.h instead. */ | |
03a14243 | 1346 | |
4633a7c4 | 1347 | #ifdef MYMALLOC |
86058a2d | 1348 | # ifdef PERL_POLLUTE_MALLOC |
ee13e175 | 1349 | # ifndef PERL_EXTMALLOC_DEF |
86058a2d GS |
1350 | # define Perl_malloc malloc |
1351 | # define Perl_calloc calloc | |
1352 | # define Perl_realloc realloc | |
1353 | # define Perl_mfree free | |
ee13e175 | 1354 | # endif |
86058a2d GS |
1355 | # else |
1356 | # define EMBEDMYMALLOC /* for compatibility */ | |
1357 | # endif | |
827e134a | 1358 | |
651b9576 GS |
1359 | # define safemalloc Perl_malloc |
1360 | # define safecalloc Perl_calloc | |
1361 | # define saferealloc Perl_realloc | |
1362 | # define safefree Perl_mfree | |
22f7c9c9 | 1363 | # define CHECK_MALLOC_TOO_LATE_FOR_(code) STMT_START { \ |
54725a52 | 1364 | if (!TAINTING_get && MallocCfg_ptr[MallocCfg_cfg_env_read]) \ |
22f7c9c9 JH |
1365 | code; \ |
1366 | } STMT_END | |
1367 | # define CHECK_MALLOC_TOO_LATE_FOR(ch) \ | |
1368 | CHECK_MALLOC_TOO_LATE_FOR_(MALLOC_TOO_LATE_FOR(ch)) | |
1369 | # define panic_write2(s) write(2, s, strlen(s)) | |
1370 | # define CHECK_MALLOC_TAINT(newval) \ | |
1371 | CHECK_MALLOC_TOO_LATE_FOR_( \ | |
1372 | if (newval) { \ | |
acfd4d8e | 1373 | PERL_UNUSED_RESULT(panic_write2("panic: tainting with $ENV{PERL_MALLOC_OPT}\n"));\ |
22f7c9c9 | 1374 | exit(1); }) |
22f7c9c9 | 1375 | # define MALLOC_CHECK_TAINT(argc,argv,env) STMT_START { \ |
b0891165 | 1376 | if (doing_taint(argc,argv,env)) { \ |
22f7c9c9 JH |
1377 | MallocCfg_ptr[MallocCfg_skip_cfg_env] = 1; \ |
1378 | }} STMT_END; | |
f2517201 GS |
1379 | #else /* MYMALLOC */ |
1380 | # define safemalloc safesysmalloc | |
1381 | # define safecalloc safesyscalloc | |
1382 | # define saferealloc safesysrealloc | |
1383 | # define safefree safesysfree | |
22f7c9c9 JH |
1384 | # define CHECK_MALLOC_TOO_LATE_FOR(ch) ((void)0) |
1385 | # define CHECK_MALLOC_TAINT(newval) ((void)0) | |
1386 | # define MALLOC_CHECK_TAINT(argc,argv,env) | |
55497cff | 1387 | #endif /* MYMALLOC */ |
4633a7c4 | 1388 | |
fe13d51d | 1389 | /* diag_listed_as: "-T" is on the #! line, it must also be used on the command line */ |
27da23d5 | 1390 | #define TOO_LATE_FOR_(ch,what) Perl_croak(aTHX_ "\"-%c\" is on the #! line, it must also be used on the command line%s", (char)(ch), what) |
22f7c9c9 JH |
1391 | #define TOO_LATE_FOR(ch) TOO_LATE_FOR_(ch, "") |
1392 | #define MALLOC_TOO_LATE_FOR(ch) TOO_LATE_FOR_(ch, " with $ENV{PERL_MALLOC_OPT}") | |
1393 | #define MALLOC_CHECK_TAINT2(argc,argv) MALLOC_CHECK_TAINT(argc,argv,NULL) | |
1394 | ||
897b41d9 KW |
1395 | /* |
1396 | =for apidoc Am|void|memzero|void * d|Size_t l | |
1397 | Set the C<l> bytes starting at C<*d> to all zeroes. | |
1398 | ||
1399 | =cut | |
1400 | */ | |
fc36a67e | 1401 | #ifndef memzero |
04322328 | 1402 | # define memzero(d,l) memset(d,0,l) |
d9d8d8de | 1403 | #endif |
378cc40b | 1404 | |
ae986130 | 1405 | #ifdef I_NETINET_IN |
79072805 | 1406 | # include <netinet/in.h> |
ae986130 LW |
1407 | #endif |
1408 | ||
28e8609d JH |
1409 | #ifdef I_ARPA_INET |
1410 | # include <arpa/inet.h> | |
1411 | #endif | |
1412 | ||
1aef975c | 1413 | #ifdef I_SYS_STAT |
84902520 | 1414 | # include <sys/stat.h> |
1aef975c | 1415 | #endif |
79072805 | 1416 | |
287a962e JD |
1417 | /* Microsoft VC's sys/stat.h defines all S_Ixxx macros except S_IFIFO. |
1418 | This definition should ideally go into win32/win32.h, but S_IFIFO is | |
1419 | used later here in perl.h before win32/win32.h is being included. */ | |
1420 | #if !defined(S_IFIFO) && defined(_S_IFIFO) | |
1421 | # define S_IFIFO _S_IFIFO | |
1422 | #endif | |
1423 | ||
cc3315ba | 1424 | /* The stat macros for Unisoft System V/88 (and derivatives |
a0d0e21e LW |
1425 | like UTekV) are broken, sometimes giving false positives. Undefine |
1426 | them here and let the code below set them to proper values. | |
1427 | ||
1428 | The ghs macro stands for GreenHills Software C-1.8.5 which | |
1429 | is the C compiler for sysV88 and the various derivatives. | |
1430 | This header file bug is corrected in gcc-2.5.8 and later versions. | |
1431 | --Kaveh Ghazi (ghazi@noc.rutgers.edu) 10/3/94. */ | |
1432 | ||
cc3315ba | 1433 | #if defined(m88k) && defined(ghs) |
79072805 LW |
1434 | # undef S_ISDIR |
1435 | # undef S_ISCHR | |
1436 | # undef S_ISBLK | |
1437 | # undef S_ISREG | |
1438 | # undef S_ISFIFO | |
1439 | # undef S_ISLNK | |
ee0007ab | 1440 | #endif |
135863df | 1441 | |
9245da2a | 1442 | #include <time.h> |
663a0e37 | 1443 | |
fe14fcc3 | 1444 | #ifdef I_SYS_TIME |
85e6fe83 | 1445 | # ifdef I_SYS_TIME_KERNEL |
663a0e37 LW |
1446 | # define KERNEL |
1447 | # endif | |
1448 | # include <sys/time.h> | |
85e6fe83 | 1449 | # ifdef I_SYS_TIME_KERNEL |
663a0e37 LW |
1450 | # undef KERNEL |
1451 | # endif | |
a687059c | 1452 | #endif |
135863df | 1453 | |
55497cff | 1454 | #if defined(HAS_TIMES) && defined(I_SYS_TIMES) |
85e6fe83 | 1455 | # include <sys/times.h> |
d9d8d8de | 1456 | #endif |
8d063cd8 | 1457 | |
663a0e37 | 1458 | #include <errno.h> |
1e743fda | 1459 | |
acfe0abc | 1460 | #if defined(WIN32) && defined(PERL_IMPLICIT_SYS) |
b4748376 NIS |
1461 | # define WIN32SCK_IS_STDSCK /* don't pull in custom wsock layer */ |
1462 | #endif | |
1463 | ||
da70cfc6 | 1464 | #if defined(HAS_SOCKET) && !defined(WIN32) /* WIN32 handles sockets via win32.h */ |
1e743fda JH |
1465 | # include <sys/socket.h> |
1466 | # if defined(USE_SOCKS) && defined(I_SOCKS) | |
1467 | # if !defined(INCLUDE_PROTOTYPES) | |
1468 | # define INCLUDE_PROTOTYPES /* for <socks.h> */ | |
1469 | # define PERL_SOCKS_NEED_PROTOTYPES | |
1470 | # endif | |
1471 | # include <socks.h> | |
1472 | # ifdef PERL_SOCKS_NEED_PROTOTYPES /* keep cpp space clean */ | |
1473 | # undef INCLUDE_PROTOTYPES | |
1474 | # undef PERL_SOCKS_NEED_PROTOTYPES | |
ed6116ce | 1475 | # endif |
d460ef45 | 1476 | # endif |
1e743fda | 1477 | # ifdef I_NETDB |
2986a63f JH |
1478 | # ifdef NETWARE |
1479 | # include<stdio.h> | |
1480 | # endif | |
1e743fda JH |
1481 | # include <netdb.h> |
1482 | # endif | |
1483 | # ifndef ENOTSOCK | |
1484 | # ifdef I_NET_ERRNO | |
1485 | # include <net/errno.h> | |
1486 | # endif | |
1487 | # endif | |
1488 | #endif | |
1489 | ||
fa0a29af | 1490 | /* sockatmark() is so new (2001) that many places might have it hidden |
29820b6d MHM |
1491 | * behind some -D_BLAH_BLAH_SOURCE guard. The __THROW magic is required |
1492 | * e.g. in Gentoo, see http://bugs.gentoo.org/show_bug.cgi?id=12605 */ | |
fa0a29af | 1493 | #if defined(HAS_SOCKATMARK) && !defined(HAS_SOCKATMARK_PROTO) |
29820b6d MHM |
1494 | # if defined(__THROW) && defined(__GLIBC__) |
1495 | int sockatmark(int) __THROW; | |
1496 | # else | |
2ef53570 | 1497 | int sockatmark(int); |
29820b6d | 1498 | # endif |
2ef53570 JH |
1499 | #endif |
1500 | ||
7e827271 | 1501 | #if defined(__osf__) && defined(__cplusplus) && !defined(_XOPEN_SOURCE_EXTENDED) /* Tru64 "cxx" (C++), see hints/dec_osf.sh for why the _XOPEN_SOURCE_EXTENDED cannot be defined. */ |
45d3b546 JH |
1502 | EXTERN_C int fchdir(int); |
1503 | EXTERN_C int flock(int, int); | |
1504 | EXTERN_C int fseeko(FILE *, off_t, int); | |
1505 | EXTERN_C off_t ftello(FILE *); | |
1506 | #endif | |
1507 | ||
7e827271 | 1508 | #if defined(__SUNPRO_CC) /* SUNWspro CC (C++) */ |
1ccb7c8d JH |
1509 | EXTERN_C char *crypt(const char *, const char *); |
1510 | #endif | |
1511 | ||
a54aca4b | 1512 | #if defined(__cplusplus) && defined(__CYGWIN__) |
667e2948 SP |
1513 | EXTERN_C char *crypt(const char *, const char *); |
1514 | #endif | |
1515 | ||
131e4949 | 1516 | /* |
3f620621 | 1517 | =for apidoc_section $errno |
131e4949 TC |
1518 | |
1519 | =for apidoc m|void|SETERRNO|int errcode|int vmserrcode | |
1520 | ||
1521 | Set C<errno>, and on VMS set C<vaxc$errno>. | |
1522 | ||
1523 | =for apidoc mn|void|dSAVEDERRNO | |
1524 | ||
1525 | Declare variables needed to save C<errno> and any operating system | |
1526 | specific error number. | |
1527 | ||
1528 | =for apidoc mn|void|dSAVE_ERRNO | |
1529 | ||
1530 | Declare variables needed to save C<errno> and any operating system | |
1531 | specific error number, and save them for optional later restoration | |
1532 | by C<RESTORE_ERRNO>. | |
1533 | ||
1534 | =for apidoc mn|void|SAVE_ERRNO | |
1535 | ||
1536 | Save C<errno> and any operating system specific error number for | |
1537 | optional later restoration by C<RESTORE_ERRNO>. Requires | |
1538 | C<dSAVEDERRNO> or C<dSAVE_ERRNO> in scope. | |
1539 | ||
1540 | =for apidoc mn|void|RESTORE_ERRNO | |
1541 | ||
1542 | Restore C<errno> and any operating system specific error number that | |
1543 | was saved by C<dSAVE_ERRNO> or C<RESTORE_ERRNO>. | |
1544 | ||
1545 | =cut | |
1546 | */ | |
1547 | ||
1e743fda JH |
1548 | #ifdef SETERRNO |
1549 | # undef SETERRNO /* SOCKS might have defined this */ | |
ed6116ce | 1550 | #endif |
f86702cc PP |
1551 | |
1552 | #ifdef VMS | |
1553 | # define SETERRNO(errcode,vmserrcode) \ | |
1554 | STMT_START { \ | |
1555 | set_errno(errcode); \ | |
1556 | set_vaxc_errno(vmserrcode); \ | |
1557 | } STMT_END | |
4ee39169 CS |
1558 | # define dSAVEDERRNO int saved_errno; unsigned saved_vms_errno |
1559 | # define dSAVE_ERRNO int saved_errno = errno; unsigned saved_vms_errno = vaxc$errno | |
1560 | # define SAVE_ERRNO ( saved_errno = errno, saved_vms_errno = vaxc$errno ) | |
1561 | # define RESTORE_ERRNO SETERRNO(saved_errno, saved_vms_errno) | |
1562 | ||
93189314 JH |
1563 | # define LIB_INVARG LIB$_INVARG |
1564 | # define RMS_DIR RMS$_DIR | |
1565 | # define RMS_FAC RMS$_FAC | |
1566 | # define RMS_FEX RMS$_FEX | |
1567 | # define RMS_FNF RMS$_FNF | |
1568 | # define RMS_IFI RMS$_IFI | |
1569 | # define RMS_ISI RMS$_ISI | |
1570 | # define RMS_PRV RMS$_PRV | |
1571 | # define SS_ACCVIO SS$_ACCVIO | |
1572 | # define SS_DEVOFFLINE SS$_DEVOFFLINE | |
1573 | # define SS_IVCHAN SS$_IVCHAN | |
1574 | # define SS_NORMAL SS$_NORMAL | |
8a9f18be | 1575 | # define SS_NOPRIV SS$_NOPRIV |
4388f261 | 1576 | # define SS_BUFFEROVF SS$_BUFFEROVF |
748a9306 | 1577 | #else |
93189314 JH |
1578 | # define LIB_INVARG 0 |
1579 | # define RMS_DIR 0 | |
1580 | # define RMS_FAC 0 | |
1581 | # define RMS_FEX 0 | |
1582 | # define RMS_FNF 0 | |
1583 | # define RMS_IFI 0 | |
1584 | # define RMS_ISI 0 | |
1585 | # define RMS_PRV 0 | |
1586 | # define SS_ACCVIO 0 | |
1587 | # define SS_DEVOFFLINE 0 | |
1588 | # define SS_IVCHAN 0 | |
1589 | # define SS_NORMAL 0 | |
8a9f18be | 1590 | # define SS_NOPRIV 0 |
4388f261 | 1591 | # define SS_BUFFEROVF 0 |
748a9306 | 1592 | #endif |
ed6116ce | 1593 | |
6ca940a9 TC |
1594 | #ifdef WIN32 |
1595 | # define dSAVEDERRNO int saved_errno; DWORD saved_win32_errno | |
1596 | # define dSAVE_ERRNO int saved_errno = errno; DWORD saved_win32_errno = GetLastError() | |
1597 | # define SAVE_ERRNO ( saved_errno = errno, saved_win32_errno = GetLastError() ) | |
1598 | # define RESTORE_ERRNO ( errno = saved_errno, SetLastError(saved_win32_errno) ) | |
1599 | #endif | |
1600 | ||
1601 | #ifdef OS2 | |
1602 | # define dSAVEDERRNO int saved_errno; unsigned long saved_os2_errno | |
1603 | # define dSAVE_ERRNO int saved_errno = errno; unsigned long saved_os2_errno = Perl_rc | |
1604 | # define SAVE_ERRNO ( saved_errno = errno, saved_os2_errno = Perl_rc ) | |
1605 | # define RESTORE_ERRNO ( errno = saved_errno, Perl_rc = saved_os2_errno ) | |
1606 | #endif | |
1607 | ||
1608 | #ifndef SETERRNO | |
1609 | # define SETERRNO(errcode,vmserrcode) (errno = (errcode)) | |
1610 | #endif | |
1611 | ||
1612 | #ifndef dSAVEDERRNO | |
1613 | # define dSAVEDERRNO int saved_errno | |
1614 | # define dSAVE_ERRNO int saved_errno = errno | |
1615 | # define SAVE_ERRNO (saved_errno = errno) | |
1616 | # define RESTORE_ERRNO (errno = saved_errno) | |
1617 | #endif | |
1618 | ||
40bec302 | 1619 | /* |
3f620621 | 1620 | =for apidoc_section $warning |
40bec302 TC |
1621 | |
1622 | =for apidoc Amn|SV *|ERRSV | |
1623 | ||
1624 | Returns the SV for C<$@>, creating it if needed. | |
1625 | ||
1626 | =for apidoc Am|void|CLEAR_ERRSV | |
1627 | ||
1628 | Clear the contents of C<$@>, setting it to the empty string. | |
1629 | ||
1630 | This replaces any read-only SV with a fresh SV and removes any magic. | |
1631 | ||
933e3e63 TC |
1632 | =for apidoc Am|void|SANE_ERRSV |
1633 | ||
1634 | Clean up ERRSV so we can safely set it. | |
1635 | ||
1636 | This replaces any read-only SV with a fresh writable copy and removes | |
1637 | any magic. | |
1638 | ||
40bec302 TC |
1639 | =cut |
1640 | */ | |
1641 | ||
f5fa9033 | 1642 | #define ERRSV GvSVn(PL_errgv) |
dfd167e9 | 1643 | |
b4f8d149 | 1644 | /* contains inlined gv_add_by_type */ |
dfd167e9 | 1645 | #define CLEAR_ERRSV() STMT_START { \ |
b4f8d149 DD |
1646 | SV ** const svp = &GvSV(PL_errgv); \ |
1647 | if (!*svp) { \ | |
a1b60c8d | 1648 | *svp = newSVpvs(""); \ |
b4f8d149 DD |
1649 | } else if (SvREADONLY(*svp)) { \ |
1650 | SvREFCNT_dec_NN(*svp); \ | |
b4f8d149 | 1651 | *svp = newSVpvs(""); \ |
dfd167e9 | 1652 | } else { \ |
b4f8d149 | 1653 | SV *const errsv = *svp; \ |
a1b60c8d | 1654 | SvPVCLEAR(errsv); \ |
b4f8d149 | 1655 | SvPOK_only(errsv); \ |
dfd167e9 NC |
1656 | if (SvMAGICAL(errsv)) { \ |
1657 | mg_free(errsv); \ | |
1658 | } \ | |
dfd167e9 NC |
1659 | } \ |
1660 | } STMT_END | |
1661 | ||
933e3e63 TC |
1662 | /* contains inlined gv_add_by_type */ |
1663 | #define SANE_ERRSV() STMT_START { \ | |
1664 | SV ** const svp = &GvSV(PL_errgv); \ | |
1665 | if (!*svp) { \ | |
1666 | *svp = newSVpvs(""); \ | |
1667 | } else if (SvREADONLY(*svp)) { \ | |
1668 | SV *dupsv = newSVsv(*svp); \ | |
1669 | SvREFCNT_dec_NN(*svp); \ | |
1670 | *svp = dupsv; \ | |
1671 | } else { \ | |
1672 | SV *const errsv = *svp; \ | |
1673 | if (SvMAGICAL(errsv)) { \ | |
1674 | mg_free(errsv); \ | |
1675 | } \ | |
1676 | } \ | |
1677 | } STMT_END | |
1678 | ||
dfd167e9 | 1679 | |
414bf5ae MHM |
1680 | #ifdef PERL_CORE |
1681 | # define DEFSV (0 + GvSVn(PL_defgv)) | |
55b5114f FC |
1682 | # define DEFSV_set(sv) \ |
1683 | (SvREFCNT_dec(GvSV(PL_defgv)), GvSV(PL_defgv) = SvREFCNT_inc(sv)) | |
1684 | # define SAVE_DEFSV \ | |
1685 | ( \ | |
1686 | save_gp(PL_defgv, 0), \ | |
1687 | GvINTRO_off(PL_defgv), \ | |
1688 | SAVEGENERICSV(GvSV(PL_defgv)), \ | |
1689 | GvSV(PL_defgv) = NULL \ | |
1690 | ) | |
414bf5ae MHM |
1691 | #else |
1692 | # define DEFSV GvSVn(PL_defgv) | |
55b5114f FC |
1693 | # define DEFSV_set(sv) (GvSV(PL_defgv) = (sv)) |
1694 | # define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv)) | |
414bf5ae | 1695 | #endif |
ed07b037 KW |
1696 | |
1697 | /* | |
3f620621 | 1698 | =for apidoc_section $SV |
ed07b037 KW |
1699 | =for apidoc Amn|SV *|DEFSV |
1700 | Returns the SV associated with C<$_> | |
1701 | ||
1702 | =for apidoc Am|void|DEFSV_set|SV * sv | |
1703 | Associate C<sv> with C<$_> | |
1704 | ||
1705 | =for apidoc Amn|void|SAVE_DEFSV | |
1706 | Localize C<$_>. See L<perlguts/Localizing changes>. | |
1707 | ||
1708 | =cut | |
1709 | */ | |
38a03e6e | 1710 | |
55497cff | 1711 | #ifndef errno |
5ff3f7a4 GS |
1712 | extern int errno; /* ANSI allows errno to be an lvalue expr. |
1713 | * For example in multithreaded environments | |
1714 | * something like this might happen: | |
1715 | * extern int *_errno(void); | |
1716 | * #define errno (*_errno()) */ | |
d9d8d8de | 1717 | #endif |
663a0e37 | 1718 | |
7e996671 KW |
1719 | #define UNKNOWN_ERRNO_MSG "(unknown)" |
1720 | ||
d1747a5a | 1721 | #ifdef VMS |
b21d8587 AC |
1722 | #define Strerror(e) strerror((e), vaxc$errno) |
1723 | #else | |
1724 | #define Strerror(e) strerror(e) | |
35c8bce7 | 1725 | #endif |
663a0e37 | 1726 | |
2304df62 | 1727 | #ifdef I_SYS_IOCTL |
79072805 LW |
1728 | # ifndef _IOCTL_ |
1729 | # include <sys/ioctl.h> | |
1730 | # endif | |
a687059c LW |
1731 | #endif |
1732 | ||
ee0007ab | 1733 | #if defined(mc300) || defined(mc500) || defined(mc700) || defined(mc6000) |
79072805 LW |
1734 | # ifdef HAS_SOCKETPAIR |
1735 | # undef HAS_SOCKETPAIR | |
1736 | # endif | |
2304df62 AD |
1737 | # ifdef I_NDBM |
1738 | # undef I_NDBM | |
79072805 | 1739 | # endif |
a687059c LW |
1740 | #endif |
1741 | ||
02fc2eee NC |
1742 | #ifndef HAS_SOCKETPAIR |
1743 | # ifdef HAS_SOCKET | |
1744 | # define socketpair Perl_my_socketpair | |
1745 | # endif | |
1746 | #endif | |
1747 | ||
a687059c | 1748 | #if INTSIZE == 2 |
79072805 LW |
1749 | # define htoni htons |
1750 | # define ntohi ntohs | |
a687059c | 1751 | #else |
79072805 LW |
1752 | # define htoni htonl |
1753 | # define ntohi ntohl | |
a687059c LW |
1754 | #endif |
1755 | ||
a0d0e21e | 1756 | /* Configure already sets Direntry_t */ |
35c8bce7 | 1757 | #if defined(I_DIRENT) |
da5fdda8 AC |
1758 | # include <dirent.h> |
1759 | #elif defined(I_SYS_NDIR) | |
1760 | # include <sys/ndir.h> | |
1761 | #elif defined(I_SYS_DIR) | |
1762 | # include <sys/dir.h> | |
4633a7c4 | 1763 | #endif |
a687059c | 1764 | |
c623bd54 LW |
1765 | /* |
1766 | * The following gobbledygook brought to you on behalf of __STDC__. | |
1767 | * (I could just use #ifndef __STDC__, but this is more bulletproof | |
1768 | * in the face of half-implementations.) | |
1769 | */ | |
1770 | ||
21e89b5f | 1771 | #if defined(I_SYSMODE) |
ca6e1c26 JH |
1772 | #include <sys/mode.h> |
1773 | #endif | |
1774 | ||
c623bd54 LW |
1775 | #ifndef S_IFMT |
1776 | # ifdef _S_IFMT | |
1777 | # define S_IFMT _S_IFMT | |
1778 | # else | |
1779 | # define S_IFMT 0170000 | |
1780 | # endif | |
1781 | #endif | |
1782 | ||
1783 | #ifndef S_ISDIR | |
1784 | # define S_ISDIR(m) ((m & S_IFMT) == S_IFDIR) | |
1785 | #endif | |
1786 | ||
1787 | #ifndef S_ISCHR | |
1788 | # define S_ISCHR(m) ((m & S_IFMT) == S_IFCHR) | |
1789 | #endif | |
1790 | ||
1791 | #ifndef S_ISBLK | |
fe14fcc3 LW |
1792 | # ifdef S_IFBLK |
1793 | # define S_ISBLK(m) ((m & S_IFMT) == S_IFBLK) | |
1794 | # else | |
1795 | # define S_ISBLK(m) (0) | |
1796 | # endif | |
c623bd54 LW |
1797 | #endif |
1798 | ||
1799 | #ifndef S_ISREG | |
1800 | # define S_ISREG(m) ((m & S_IFMT) == S_IFREG) | |
1801 | #endif | |
1802 | ||
1803 | #ifndef S_ISFIFO | |
fe14fcc3 LW |
1804 | # ifdef S_IFIFO |
1805 | # define S_ISFIFO(m) ((m & S_IFMT) == S_IFIFO) | |
1806 | # else | |
1807 | # define S_ISFIFO(m) (0) | |
1808 | # endif | |
c623bd54 LW |
1809 | #endif |
1810 | ||
1811 | #ifndef S_ISLNK | |
da5fdda8 AC |
1812 | # ifdef _S_ISLNK |
1813 | # define S_ISLNK(m) _S_ISLNK(m) | |
1814 | # elif defined(_S_IFLNK) | |
1815 | # define S_ISLNK(m) ((m & S_IFMT) == _S_IFLNK) | |
1816 | # elif defined(S_IFLNK) | |
1817 | # define S_ISLNK(m) ((m & S_IFMT) == S_IFLNK) | |
1818 | # else | |
1819 | # define S_ISLNK(m) (0) | |
1820 | # endif | |
c623bd54 LW |
1821 | #endif |
1822 | ||
1823 | #ifndef S_ISSOCK | |
da5fdda8 AC |
1824 | # ifdef _S_ISSOCK |
1825 | # define S_ISSOCK(m) _S_ISSOCK(m) | |
1826 | # elif defined(_S_IFSOCK) | |
1827 | # define S_ISSOCK(m) ((m & S_IFMT) == _S_IFSOCK) | |
1828 | # elif defined(S_IFSOCK) | |
1829 | # define S_ISSOCK(m) ((m & S_IFMT) == S_IFSOCK) | |
1830 | # else | |
1831 | # define S_ISSOCK(m) (0) | |
1832 | # endif | |
c623bd54 LW |
1833 | #endif |
1834 | ||
1835 | #ifndef S_IRUSR | |
1836 | # ifdef S_IREAD | |
1837 | # define S_IRUSR S_IREAD | |
1838 | # define S_IWUSR S_IWRITE | |
1839 | # define S_IXUSR S_IEXEC | |
1840 | # else | |
1841 | # define S_IRUSR 0400 | |
1842 | # define S_IWUSR 0200 | |
1843 | # define S_IXUSR 0100 | |
1844 | # endif | |
fac7cdfc | 1845 | #endif |
1846 | ||
1847 | #ifndef S_IRGRP | |
1848 | # ifdef S_IRUSR | |
1849 | # define S_IRGRP (S_IRUSR>>3) | |
1850 | # define S_IWGRP (S_IWUSR>>3) | |
1851 | # define S_IXGRP (S_IXUSR>>3) | |
1852 | # else | |
1853 | # define S_IRGRP 0040 | |
1854 | # define S_IWGRP 0020 | |
1855 | # define S_IXGRP 0010 | |
1856 | # endif | |
1857 | #endif | |
1858 | ||
1859 | #ifndef S_IROTH | |
1860 | # ifdef S_IRUSR | |
1861 | # define S_IROTH (S_IRUSR>>6) | |
1862 | # define S_IWOTH (S_IWUSR>>6) | |
1863 | # define S_IXOTH (S_IXUSR>>6) | |
1864 | # else | |
1865 | # define S_IROTH 0040 | |
1866 | # define S_IWOTH 0020 | |
1867 | # define S_IXOTH 0010 | |
1868 | # endif | |
c623bd54 LW |
1869 | #endif |
1870 | ||
1871 | #ifndef S_ISUID | |
1872 | # define S_ISUID 04000 | |
1873 | #endif | |
1874 | ||
1875 | #ifndef S_ISGID | |
1876 | # define S_ISGID 02000 | |
1877 | #endif | |
1878 | ||
ca6e1c26 JH |
1879 | #ifndef S_IRWXU |
1880 | # define S_IRWXU (S_IRUSR|S_IWUSR|S_IXUSR) | |
d460ef45 | 1881 | #endif |
ca6e1c26 JH |
1882 | |
1883 | #ifndef S_IRWXG | |
1884 | # define S_IRWXG (S_IRGRP|S_IWGRP|S_IXGRP) | |
d460ef45 | 1885 | #endif |
ca6e1c26 JH |
1886 | |
1887 | #ifndef S_IRWXO | |
1888 | # define S_IRWXO (S_IROTH|S_IWOTH|S_IXOTH) | |
d460ef45 | 1889 | #endif |
ca6e1c26 | 1890 | |
b6c36746 | 1891 | /* Haiku R1 seems to define S_IREAD and S_IWRITE in <posix/fcntl.h> |
c21fb2b8 JH |
1892 | * which would get included through <sys/file.h >, but that is 3000 |
1893 | * lines in the future. --jhi */ | |
1894 | ||
b6c36746 | 1895 | #if !defined(S_IREAD) && !defined(__HAIKU__) |
ca6e1c26 JH |
1896 | # define S_IREAD S_IRUSR |
1897 | #endif | |
1898 | ||
b6c36746 | 1899 | #if !defined(S_IWRITE) && !defined(__HAIKU__) |
ca6e1c26 JH |
1900 | # define S_IWRITE S_IWUSR |
1901 | #endif | |
1902 | ||
1903 | #ifndef S_IEXEC | |
1904 | # define S_IEXEC S_IXUSR | |
1905 | #endif | |
1906 | ||
a0d0e21e | 1907 | #if defined(cray) || defined(gould) || defined(i860) || defined(pyr) |
45d8adaa LW |
1908 | # define SLOPPYDIVIDE |
1909 | #endif | |
1910 | ||
748a9306 LW |
1911 | #ifdef UV |
1912 | #undef UV | |
1913 | #endif | |
1914 | ||
f1519f70 AC |
1915 | /* This used to be conditionally defined based on whether we had a sprintf() |
1916 | * that correctly returns the string length (as required by C89), but we no | |
1917 | * longer need that. XS modules can (and do) use this name, so it must remain | |
558a6899 KW |
1918 | * a part of the API that's visible to modules. |
1919 | ||
3f620621 | 1920 | =for apidoc_section $string |
558a6899 KW |
1921 | =for apidoc ATmD|int|my_sprintf|NN char *buffer|NN const char *pat|... |
1922 | ||
1923 | Do NOT use this due to the possibility of overflowing C<buffer>. Instead use | |
1924 | my_snprintf() | |
1925 | ||
1926 | =cut | |
1927 | */ | |
f1519f70 | 1928 | #define my_sprintf sprintf |
ce582cee | 1929 | |
5b692037 JH |
1930 | /* |
1931 | * If we have v?snprintf() and the C99 variadic macros, we can just | |
1932 | * use just the v?snprintf(). It is nice to try to trap the buffer | |
1933 | * overflow, however, so if we are DEBUGGING, and we cannot use the | |
e5afc1ae DD |
1934 | * gcc statement expressions, then use the function wrappers which try |
1935 | * to trap the overflow. If we can use the gcc statement expressions, | |
1936 | * we can try that even with the version that uses the C99 variadic | |
1937 | * macros. | |
5b692037 JH |
1938 | */ |
1939 | ||
1208b3dd | 1940 | /* Note that we do not check against snprintf()/vsnprintf() returning |
4059ba87 AC |
1941 | * negative values because that is non-standard behaviour and we use |
1942 | * snprintf/vsnprintf only iff HAS_VSNPRINTF has been defined, and | |
1943 | * that should be true only if the snprintf()/vsnprintf() are true | |
1944 | * to the standard. */ | |
1208b3dd | 1945 | |
571ee10c | 1946 | #define PERL_SNPRINTF_CHECK(len, max, api) STMT_START { if ((max) > 0 && (Size_t)len > (max)) Perl_croak_nocontext("panic: %s buffer overflow", STRINGIFY(api)); } STMT_END |
e8549682 | 1947 | |
a4eca1d4 JH |
1948 | #ifdef USE_QUADMATH |
1949 | # define my_snprintf Perl_my_snprintf | |
1950 | # define PERL_MY_SNPRINTF_GUARDED | |
4059ba87 | 1951 | #elif defined(HAS_SNPRINTF) && defined(HAS_C99_VARIADIC_MACROS) && !(defined(DEBUGGING) && !defined(PERL_USE_GCC_BRACE_GROUPS)) && !defined(PERL_GCC_PEDANTIC) |
5b692037 | 1952 | # ifdef PERL_USE_GCC_BRACE_GROUPS |
e8549682 | 1953 | # define my_snprintf(buffer, max, ...) ({ int len = snprintf(buffer, max, __VA_ARGS__); PERL_SNPRINTF_CHECK(len, max, snprintf); len; }) |
1208b3dd | 1954 | # define PERL_MY_SNPRINTF_GUARDED |
5b692037 | 1955 | # else |
e8549682 | 1956 | # define my_snprintf(buffer, max, ...) snprintf(buffer, max, __VA_ARGS__) |
5b692037 JH |
1957 | # endif |
1958 | #else | |
1959 | # define my_snprintf Perl_my_snprintf | |
1208b3dd | 1960 | # define PERL_MY_SNPRINTF_GUARDED |
5b692037 JH |
1961 | #endif |
1962 | ||
a4eca1d4 JH |
1963 | /* There is no quadmath_vsnprintf, and therefore my_vsnprintf() |
1964 | * dies if called under USE_QUADMATH. */ | |
4059ba87 | 1965 | #if defined(HAS_VSNPRINTF) && defined(HAS_C99_VARIADIC_MACROS) && !(defined(DEBUGGING) && !defined(PERL_USE_GCC_BRACE_GROUPS)) && !defined(PERL_GCC_PEDANTIC) |
5b692037 | 1966 | # ifdef PERL_USE_GCC_BRACE_GROUPS |
e8549682 | 1967 | # define my_vsnprintf(buffer, max, ...) ({ int len = vsnprintf(buffer, max, __VA_ARGS__); PERL_SNPRINTF_CHECK(len, max, vsnprintf); len; }) |
1208b3dd | 1968 | # define PERL_MY_VSNPRINTF_GUARDED |
5b692037 | 1969 | # else |
e8549682 | 1970 | # define my_vsnprintf(buffer, max, ...) vsnprintf(buffer, max, __VA_ARGS__) |
5b692037 JH |
1971 | # endif |
1972 | #else | |
1973 | # define my_vsnprintf Perl_my_vsnprintf | |
1208b3dd | 1974 | # define PERL_MY_VSNPRINTF_GUARDED |
5b692037 | 1975 | #endif |
d9fad198 | 1976 | |
e8549682 JH |
1977 | /* You will definitely need to use the PERL_MY_SNPRINTF_POST_GUARD() |
1978 | * or PERL_MY_VSNPRINTF_POST_GUARD() if you otherwise decide to ignore | |
1979 | * the result of my_snprintf() or my_vsnprintf(). (No, you should not | |
1980 | * completely ignore it: otherwise you cannot know whether your output | |
1981 | * was too long.) | |
1982 | * | |
1983 | * int len = my_sprintf(buf, max, ...); | |
1984 | * PERL_MY_SNPRINTF_POST_GUARD(len, max); | |
1985 | * | |
1986 | * The trick is that in certain platforms [a] the my_sprintf() already | |
1987 | * contains the sanity check, while in certain platforms [b] it needs | |
1988 | * to be done as a separate step. The POST_GUARD is that step-- in [a] | |
1989 | * platforms the POST_GUARD actually does nothing since the check has | |
1990 | * already been done. Watch out for the max being the same in both calls. | |
1991 | * | |
1992 | * If you actually use the snprintf/vsnprintf return value already, | |
1993 | * you assumedly are checking its validity somehow. But you can | |
1994 | * insert the POST_GUARD() also in that case. */ | |
1995 | ||
1996 | #ifndef PERL_MY_SNPRINTF_GUARDED | |
1997 | # define PERL_MY_SNPRINTF_POST_GUARD(len, max) PERL_SNPRINTF_CHECK(len, max, snprintf) | |
1998 | #else | |
1999 | # define PERL_MY_SNPRINTF_POST_GUARD(len, max) PERL_UNUSED_VAR(len) | |
2000 | #endif | |
2001 | ||
2002 | #ifndef PERL_MY_VSNPRINTF_GUARDED | |
2003 | # define PERL_MY_VSNPRINTF_POST_GUARD(len, max) PERL_SNPRINTF_CHECK(len, max, vsnprintf) | |
2004 | #else | |
2005 | # define PERL_MY_VSNPRINTF_POST_GUARD(len, max) PERL_UNUSED_VAR(len) | |
2006 | #endif | |
2007 | ||
a6cc4119 SP |
2008 | #ifdef HAS_STRLCAT |
2009 | # define my_strlcat strlcat | |
a6cc4119 SP |
2010 | #endif |
2011 | ||
6dba01e2 KW |
2012 | #if defined(PERL_CORE) || defined(PERL_EXT) |
2013 | # ifdef HAS_MEMRCHR | |
2014 | # define my_memrchr memrchr | |
2015 | # else | |
2016 | # define my_memrchr S_my_memrchr | |
2017 | # endif | |
2018 | #endif | |
2019 | ||
a6cc4119 SP |
2020 | #ifdef HAS_STRLCPY |
2021 | # define my_strlcpy strlcpy | |
a6cc4119 SP |
2022 | #endif |
2023 | ||
aefb3fa0 DIM |
2024 | #ifdef HAS_STRNLEN |
2025 | # define my_strnlen strnlen | |
aefb3fa0 DIM |
2026 | #endif |
2027 | ||
05f13f53 | 2028 | /* |
27d4fb96 PP |
2029 | The IV type is supposed to be long enough to hold any integral |
2030 | value or a pointer. | |
2031 | --Andy Dougherty August 1996 | |
2032 | */ | |
2033 | ||
a22e52b9 JH |
2034 | typedef IVTYPE IV; |
2035 | typedef UVTYPE UV; | |
8175356b | 2036 | |
10cc9d2a | 2037 | #if defined(USE_64_BIT_INT) && defined(HAS_QUAD) |
6b8eaf93 | 2038 | # if QUADKIND == QUAD_IS_INT64_T && defined(INT64_MAX) |
bf51a9b9 TC |
2039 | # define IV_MAX ((IV)INT64_MAX) |
2040 | # define IV_MIN ((IV)INT64_MIN) | |
2041 | # define UV_MAX ((UV)UINT64_MAX) | |
cae7ae48 JH |
2042 | # ifndef UINT64_MIN |
2043 | # define UINT64_MIN 0 | |
2044 | # endif | |
bf51a9b9 | 2045 | # define UV_MIN ((UV)UINT64_MIN) |
5ff3f7a4 GS |
2046 | # else |
2047 | # define IV_MAX PERL_QUAD_MAX | |
2048 | # define IV_MIN PERL_QUAD_MIN | |
2049 | # define UV_MAX PERL_UQUAD_MAX | |
2050 | # define UV_MIN PERL_UQUAD_MIN | |
2051 | # endif | |
cf2093f6 JH |
2052 | # define IV_IS_QUAD |
2053 | # define UV_IS_QUAD | |
79072805 | 2054 | #else |
8175356b | 2055 | # if defined(INT32_MAX) && IVSIZE == 4 |
bf51a9b9 TC |
2056 | # define IV_MAX ((IV)INT32_MAX) |
2057 | # define IV_MIN ((IV)INT32_MIN) | |
716026f9 | 2058 | # ifndef UINT32_MAX_BROKEN /* e.g. HP-UX with gcc messes this up */ |
bf51a9b9 | 2059 | # define UV_MAX ((UV)UINT32_MAX) |
716026f9 | 2060 | # else |
bf51a9b9 | 2061 | # define UV_MAX ((UV)4294967295U) |
716026f9 | 2062 | # endif |
cae7ae48 JH |
2063 | # ifndef UINT32_MIN |
2064 | # define UINT32_MIN 0 | |
2065 | # endif | |
bf51a9b9 | 2066 | # define UV_MIN ((UV)UINT32_MIN) |
5ff3f7a4 GS |
2067 | # else |
2068 | # define IV_MAX PERL_LONG_MAX | |
2069 | # define IV_MIN PERL_LONG_MIN | |
2070 | # define UV_MAX PERL_ULONG_MAX | |
2071 | # define UV_MIN PERL_ULONG_MIN | |
2072 | # endif | |
8175356b | 2073 | # if IVSIZE == 8 |
cf2093f6 JH |
2074 | # define IV_IS_QUAD |
2075 | # define UV_IS_QUAD | |
de1c2614 JH |
2076 | # ifndef HAS_QUAD |
2077 | # define HAS_QUAD | |
2078 | # endif | |
cf2093f6 JH |
2079 | # else |
2080 | # undef IV_IS_QUAD | |
2081 | # undef UV_IS_QUAD | |
7adf2470 | 2082 | #if !defined(PERL_CORE) |
e25d460c NC |
2083 | /* We think that removing this decade-old undef this will cause too much |
2084 | breakage on CPAN for too little gain. (See RT #119753) | |
7adf2470 | 2085 | However, we do need HAS_QUAD in the core for use by the drand48 code. */ |
cb4b14d5 | 2086 | # undef HAS_QUAD |
e25d460c | 2087 | #endif |
cf2093f6 | 2088 | # endif |
79072805 | 2089 | #endif |
d7d93a81 | 2090 | |
6313e544 JH |
2091 | #define Size_t_MAX (~(Size_t)0) |
2092 | #define SSize_t_MAX (SSize_t)(~(Size_t)0 >> 1) | |
9a543cee | 2093 | |
cae7ae48 | 2094 | #define IV_DIG (BIT_DIGITS(IVSIZE * 8)) |
22ec83e3 | 2095 | #define UV_DIG (BIT_DIGITS(UVSIZE * 8)) |
56431972 | 2096 | |
28e5dec8 | 2097 | #ifndef NO_PERL_PRESERVE_IVUV |
f5c03d33 | 2098 | #define PERL_PRESERVE_IVUV /* We like our integers to stay integers. */ |
28e5dec8 JH |
2099 | #endif |
2100 | ||
d460ef45 | 2101 | /* |
26bb67e2 JH |
2102 | * The macros INT2PTR and NUM2PTR are (despite their names) |
2103 | * bi-directional: they will convert int/float to or from pointers. | |
2104 | * However the conversion to int/float are named explicitly: | |
2105 | * PTR2IV, PTR2UV, PTR2NV. | |
2106 | * | |
2107 | * For int conversions we do not need two casts if pointers are | |
2108 | * the same size as IV and UV. Otherwise we need an explicit | |
2109 | * cast (PTRV) to avoid compiler warnings. | |
81065b6d KW |
2110 | * |
2111 | * These are mentioned in perlguts | |
26bb67e2 | 2112 | */ |
56431972 RB |
2113 | #if (IVSIZE == PTRSIZE) && (UVSIZE == PTRSIZE) |
2114 | # define PTRV UV | |
2115 | # define INT2PTR(any,d) (any)(d) | |
da5fdda8 AC |
2116 | #elif PTRSIZE == LONGSIZE |
2117 | # define PTRV unsigned long | |
2118 | # define PTR2ul(p) (unsigned long)(p) | |
56431972 | 2119 | #else |
da5fdda8 | 2120 | # define PTRV unsigned |
e91e3b10 RB |
2121 | #endif |
2122 | ||
2123 | #ifndef INT2PTR | |
56431972 | 2124 | # define INT2PTR(any,d) (any)(PTRV)(d) |
42718184 | 2125 | #endif |
e91e3b10 RB |
2126 | |
2127 | #ifndef PTR2ul | |
2128 | # define PTR2ul(p) INT2PTR(unsigned long,p) | |
2129 | #endif | |
2130 | ||
e6cf6753 KW |
2131 | /* |
2132 | =for apidoc_section Casting | |
2133 | =for apidoc Cyh|type|NUM2PTR|type|int value | |
2134 | You probably want to be using L<C</INT2PTR>> instead. | |
2135 | ||
2136 | =cut | |
2137 | */ | |
2138 | ||
56431972 RB |
2139 | #define NUM2PTR(any,d) (any)(PTRV)(d) |
2140 | #define PTR2IV(p) INT2PTR(IV,p) | |
2141 | #define PTR2UV(p) INT2PTR(UV,p) | |
2142 | #define PTR2NV(p) NUM2PTR(NV,p) | |
e91e3b10 | 2143 | #define PTR2nat(p) (PTRV)(p) /* pointer to integer of PTRSIZE */ |
d460ef45 | 2144 | |
8141890a JH |
2145 | /* According to strict ANSI C89 one cannot freely cast between |
2146 | * data pointers and function (code) pointers. There are at least | |
2147 | * two ways around this. One (used below) is to do two casts, | |
2148 | * first the other pointer to an (unsigned) integer, and then | |
2149 | * the integer to the other pointer. The other way would be | |
2150 | * to use unions to "overlay" the pointers. For an example of | |
2151 | * the latter technique, see union dirpu in struct xpvio in sv.h. | |
2152 | * The only feasible use is probably temporarily storing | |
2153 | * function pointers in a data pointer (such as a void pointer). */ | |
2154 | ||
e91e3b10 RB |
2155 | #define DPTR2FPTR(t,p) ((t)PTR2nat(p)) /* data pointer to function pointer */ |
2156 | #define FPTR2DPTR(t,p) ((t)PTR2nat(p)) /* function pointer to data pointer */ | |
8141890a | 2157 | |
65202027 | 2158 | #ifdef USE_LONG_DOUBLE |
f3654d06 JH |
2159 | # if LONG_DOUBLESIZE == DOUBLESIZE |
2160 | # define LONG_DOUBLE_EQUALS_DOUBLE | |
2161 | # undef USE_LONG_DOUBLE /* Ouch! */ | |
65202027 DS |
2162 | # endif |
2163 | #endif | |
2164 | ||
2d4389e4 JH |
2165 | /* The following is all to get LDBL_DIG, in order to pick a nice |
2166 | default value for printing floating point numbers in Gconvert. | |
2167 | (see config.h) | |
2168 | */ | |
63b481b9 | 2169 | #ifndef HAS_LDBL_DIG |
68d4903c | 2170 | # if LONG_DOUBLESIZE == 10 |
63b481b9 AC |
2171 | # define LDBL_DIG 18 /* assume IEEE */ |
2172 | # elif LONG_DOUBLESIZE == 12 | |
68d4903c | 2173 | # define LDBL_DIG 18 /* gcc? */ |
63b481b9 AC |
2174 | # elif LONG_DOUBLESIZE == 16 |
2175 | # define LDBL_DIG 33 /* assume IEEE */ | |
2176 | # elif LONG_DOUBLESIZE == DOUBLESIZE | |
2177 | # define LDBL_DIG DBL_DIG /* bummer */ | |
68d4903c | 2178 | # endif |
2d4389e4 JH |
2179 | #endif |
2180 | ||
48fc6303 | 2181 | /* On MS Windows,with 64-bit mingw-w64 compilers, we |
2182 | need to attend to a __float128 alignment issue if | |
2183 | USE_QUADMATH is defined. Otherwise we simply: | |
2184 | typedef NVTYPE NV | |
2185 | 32-bit mingw.org compilers might also require | |
2186 | aligned(32) - at least that's what I found with my | |
2187 | Math::Foat128 module. But this is as yet untested | |
2188 | here, so no allowance is being made for mingw.org | |
2189 | compilers at this stage. -- sisyphus January 2021 | |
2190 | */ | |
2191 | #if defined(USE_QUADMATH) && defined(__MINGW64__) | |
2192 | /* 64-bit build, mingw-w64 compiler only */ | |
2193 | typedef NVTYPE NV __attribute__ ((aligned(8))); | |
2194 | #else | |
2195 | typedef NVTYPE NV; | |
2196 | #endif | |
8175356b | 2197 | |
792d8dab JH |
2198 | #ifdef I_IEEEFP |
2199 | # include <ieeefp.h> | |
2200 | #endif | |
923fc586 | 2201 | |
bcd8bfa9 JH |
2202 | #if defined(__DECC) && defined(__osf__) |
2203 | /* Also Tru64 cc has broken NaN comparisons. */ | |
2204 | # define NAN_COMPARE_BROKEN | |
c32c3de1 | 2205 | #endif |
6504068e JH |
2206 | #if defined(__sgi) |
2207 | # define NAN_COMPARE_BROKEN | |
2208 | #endif | |
c32c3de1 | 2209 | |
65202027 | 2210 | #ifdef USE_LONG_DOUBLE |
923fc586 JH |
2211 | # ifdef I_SUNMATH |
2212 | # include <sunmath.h> | |
2213 | # endif | |
84e6cb05 | 2214 | # if defined(LDBL_DIG) |
05b4a618 JH |
2215 | # define NV_DIG LDBL_DIG |
2216 | # ifdef LDBL_MANT_DIG | |
2217 | # define NV_MANT_DIG LDBL_MANT_DIG | |
2218 | # endif | |
2219 | # ifdef LDBL_MIN | |
2220 | # define NV_MIN LDBL_MIN | |
2221 | # endif | |
2222 | # ifdef LDBL_MAX | |
2223 | # define NV_MAX LDBL_MAX | |
2224 | # endif | |
2225 | # ifdef LDBL_MIN_EXP | |
2226 | # define NV_MIN_EXP LDBL_MIN_EXP | |
2227 | # endif | |
2228 | # ifdef LDBL_MAX_EXP | |
2229 | # define NV_MAX_EXP LDBL_MAX_EXP | |
2230 | # endif | |
2231 | # ifdef LDBL_MIN_10_EXP | |
2232 | # define NV_MIN_10_EXP LDBL_MIN_10_EXP | |
2233 | # endif | |
2234 | # ifdef LDBL_MAX_10_EXP | |
2235 | # define NV_MAX_10_EXP LDBL_MAX_10_EXP | |
2236 | # endif | |
2237 | # ifdef LDBL_EPSILON | |
2238 | # define NV_EPSILON LDBL_EPSILON | |
2239 | # endif | |
2240 | # ifdef LDBL_MAX | |
2241 | # define NV_MAX LDBL_MAX | |
20f6aaab | 2242 | /* Having LDBL_MAX doesn't necessarily mean that we have LDBL_MIN... -Allen */ |
da5fdda8 AC |
2243 | # elif defined(HUGE_VALL) |
2244 | # define NV_MAX HUGE_VALL | |
f4a14a62 JH |
2245 | # endif |
2246 | # endif | |
84e6cb05 | 2247 | # if defined(HAS_SQRTL) |
8a00eddc JH |
2248 | # define Perl_acos acosl |
2249 | # define Perl_asin asinl | |
2250 | # define Perl_atan atanl | |
940e3d56 JH |
2251 | # define Perl_atan2 atan2l |
2252 | # define Perl_ceil ceill | |
2253 | # define Perl_cos cosl | |
8a00eddc | 2254 | # define Perl_cosh coshl |
940e3d56 | 2255 | # define Perl_exp expl |
55da5e5b | 2256 | /* no Perl_fabs, but there's PERL_ABS */ |
940e3d56 JH |
2257 | # define Perl_floor floorl |
2258 | # define Perl_fmod fmodl | |
2259 | # define Perl_log logl | |
8a00eddc | 2260 | # define Perl_log10 log10l |
940e3d56 JH |
2261 | # define Perl_pow powl |
2262 | # define Perl_sin sinl | |
8a00eddc | 2263 | # define Perl_sinh sinhl |
940e3d56 | 2264 | # define Perl_sqrt sqrtl |
8a00eddc JH |
2265 | # define Perl_tan tanl |
2266 | # define Perl_tanh tanhl | |
68d4903c | 2267 | # endif |
a3540c92 | 2268 | /* e.g. libsunmath doesn't have modfl and frexpl as of mid-March 2000 */ |
05b4a618 JH |
2269 | # ifndef Perl_modf |
2270 | # ifdef HAS_MODFL | |
2271 | # define Perl_modf(x,y) modfl(x,y) | |
51997bc3 NC |
2272 | /* eg glibc 2.2 series seems to provide modfl on ppc and arm, but has no |
2273 | prototype in <math.h> */ | |
05b4a618 | 2274 | # ifndef HAS_MODFL_PROTO |
a221a8a5 | 2275 | EXTERN_C long double modfl(long double, long double *); |
05b4a618 JH |
2276 | # endif |
2277 | # elif (defined(HAS_TRUNCL) || defined(HAS_AINTL)) && defined(HAS_COPYSIGNL) | |
55954f19 | 2278 | extern long double Perl_my_modfl(long double x, long double *ip); |
03476e8e | 2279 | # define Perl_modf(x,y) Perl_my_modfl(x,y) |
05b4a618 | 2280 | # endif |
a3540c92 | 2281 | # endif |
05b4a618 JH |
2282 | # ifndef Perl_frexp |
2283 | # ifdef HAS_FREXPL | |
2284 | # define Perl_frexp(x,y) frexpl(x,y) | |
da5fdda8 | 2285 | # elif defined(HAS_ILOGBL) && defined(HAS_SCALBNL) |
05b4a618 | 2286 | extern long double Perl_my_frexpl(long double x, int *e); |
da5fdda8 | 2287 | # define Perl_frexp(x,y) Perl_my_frexpl(x,y) |
03476e8e | 2288 | # endif |
a3540c92 | 2289 | # endif |
05b4a618 JH |
2290 | # ifndef Perl_ldexp |
2291 | # ifdef HAS_LDEXPL | |
2292 | # define Perl_ldexp(x, y) ldexpl(x,y) | |
da5fdda8 AC |
2293 | # elif defined(HAS_SCALBNL) && FLT_RADIX == 2 |
2294 | # define Perl_ldexp(x,y) scalbnl(x,y) | |
98181445 JH |
2295 | # endif |
2296 | # endif | |
38dbb4c5 | 2297 | # ifndef Perl_isnan |
e4c957f4 | 2298 | # if defined(HAS_ISNANL) && !(defined(isnan) && defined(HAS_C99)) |
758a5d79 | 2299 | # define Perl_isnan(x) isnanl(x) |
a1115378 JH |
2300 | # elif defined(__sgi) && defined(__c99) /* XXX Configure test needed */ |
2301 | # define Perl_isnan(x) isnan(x) | |
758a5d79 JH |
2302 | # endif |
2303 | # endif | |
2304 | # ifndef Perl_isinf | |
e4c957f4 | 2305 | # if defined(HAS_ISINFL) && !(defined(isinf) && defined(HAS_C99)) |
87190886 | 2306 | # define Perl_isinf(x) isinfl(x) |
a1115378 JH |
2307 | # elif defined(__sgi) && defined(__c99) /* XXX Configure test needed */ |
2308 | # define Perl_isinf(x) isinf(x) | |
bcd8bfa9 | 2309 | # elif defined(LDBL_MAX) && !defined(NAN_COMPARE_BROKEN) |
efcbf317 | 2310 | # define Perl_isinf(x) ((x) > LDBL_MAX || (x) < -LDBL_MAX) |
a3540c92 JH |
2311 | # endif |
2312 | # endif | |
e38461cc JH |
2313 | # ifndef Perl_isfinite |
2314 | # define Perl_isfinite(x) Perl_isfinitel(x) | |
2315 | # endif | |
84e6cb05 JH |
2316 | #elif defined(USE_QUADMATH) && defined(I_QUADMATH) |
2317 | # include <quadmath.h> | |
2318 | # define NV_DIG FLT128_DIG | |
2319 | # define NV_MANT_DIG FLT128_MANT_DIG | |
2320 | # define NV_MIN FLT128_MIN | |
2321 | # define NV_MAX FLT128_MAX | |
2322 | # define NV_MIN_EXP FLT128_MIN_EXP | |
2323 | # define NV_MAX_EXP FLT128_MAX_EXP | |
2324 | # define NV_EPSILON FLT128_EPSILON | |
2325 | # define NV_MIN_10_EXP FLT128_MIN_10_EXP | |
2326 | # define NV_MAX_10_EXP FLT128_MAX_10_EXP | |
84e6cb05 JH |
2327 | # define Perl_acos acosq |
2328 | # define Perl_asin asinq | |
2329 | # define Perl_atan atanq | |
2330 | # define Perl_atan2 atan2q | |
2331 | # define Perl_ceil ceilq | |
2332 | # define Perl_cos cosq | |
2333 | # define Perl_cosh coshq | |
2334 | # define Perl_exp expq | |
2335 | /* no Perl_fabs, but there's PERL_ABS */ | |
2336 | # define Perl_floor floorq | |
2337 | # define Perl_fmod fmodq | |
2338 | # define Perl_log logq | |
2339 | # define Perl_log10 log10q | |
e6081c0e | 2340 | # define Perl_signbit signbitq |
84e6cb05 JH |
2341 | # define Perl_pow powq |
2342 | # define Perl_sin sinq | |
2343 | # define Perl_sinh sinhq | |
2344 | # define Perl_sqrt sqrtq | |
2345 | # define Perl_tan tanq | |
2346 | # define Perl_tanh tanhq | |
2347 | # define Perl_modf(x,y) modfq(x,y) | |
2348 | # define Perl_frexp(x,y) frexpq(x,y) | |
2349 | # define Perl_ldexp(x, y) ldexpq(x,y) | |
2350 | # define Perl_isinf(x) isinfq(x) | |
2351 | # define Perl_isnan(x) isnanq(x) | |
2352 | # define Perl_isfinite(x) !(isnanq(x) || isinfq(x)) | |
b28053d1 JH |
2353 | # define Perl_fp_class(x) ((x) == 0.0Q ? 0 : isinfq(x) ? 3 : isnanq(x) ? 4 : PERL_ABS(x) < FLT128_MIN ? 2 : 1) |
2354 | # define Perl_fp_class_inf(x) (Perl_fp_class(x) == 3) | |
2355 | # define Perl_fp_class_nan(x) (Perl_fp_class(x) == 4) | |
2356 | # define Perl_fp_class_norm(x) (Perl_fp_class(x) == 1) | |
2357 | # define Perl_fp_class_denorm(x) (Perl_fp_class(x) == 2) | |
2358 | # define Perl_fp_class_zero(x) (Perl_fp_class(x) == 0) | |
65202027 | 2359 | #else |
2d4389e4 | 2360 | # define NV_DIG DBL_DIG |
63b481b9 AC |
2361 | # define NV_MANT_DIG DBL_MANT_DIG |
2362 | # define NV_MIN DBL_MIN | |
2363 | # define NV_MAX DBL_MAX | |
2364 | # define NV_MIN_EXP DBL_MIN_EXP | |
2365 | # define NV_MAX_EXP DBL_MAX_EXP | |
2366 | # define NV_MIN_10_EXP DBL_MIN_10_EXP | |
2367 | # define NV_MAX_10_EXP DBL_MAX_10_EXP | |
2368 | # define NV_EPSILON DBL_EPSILON | |
2369 | # define NV_MAX DBL_MAX | |
2370 | # define NV_MIN DBL_MIN | |
940e3d56 | 2371 | |
55da5e5b | 2372 | /* These math interfaces are C89. */ |
8a00eddc JH |
2373 | # define Perl_acos acos |
2374 | # define Perl_asin asin | |
2375 | # define Perl_atan atan | |
940e3d56 JH |
2376 | # define Perl_atan2 atan2 |
2377 | # define Perl_ceil ceil | |
2378 | # define Perl_cos cos | |
8a00eddc | 2379 | # define Perl_cosh cosh |
940e3d56 | 2380 | # define Perl_exp exp |
55da5e5b | 2381 | /* no Perl_fabs, but there's PERL_ABS */ |
940e3d56 JH |
2382 | # define Perl_floor floor |
2383 | # define Perl_fmod fmod | |
2384 | # define Perl_log log | |
8a00eddc | 2385 | # define Perl_log10 log10 |
940e3d56 JH |
2386 | # define Perl_pow pow |
2387 | # define Perl_sin sin | |
8a00eddc | 2388 | # define Perl_sinh sinh |
940e3d56 | 2389 | # define Perl_sqrt sqrt |
8a00eddc JH |
2390 | # define Perl_tan tan |
2391 | # define Perl_tanh tanh | |
940e3d56 JH |
2392 | |
2393 | # define Perl_modf(x,y) modf(x,y) | |
2394 | # define Perl_frexp(x,y) frexp(x,y) | |
2395 | # define Perl_ldexp(x,y) ldexp(x,y) | |
2396 | ||
1a322af2 JH |
2397 | # ifndef Perl_isnan |
2398 | # ifdef HAS_ISNAN | |
2399 | # define Perl_isnan(x) isnan(x) | |
2400 | # endif | |
2401 | # endif | |
2402 | # ifndef Perl_isinf | |
2403 | # if defined(HAS_ISINF) | |
2404 | # define Perl_isinf(x) isinf(x) | |
bcd8bfa9 | 2405 | # elif defined(DBL_MAX) && !defined(NAN_COMPARE_BROKEN) |
efcbf317 | 2406 | # define Perl_isinf(x) ((x) > DBL_MAX || (x) < -DBL_MAX) |
1a322af2 JH |
2407 | # endif |
2408 | # endif | |
2409 | # ifndef Perl_isfinite | |
2410 | # ifdef HAS_ISFINITE | |
2411 | # define Perl_isfinite(x) isfinite(x) | |
2412 | # elif defined(HAS_FINITE) | |
2413 | # define Perl_isfinite(x) finite(x) | |
2414 | # endif | |
2415 | # endif | |
758a5d79 JH |
2416 | #endif |
2417 | ||
30404d48 JH |
2418 | /* fpclassify(): C99. It is supposed to be a macro that switches on |
2419 | * the sizeof() of its argument, so there's no need for e.g. fpclassifyl().*/ | |
2420 | #if !defined(Perl_fp_class) && defined(HAS_FPCLASSIFY) | |
2421 | # include <math.h> | |
25c46df8 JH |
2422 | # if defined(FP_INFINITE) && defined(FP_NAN) |
2423 | # define Perl_fp_class(x) fpclassify(x) | |
2424 | # define Perl_fp_class_inf(x) (Perl_fp_class(x)==FP_INFINITE) | |
2425 | # define Perl_fp_class_nan(x) (Perl_fp_class(x)==FP_NAN) | |
2426 | # define Perl_fp_class_norm(x) (Perl_fp_class(x)==FP_NORMAL) | |
2427 | # define Perl_fp_class_denorm(x) (Perl_fp_class(x)==FP_SUBNORMAL) | |
2428 | # define Perl_fp_class_zero(x) (Perl_fp_class(x)==FP_ZERO) | |
2429 | # elif defined(FP_PLUS_INF) && defined(FP_QNAN) | |
2430 | /* Some versions of HP-UX (10.20) have (only) fpclassify() but which is | |
2431 | * actually not the C99 fpclassify, with its own set of return defines. */ | |
2432 | # define Perl_fp_class(x) fpclassify(x) | |
2433 | # define Perl_fp_class_pinf(x) (Perl_fp_class(x)==FP_PLUS_INF) | |
2434 | # define Perl_fp_class_ninf(x) (Perl_fp_class(x)==FP_MINUS_INF) | |
82947af8 | 2435 | # define Perl_fp_class_snan(x) (Perl_fp_class(x)==FP_SNAN) |
25c46df8 JH |
2436 | # define Perl_fp_class_qnan(x) (Perl_fp_class(x)==FP_QNAN) |
2437 | # define Perl_fp_class_pnorm(x) (Perl_fp_class(x)==FP_PLUS_NORM) | |
1ae51000 | 2438 | # define Perl_fp_class_nnorm(x) (Perl_fp_class(x)==FP_MINUS_NORM) |
25c46df8 JH |
2439 | # define Perl_fp_class_pdenorm(x) (Perl_fp_class(x)==FP_PLUS_DENORM) |
2440 | # define Perl_fp_class_ndenorm(x) (Perl_fp_class(x)==FP_MINUS_DENORM) | |
2441 | # define Perl_fp_class_pzero(x) (Perl_fp_class(x)==FP_PLUS_ZERO) | |
2442 | # define Perl_fp_class_nzero(x) (Perl_fp_class(x)==FP_MINUS_ZERO) | |
2443 | # else | |
2444 | # undef Perl_fp_class /* Unknown set of defines */ | |
2445 | # endif | |
30404d48 JH |
2446 | #endif |
2447 | ||
25c46df8 JH |
2448 | /* fp_classify(): Legacy: VMS, maybe Unicos? The values, however, |
2449 | * are identical to the C99 fpclassify(). */ | |
2450 | #if !defined(Perl_fp_class) && defined(HAS_FP_CLASSIFY) | |
2451 | # include <math.h> | |
558f3e66 CB |
2452 | # ifdef __VMS |
2453 | /* FP_INFINITE and others are here rather than in math.h as C99 stipulates */ | |
2454 | # include <fp.h> | |
56610b8f CB |
2455 | /* oh, and the isnormal macro has a typo in it! */ |
2456 | # undef isnormal | |
2457 | # define isnormal(x) Perl_fp_class_norm(x) | |
558f3e66 | 2458 | # endif |
25c46df8 JH |
2459 | # if defined(FP_INFINITE) && defined(FP_NAN) |
2460 | # define Perl_fp_class(x) fp_classify(x) | |
2461 | # define Perl_fp_class_inf(x) (Perl_fp_class(x)==FP_INFINITE) | |
2462 | # define Perl_fp_class_nan(x) (Perl_fp_class(x)==FP_NAN) | |
2463 | # define Perl_fp_class_norm(x) (Perl_fp_class(x)==FP_NORMAL) | |
2464 | # define Perl_fp_class_denorm(x) (Perl_fp_class(x)==FP_SUBNORMAL) | |
2465 | # define Perl_fp_class_zero(x) (Perl_fp_class(x)==FP_ZERO) | |
2466 | # else | |
2467 | # undef Perl_fp_class /* Unknown set of defines */ | |
2468 | # endif | |
f279e099 | 2469 | #endif |
205f51d8 | 2470 | |
30404d48 JH |
2471 | /* Feel free to check with me for the SGI manpages, SGI testing, |
2472 | * etcetera, if you want to try getting this to work with IRIX. | |
2473 | * | |
2474 | * - Allen <allens@cpan.org> */ | |
2475 | ||
2476 | /* fpclass(): SysV, at least Solaris and some versions of IRIX. */ | |
758a5d79 | 2477 | #if !defined(Perl_fp_class) && (defined(HAS_FPCLASS)||defined(HAS_FPCLASSL)) |
25c46df8 JH |
2478 | /* Solaris and IRIX have fpclass/fpclassl, but they are using |
2479 | * an enum typedef, not cpp symbols, and Configure doesn't detect that. | |
2480 | * Define some symbols also as cpp symbols so we can detect them. */ | |
033a6f7a | 2481 | # if defined(__sun) || defined(__sgi) /* XXX Configure test instead */ |
25c46df8 JH |
2482 | # define FP_PINF FP_PINF |
2483 | # define FP_QNAN FP_QNAN | |
2484 | # endif | |
f279e099 | 2485 | # include <math.h> |
68ad61f5 | 2486 | # ifdef I_IEEEFP |
758a5d79 JH |
2487 | # include <ieeefp.h> |
2488 | # endif | |
2489 | # ifdef I_FP | |
2490 | # include <fp.h> | |
2491 | # endif | |
2492 | # if defined(USE_LONG_DOUBLE) && defined(HAS_FPCLASSL) | |
f279e099 | 2493 | # define Perl_fp_class(x) fpclassl(x) |
758a5d79 | 2494 | # else |
f279e099 JH |
2495 | # define Perl_fp_class(x) fpclass(x) |
2496 | # endif | |
25c46df8 | 2497 | # if defined(FP_CLASS_PINF) && defined(FP_CLASS_SNAN) |
f279e099 JH |
2498 | # define Perl_fp_class_snan(x) (Perl_fp_class(x)==FP_CLASS_SNAN) |
2499 | # define Perl_fp_class_qnan(x) (Perl_fp_class(x)==FP_CLASS_QNAN) | |
2500 | # define Perl_fp_class_ninf(x) (Perl_fp_class(x)==FP_CLASS_NINF) | |
2501 | # define Perl_fp_class_pinf(x) (Perl_fp_class(x)==FP_CLASS_PINF) | |
2502 | # define Perl_fp_class_nnorm(x) (Perl_fp_class(x)==FP_CLASS_NNORM) | |
2503 | # define Perl_fp_class_pnorm(x) (Perl_fp_class(x)==FP_CLASS_PNORM) | |
2504 | # define Perl_fp_class_ndenorm(x) (Perl_fp_class(x)==FP_CLASS_NDENORM) | |
2505 | # define Perl_fp_class_pdenorm(x) (Perl_fp_class(x)==FP_CLASS_PDENORM) | |
2506 | # define Perl_fp_class_nzero(x) (Perl_fp_class(x)==FP_CLASS_NZERO) | |
2507 | # define Perl_fp_class_pzero(x) (Perl_fp_class(x)==FP_CLASS_PZERO) | |
25c46df8 | 2508 | # elif defined(FP_PINF) && defined(FP_QNAN) |
f279e099 JH |
2509 | # define Perl_fp_class_snan(x) (Perl_fp_class(x)==FP_SNAN) |
2510 | # define Perl_fp_class_qnan(x) (Perl_fp_class(x)==FP_QNAN) | |
2511 | # define Perl_fp_class_ninf(x) (Perl_fp_class(x)==FP_NINF) | |
2512 | # define Perl_fp_class_pinf(x) (Perl_fp_class(x)==FP_PINF) | |
2513 | # define Perl_fp_class_nnorm(x) (Perl_fp_class(x)==FP_NNORM) | |
2514 | # define Perl_fp_class_pnorm(x) (Perl_fp_class(x)==FP_PNORM) | |
2515 | # define Perl_fp_class_ndenorm(x) (Perl_fp_class(x)==FP_NDENORM) | |
2516 | # define Perl_fp_class_pdenorm(x) (Perl_fp_class(x)==FP_PDENORM) | |
2517 | # define Perl_fp_class_nzero(x) (Perl_fp_class(x)==FP_NZERO) | |
2518 | # define Perl_fp_class_pzero(x) (Perl_fp_class(x)==FP_PZERO) | |
25c46df8 JH |
2519 | # else |
2520 | # undef Perl_fp_class /* Unknown set of defines */ | |
758a5d79 | 2521 | # endif |
758a5d79 JH |
2522 | #endif |
2523 | ||
30404d48 JH |
2524 | /* fp_class(): Legacy: at least Tru64, some versions of IRIX. */ |
2525 | #if !defined(Perl_fp_class) && (defined(HAS_FP_CLASS)||defined(HAS_FP_CLASSL)) | |
758a5d79 JH |
2526 | # include <math.h> |
2527 | # if !defined(FP_SNAN) && defined(I_FP_CLASS) | |
2528 | # include <fp_class.h> | |
2529 | # endif | |
25c46df8 | 2530 | # if defined(FP_POS_INF) && defined(FP_QNAN) |
033a6f7a | 2531 | # ifdef __sgi /* XXX Configure test instead */ |
25c46df8 JH |
2532 | # ifdef USE_LONG_DOUBLE |
2533 | # define Perl_fp_class(x) fp_class_l(x) | |
2534 | # else | |
2535 | # define Perl_fp_class(x) fp_class_d(x) | |
2536 | # endif | |
f279e099 | 2537 | # else |
25c46df8 JH |
2538 | # if defined(USE_LONG_DOUBLE) && defined(HAS_FP_CLASSL) |
2539 | # define Perl_fp_class(x) fp_classl(x) | |
2540 | # else | |
2541 | # define Perl_fp_class(x) fp_class(x) | |
2542 | # endif | |
f279e099 | 2543 | # endif |
25c46df8 JH |
2544 | # if defined(FP_POS_INF) && defined(FP_QNAN) |
2545 | # define Perl_fp_class_snan(x) (Perl_fp_class(x)==FP_SNAN) | |
2546 | # define Perl_fp_class_qnan(x) (Perl_fp_class(x)==FP_QNAN) | |
2547 | # define Perl_fp_class_ninf(x) (Perl_fp_class(x)==FP_NEG_INF) | |
2548 | # define Perl_fp_class_pinf(x) (Perl_fp_class(x)==FP_POS_INF) | |
2549 | # define Perl_fp_class_nnorm(x) (Perl_fp_class(x)==FP_NEG_NORM) | |
2550 | # define Perl_fp_class_pnorm(x) (Perl_fp_class(x)==FP_POS_NORM) | |
2551 | # define Perl_fp_class_ndenorm(x) (Perl_fp_class(x)==FP_NEG_DENORM) | |
2552 | # define Perl_fp_class_pdenorm(x) (Perl_fp_class(x)==FP_POS_DENORM) | |
2553 | # define Perl_fp_class_nzero(x) (Perl_fp_class(x)==FP_NEG_ZERO) | |
2554 | # define Perl_fp_class_pzero(x) (Perl_fp_class(x)==FP_POS_ZERO) | |
30404d48 | 2555 | # else |
25c46df8 | 2556 | # undef Perl_fp_class /* Unknown set of defines */ |
30404d48 | 2557 | # endif |
f279e099 | 2558 | # endif |
30404d48 JH |
2559 | #endif |
2560 | ||
052758ae | 2561 | /* class(), _class(): Legacy: AIX. */ |
758a5d79 JH |
2562 | #if !defined(Perl_fp_class) && defined(HAS_CLASS) |
2563 | # include <math.h> | |
25c46df8 JH |
2564 | # if defined(FP_PLUS_NORM) && defined(FP_PLUS_INF) |
2565 | # ifndef _cplusplus | |
2566 | # define Perl_fp_class(x) class(x) | |
2567 | # else | |
2568 | # define Perl_fp_class(x) _class(x) | |
2569 | # endif | |
2570 | # if defined(FP_PLUS_INF) && defined(FP_NANQ) | |
2571 | # define Perl_fp_class_snan(x) (Perl_fp_class(x)==FP_NANS) | |
2572 | # define Perl_fp_class_qnan(x) (Perl_fp_class(x)==FP_NANQ) | |
2573 | # define Perl_fp_class_ninf(x) (Perl_fp_class(x)==FP_MINUS_INF) | |
2574 | # define Perl_fp_class_pinf(x) (Perl_fp_class(x)==FP_PLUS_INF) | |
2575 | # define Perl_fp_class_nnorm(x) (Perl_fp_class(x)==FP_MINUS_NORM) | |
2576 | # define Perl_fp_class_pnorm(x) (Perl_fp_class(x)==FP_PLUS_NORM) | |
2577 | # define Perl_fp_class_ndenorm(x) (Perl_fp_class(x)==FP_MINUS_DENORM) | |
2578 | # define Perl_fp_class_pdenorm(x) (Perl_fp_class(x)==FP_PLUS_DENORM) | |
2579 | # define Perl_fp_class_nzero(x) (Perl_fp_class(x)==FP_MINUS_ZERO) | |
2580 | # define Perl_fp_class_pzero(x) (Perl_fp_class(x)==FP_PLUS_ZERO) | |
2581 | # else | |
2582 | # undef Perl_fp_class /* Unknown set of defines */ | |
2583 | # endif | |
758a5d79 | 2584 | # endif |
30404d48 JH |
2585 | #endif |
2586 | ||
2587 | /* Win32: _fpclass(), _isnan(), _finite(). */ | |
90f54b14 | 2588 | #ifdef _MSC_VER |
796ea9ea JH |
2589 | # ifndef Perl_isnan |
2590 | # define Perl_isnan(x) _isnan(x) | |
2591 | # endif | |
2592 | # ifndef Perl_isfinite | |
2593 | # define Perl_isfinite(x) _finite(x) | |
2594 | # endif | |
2595 | # ifndef Perl_fp_class_snan | |
25c46df8 JH |
2596 | /* No simple way to #define Perl_fp_class because _fpclass() |
2597 | * returns a set of bits. */ | |
796ea9ea JH |
2598 | # define Perl_fp_class_snan(x) (_fpclass(x) & _FPCLASS_SNAN) |
2599 | # define Perl_fp_class_qnan(x) (_fpclass(x) & _FPCLASS_QNAN) | |
82947af8 | 2600 | # define Perl_fp_class_nan(x) (_fpclass(x) & (_FPCLASS_SNAN|_FPCLASS_QNAN)) |
d74c13c0 KW |
2601 | # define Perl_fp_class_ninf(x) (_fpclass(x) & _FPCLASS_NINF) |
2602 | # define Perl_fp_class_pinf(x) (_fpclass(x) & _FPCLASS_PINF) | |
796ea9ea JH |
2603 | # define Perl_fp_class_inf(x) (_fpclass(x) & (_FPCLASS_NINF|_FPCLASS_PINF)) |
2604 | # define Perl_fp_class_nnorm(x) (_fpclass(x) & _FPCLASS_NN) | |
2605 | # define Perl_fp_class_pnorm(x) (_fpclass(x) & _FPCLASS_PN) | |
2606 | # define Perl_fp_class_norm(x) (_fpclass(x) & (_FPCLASS_NN|_FPCLASS_PN)) | |
2607 | # define Perl_fp_class_ndenorm(x) (_fpclass(x) & _FPCLASS_ND) | |
2608 | # define Perl_fp_class_pdenorm(x) (_fpclass(x) & _FPCLASS_PD) | |
2609 | # define Perl_fp_class_denorm(x) (_fpclass(x) & (_FPCLASS_ND|_FPCLASS_PD)) | |
2610 | # define Perl_fp_class_nzero(x) (_fpclass(x) & _FPCLASS_NZ) | |
2611 | # define Perl_fp_class_pzero(x) (_fpclass(x) & _FPCLASS_PZ) | |
2612 | # define Perl_fp_class_zero(x) (_fpclass(x) & (_FPCLASS_NZ|_FPCLASS_PZ)) | |
2613 | # endif | |
f279e099 JH |
2614 | #endif |
2615 | ||
2616 | #if !defined(Perl_fp_class_inf) && \ | |
2617 | defined(Perl_fp_class_pinf) && defined(Perl_fp_class_ninf) | |
2618 | # define Perl_fp_class_inf(x) \ | |
2619 | (Perl_fp_class_pinf(x) || Perl_fp_class_ninf(x)) | |
2620 | #endif | |
2621 | ||
2622 | #if !defined(Perl_fp_class_nan) && \ | |
2623 | defined(Perl_fp_class_snan) && defined(Perl_fp_class_qnan) | |
2624 | # define Perl_fp_class_nan(x) \ | |
2625 | (Perl_fp_class_snan(x) || Perl_fp_class_qnan(x)) | |
2626 | #endif | |
2627 | ||
2628 | #if !defined(Perl_fp_class_zero) && \ | |
2629 | defined(Perl_fp_class_pzero) && defined(Perl_fp_class_nzero) | |
2630 | # define Perl_fp_class_zero(x) \ | |
2631 | (Perl_fp_class_pzero(x) || Perl_fp_class_nzero(x)) | |
2632 | #endif | |
2633 | ||
2634 | #if !defined(Perl_fp_class_norm) && \ | |
2635 | defined(Perl_fp_class_pnorm) && defined(Perl_fp_class_nnorm) | |
2636 | # define Perl_fp_class_norm(x) \ | |
2637 | (Perl_fp_class_pnorm(x) || Perl_fp_class_nnorm(x)) | |
2638 | #endif | |
2639 | ||
2640 | #if !defined(Perl_fp_class_denorm) && \ | |
2641 | defined(Perl_fp_class_pdenorm) && defined(Perl_fp_class_ndenorm) | |
2642 | # define Perl_fp_class_denorm(x) \ | |
2643 | (Perl_fp_class_pdenorm(x) || Perl_fp_class_ndenorm(x)) | |
796ea9ea | 2644 | #endif |
758a5d79 JH |
2645 | |
2646 | #ifndef Perl_isnan | |
1a322af2 JH |
2647 | # ifdef Perl_fp_class_nan |
2648 | # define Perl_isnan(x) Perl_fp_class_nan(x) | |
da5fdda8 AC |
2649 | # elif defined(HAS_UNORDERED) |
2650 | # define Perl_isnan(x) unordered((x), 0.0) | |
758a5d79 | 2651 | # else |
da5fdda8 | 2652 | # define Perl_isnan(x) ((x)!=(x)) |
758a5d79 JH |
2653 | # endif |
2654 | #endif | |
2655 | ||
1a322af2 JH |
2656 | #ifndef Perl_isinf |
2657 | # ifdef Perl_fp_class_inf | |
2658 | # define Perl_isinf(x) Perl_fp_class_inf(x) | |
2659 | # endif | |
ca6c63e1 JH |
2660 | #endif |
2661 | ||
758a5d79 | 2662 | #ifndef Perl_isfinite |
25c46df8 | 2663 | # if defined(HAS_ISFINITE) && !defined(isfinite) |
c496ca58 | 2664 | # define Perl_isfinite(x) isfinite((double)(x)) |
4efd38a4 | 2665 | # elif defined(HAS_FINITE) |
c496ca58 | 2666 | # define Perl_isfinite(x) finite((double)(x)) |
4efd38a4 JH |
2667 | # elif defined(Perl_fp_class_finite) |
2668 | # define Perl_isfinite(x) Perl_fp_class_finite(x) | |
758a5d79 | 2669 | # else |
c496ca58 JH |
2670 | /* For the infinities the multiplication returns nan, |
2671 | * for the nan the multiplication also returns nan, | |
2672 | * for everything else (that is, finite) zero should be returned. */ | |
4efd38a4 | 2673 | # define Perl_isfinite(x) (((x) * 0) == 0) |
a3540c92 | 2674 | # endif |
65202027 DS |
2675 | #endif |
2676 | ||
25c46df8 JH |
2677 | #ifndef Perl_isinf |
2678 | # if defined(Perl_isfinite) && defined(Perl_isnan) | |
2679 | # define Perl_isinf(x) !(Perl_isfinite(x)||Perl_isnan(x)) | |
2680 | # endif | |
2681 | #endif | |
2682 | ||
d3685250 JH |
2683 | /* We need Perl_isfinitel (ends with ell) (if available) even when |
2684 | * not USE_LONG_DOUBLE because the printf code (sv_catpvfn_flags) | |
2685 | * needs that. */ | |
2686 | #if defined(HAS_LONG_DOUBLE) && !defined(Perl_isfinitel) | |
2687 | /* If isfinite() is a macro and looks like we have C99, | |
2688 | * we assume it's the type-aware C99 isfinite(). */ | |
c06e9e3e | 2689 | # if defined(HAS_ISFINITE) && defined(isfinite) && defined(HAS_C99) |
d3685250 JH |
2690 | # define Perl_isfinitel(x) isfinite(x) |
2691 | # elif defined(HAS_ISFINITEL) | |
2692 | # define Perl_isfinitel(x) isfinitel(x) | |
2693 | # elif defined(HAS_FINITEL) | |
2694 | # define Perl_isfinitel(x) finitel(x) | |
68ad61f5 | 2695 | # elif defined(HAS_ISINFL) && defined(HAS_ISNANL) |
d3685250 | 2696 | # define Perl_isfinitel(x) !(isinfl(x)||isnanl(x)) |
16334e6e | 2697 | # else |
99bf9e32 | 2698 | # define Perl_isfinitel(x) ((x) * 0 == 0) /* See Perl_isfinite. */ |
d3685250 JH |
2699 | # endif |
2700 | #endif | |
2701 | ||
a36244b7 JH |
2702 | /* The default is to use Perl's own atof() implementation (in numeric.c). |
2703 | * Usually that is the one to use but for some platforms (e.g. UNICOS) | |
2704 | * it is however best to use the native implementation of atof. | |
2705 | * You can experiment with using your native one by -DUSE_PERL_ATOF=0. | |
2706 | * Some good tests to try out with either setting are t/base/num.t, | |
205f51d8 AS |
2707 | * t/op/numconvert.t, and t/op/pack.t. Note that if using long doubles |
2708 | * you may need to be using a different function than atof! */ | |
a36244b7 JH |
2709 | |
2710 | #ifndef USE_PERL_ATOF | |
2711 | # ifndef _UNICOS | |
2712 | # define USE_PERL_ATOF | |
2713 | # endif | |
2714 | #else | |
2715 | # if USE_PERL_ATOF == 0 | |
2716 | # undef USE_PERL_ATOF | |
2717 | # endif | |
2718 | #endif | |
2719 | ||
2720 | #ifdef USE_PERL_ATOF | |
2721 | # define Perl_atof(s) Perl_my_atof(s) | |
6928bedc | 2722 | # define Perl_atof2(s, n) Perl_my_atof3(aTHX_ (s), &(n), 0) |
a36244b7 JH |
2723 | #else |
2724 | # define Perl_atof(s) (NV)atof(s) | |
2725 | # define Perl_atof2(s, n) ((n) = atof(s)) | |
2726 | #endif | |
6928bedc | 2727 | #define my_atof2(a,b) my_atof3(a,b,0) |
cf2093f6 | 2728 | |
99abf803 | 2729 | /* |
37dee3fa KW |
2730 | =for apidoc_section $numeric |
2731 | =for apidoc AmT|NV|Perl_acos|NV x | |
2732 | =for apidoc_item |NV|Perl_asin|NV x | |
2733 | =for apidoc_item |NV|Perl_atan|NV x | |
2734 | =for apidoc_item |NV|Perl_atan2|NV x|NV y | |
2735 | =for apidoc_item |NV|Perl_ceil|NV x | |
2736 | =for apidoc_item |NV|Perl_cos|NV x | |
2737 | =for apidoc_item |NV|Perl_cosh|NV x | |
2738 | =for apidoc_item |NV|Perl_exp|NV x | |
2739 | =for apidoc_item |NV|Perl_floor|NV x | |
2740 | =for apidoc_item |NV|Perl_fmod|NV x|NV y | |
2741 | =for apidoc_item |NV|Perl_frexp|NV x|int *exp | |
2742 | =for apidoc_item |IV|Perl_isfinite|NV x | |
2743 | =for apidoc_item |IV|Perl_isinf|NV x | |
2744 | =for apidoc_item |IV|Perl_isnan|NV x | |
2745 | =for apidoc_item |NV|Perl_ldexp|NV x|int exp | |
2746 | =for apidoc_item |NV|Perl_log|NV x | |
2747 | =for apidoc_item |NV|Perl_log10|NV x | |
2748 | =for apidoc_item |NV|Perl_modf|NV x|NV *iptr | |
2749 | =for apidoc_item |NV|Perl_pow|NV x|NV y | |
2750 | =for apidoc_item |NV|Perl_sin|NV x | |
2751 | =for apidoc_item |NV|Perl_sinh|NV x | |
2752 | =for apidoc_item |NV|Perl_sqrt|NV x | |
2753 | =for apidoc_item |NV|Perl_tan|NV x | |
2754 | =for apidoc_item |NV|Perl_tanh|NV x | |
2755 | ||
2756 | These perform the corresponding mathematical operation on the operand(s), using | |
2757 | the libc function designed for the task that has just enough precision for an | |
2758 | NV on this platform. If no such function with sufficient precision exists, | |
2759 | the highest precision one available is used. | |
2760 | ||
2761 | =cut | |
2762 | */ | |
2763 | ||
2764 | /* | |
99abf803 PP |
2765 | * CHAR_MIN and CHAR_MAX are not included here, as the (char) type may be |
2766 | * ambiguous. It may be equivalent to (signed char) or (unsigned char) | |
2767 | * depending on local options. Until Configure detects this (or at least | |
2768 | * detects whether the "signed" keyword is available) the CHAR ranges | |
2769 | * will not be included. UCHAR functions normally. | |
2770 | * - kja | |
2771 | */ | |
27d4fb96 | 2772 | |
6ec488b3 AC |
2773 | #define PERL_UCHAR_MIN ((unsigned char)0) |
2774 | #define PERL_UCHAR_MAX ((unsigned char)UCHAR_MAX) | |
27d4fb96 | 2775 | |
6ec488b3 AC |
2776 | #define PERL_USHORT_MIN ((unsigned short)0) |
2777 | #define PERL_USHORT_MAX ((unsigned short)USHRT_MAX) | |
27d4fb96 | 2778 | |
6ec488b3 AC |
2779 | #define PERL_SHORT_MAX ((short)SHRT_MAX) |
2780 | #define PERL_SHORT_MIN ((short)SHRT_MIN) | |
27d4fb96 | 2781 | |
6ec488b3 | 2782 | #define PERL_UINT_MAX ((unsigned int)UINT_MAX) |
99abf803 | 2783 | #define PERL_UINT_MIN ((unsigned int)0) |
27d4fb96 | 2784 | |
6ec488b3 AC |
2785 | #define PERL_INT_MAX ((int)INT_MAX) |
2786 | #define PERL_INT_MIN ((int)INT_MIN) | |
27d4fb96 | 2787 | |
6ec488b3 | 2788 | #define PERL_ULONG_MAX ((unsigned long)ULONG_MAX) |
99abf803 | 2789 | #define PERL_ULONG_MIN ((unsigned long)0L) |
27d4fb96 | 2790 | |
6ec488b3 AC |
2791 | #define PERL_LONG_MAX ((long)LONG_MAX) |
2792 | #define PERL_LONG_MIN ((long)LONG_MIN) | |
760ac839 | 2793 | |
d7d93a81 | 2794 | #ifdef UV_IS_QUAD |
99abf803 | 2795 | # define PERL_UQUAD_MAX (~(UV)0) |
f1c3b19a | 2796 | # define PERL_UQUAD_MIN ((UV)0) |
99abf803 | 2797 | # define PERL_QUAD_MAX ((IV) (PERL_UQUAD_MAX >> 1)) |
a6e633de | 2798 | # define PERL_QUAD_MIN (-PERL_QUAD_MAX - ((3 & -1) == 3)) |
79072805 LW |
2799 | #endif |
2800 | ||
d78a5caa | 2801 | /* |
3f620621 | 2802 | =for apidoc_section $integer |
d78a5caa | 2803 | |
d78a5caa | 2804 | =for apidoc AmnU||PERL_INT_MAX |
3145e814 KW |
2805 | =for apidoc_item ||PERL_INT_MIN |
2806 | =for apidoc_item ||PERL_LONG_MAX | |
2807 | =for apidoc_item ||PERL_LONG_MIN | |
2808 | =for apidoc_item ||PERL_SHORT_MAX | |
2809 | =for apidoc_item ||PERL_SHORT_MIN | |
2810 | =for apidoc_item ||PERL_UCHAR_MAX | |
2811 | =for apidoc_item ||PERL_UCHAR_MIN | |
2812 | =for apidoc_item ||PERL_UINT_MAX | |
2813 | =for apidoc_item ||PERL_UINT_MIN | |
2814 | =for apidoc_item ||PERL_ULONG_MAX | |
2815 | =for apidoc_item ||PERL_ULONG_MIN | |
2816 | =for apidoc_item ||PERL_USHORT_MAX | |
2817 | =for apidoc_item ||PERL_USHORT_MIN | |
2818 | =for apidoc_item ||PERL_QUAD_MAX | |
2819 | =for apidoc_item ||PERL_QUAD_MIN | |
2820 | =for apidoc_item ||PERL_UQUAD_MAX | |
2821 | =for apidoc_item ||PERL_UQUAD_MIN | |
2822 | ||
2823 | These give the largest and smallest number representable in the current | |
d78a5caa KW |
2824 | platform in variables of the corresponding types. |
2825 | ||
2826 | For signed types, the smallest representable number is the most negative | |
2827 | number, the one furthest away from zero. | |
2828 | ||
2829 | For C99 and later compilers, these correspond to things like C<INT_MAX>, which | |
2830 | are available to the C code. But these constants, furnished by Perl, | |
2831 | allow code compiled on earlier compilers to portably have access to the same | |
2832 | constants. | |
2833 | ||
2834 | =cut | |
2835 | ||
2836 | */ | |
2837 | ||
ee0007ab | 2838 | typedef MEM_SIZE STRLEN; |
450a55e4 | 2839 | |
79072805 LW |
2840 | typedef struct op OP; |
2841 | typedef struct cop COP; | |
2842 | typedef struct unop UNOP; | |
2f7c6295 | 2843 | typedef struct unop_aux UNOP_AUX; |
79072805 LW |
2844 | typedef struct binop BINOP; |
2845 | typedef struct listop LISTOP; | |
2846 | typedef struct logop LOGOP; | |
79072805 LW |
2847 | typedef struct pmop PMOP; |
2848 | typedef struct svop SVOP; | |
7934575e | 2849 | typedef struct padop PADOP; |
79072805 | 2850 | typedef struct pvop PVOP; |
79072805 | 2851 | typedef struct loop LOOP; |
b46e009d | 2852 | typedef struct methop METHOP; |
79072805 | 2853 | |
7aef8e5b | 2854 | #ifdef PERL_CORE |
8be227ab FC |
2855 | typedef struct opslab OPSLAB; |
2856 | typedef struct opslot OPSLOT; | |
2857 | #endif | |
2858 | ||
52db365a | 2859 | typedef struct block_hooks BHK; |
1830b3d9 | 2860 | typedef struct custom_op XOP; |
52db365a | 2861 | |
cd1541b2 NC |
2862 | typedef struct interpreter PerlInterpreter; |
2863 | ||
d2b3f365 | 2864 | /* SGI's <sys/sema.h> has struct sv */ |
cc3315ba | 2865 | #if defined(__sgi) |
d2b3f365 | 2866 | # define STRUCT_SV perl_sv |
b8d3c5db JH |
2867 | #else |
2868 | # define STRUCT_SV sv | |
2869 | #endif | |
2870 | typedef struct STRUCT_SV SV; | |
79072805 LW |
2871 | typedef struct av AV; |
2872 | typedef struct hv HV; | |
2873 | typedef struct cv CV; | |
d2f13c59 | 2874 | typedef struct p5rx REGEXP; |
79072805 | 2875 | typedef struct gp GP; |
0c30d9ec | 2876 | typedef struct gv GV; |
8990e307 | 2877 | typedef struct io IO; |
c09156bb | 2878 | typedef struct context PERL_CONTEXT; |
79072805 | 2879 | typedef struct block BLOCK; |
47e6c6d9 | 2880 | typedef struct invlist INVLIST; |
79072805 LW |
2881 | |
2882 | typedef struct magic MAGIC; | |
2883 | typedef struct xpv XPV; | |
2884 | typedef struct xpviv XPVIV; | |
ff68c719 | 2885 | typedef struct xpvuv XPVUV; |
79072805 LW |
2886 | typedef struct xpvnv XPVNV; |
2887 | typedef struct xpvmg XPVMG; | |
2888 | typedef struct xpvlv XPVLV; | |
d361b004 | 2889 | typedef struct xpvinvlist XINVLIST; |
79072805 LW |
2890 | typedef struct xpvav XPVAV; |
2891 | typedef struct xpvhv XPVHV; | |
2892 | typedef struct xpvgv XPVGV; | |
2893 | typedef struct xpvcv XPVCV; | |
2894 | typedef struct xpvbm XPVBM; | |
2895 | typedef struct xpvfm XPVFM; | |
8990e307 | 2896 | typedef struct xpvio XPVIO; |
79072805 LW |
2897 | typedef struct mgvtbl MGVTBL; |
2898 | typedef union any ANY; | |
5f7fde29 GS |
2899 | typedef struct ptr_tbl_ent PTR_TBL_ENT_t; |
2900 | typedef struct ptr_tbl PTR_TBL_t; | |
8cf8f3d1 NIS |
2901 | typedef struct clone_params CLONE_PARAMS; |
2902 | ||
0f94cb1f | 2903 | /* a pad is currently just an AV; but that might change, |
7261499d FC |
2904 | * so hide the type. */ |
2905 | typedef struct padlist PADLIST; | |
67634234 | 2906 | typedef AV PAD; |
9b7476d7 | 2907 | typedef struct padnamelist PADNAMELIST; |
0f94cb1f | 2908 | typedef struct padname PADNAME; |
67634234 | 2909 | |
5a736967 DM |
2910 | /* always enable PERL_OP_PARENT */ |
2911 | #if !defined(PERL_OP_PARENT) | |
5d32d268 DM |
2912 | # define PERL_OP_PARENT |
2913 | #endif | |
2914 | ||
93c10d60 FC |
2915 | /* enable PERL_COPY_ON_WRITE by default */ |
2916 | #if !defined(PERL_COPY_ON_WRITE) && !defined(PERL_NO_COW) | |
2917 | # define PERL_COPY_ON_WRITE | |
13b0f67d | 2918 | #endif |
07d01d6e | 2919 | |
93c10d60 | 2920 | #ifdef PERL_COPY_ON_WRITE |
db2c6cb3 | 2921 | # define PERL_ANY_COW |
9f351b45 DM |
2922 | #else |
2923 | # define PERL_SAWAMPERSAND | |
db2c6cb3 FC |
2924 | #endif |
2925 | ||
40653c20 FC |
2926 | #if defined(PERL_DEBUG_READONLY_OPS) && !defined(USE_ITHREADS) |
2927 | # error PERL_DEBUG_READONLY_OPS only works with ithreads | |
2928 | #endif | |
2929 | ||
378cc40b | 2930 | #include "handy.h" |
64935bc6 | 2931 | #include "charclass_invlists.h" |
a0d0e21e | 2932 | |
6b8eaf93 | 2933 | #if defined(USE_LARGE_FILES) && !defined(NO_64_BIT_RAWIO) |
6b8eaf93 JH |
2934 | # if LSEEKSIZE == 8 && !defined(USE_64_BIT_RAWIO) |
2935 | # define USE_64_BIT_RAWIO /* implicit */ | |
2936 | # endif | |
4564133c JH |
2937 | #endif |
2938 | ||
6b8eaf93 JH |
2939 | /* Notice the use of HAS_FSEEKO: now we are obligated to always use |
2940 | * fseeko/ftello if possible. Don't go #defining ftell to ftello yourself, | |
2941 | * however, because operating systems like to do that themself. */ | |
2942 | #ifndef FSEEKSIZE | |
2943 | # ifdef HAS_FSEEKO | |
2944 | # define FSEEKSIZE LSEEKSIZE | |
2945 | # else | |
2946 | # define FSEEKSIZE LONGSIZE | |
d460ef45 | 2947 | # endif |
6b8eaf93 JH |
2948 | #endif |
2949 | ||
2950 | #if defined(USE_LARGE_FILES) && !defined(NO_64_BIT_STDIO) | |
6b8eaf93 JH |
2951 | # if FSEEKSIZE == 8 && !defined(USE_64_BIT_STDIO) |
2952 | # define USE_64_BIT_STDIO /* implicit */ | |
2953 | # endif | |
2954 | #endif | |
4564133c | 2955 | |
09458382 | 2956 | #ifdef USE_64_BIT_RAWIO |
d9b3e12d JH |
2957 | # ifdef HAS_OFF64_T |
2958 | # undef Off_t | |
2959 | # define Off_t off64_t | |
2960 | # undef LSEEKSIZE | |
2961 | # define LSEEKSIZE 8 | |
5ff3f7a4 | 2962 | # endif |
d9b3e12d JH |
2963 | /* Most 64-bit environments have defines like _LARGEFILE_SOURCE that |
2964 | * will trigger defines like the ones below. Some 64-bit environments, | |
09458382 | 2965 | * however, do not. Therefore we have to explicitly mix and match. */ |
d9b3e12d JH |
2966 | # if defined(USE_OPEN64) |
2967 | # define open open64 | |
5ff3f7a4 | 2968 | # endif |
d9b3e12d JH |
2969 | # if defined(USE_LSEEK64) |
2970 | # define lseek lseek64 | |
6b8eaf93 JH |
2971 | # else |
2972 | # if defined(USE_LLSEEK) | |
2973 | # define lseek llseek | |
2974 | # endif | |
d9b3e12d JH |
2975 | # endif |
2976 | # if defined(USE_STAT64) | |
2977 | # define stat stat64 | |
2978 | # endif | |
2979 | # if defined(USE_FSTAT64) | |
2980 | # define fstat fstat64 | |
2981 | # endif | |
2982 | # if defined(USE_LSTAT64) | |
2983 | # define lstat lstat64 | |
2984 | # endif | |
2985 | # if defined(USE_FLOCK64) | |
2986 | # define flock flock64 | |
2987 | # endif | |
2988 | # if defined(USE_LOCKF64) | |
2989 | # define lockf lockf64 | |
2990 | # endif | |
2991 | # if defined(USE_FCNTL64) | |
2992 | # define fcntl fcntl64 | |
2993 | # endif | |
2994 | # if defined(USE_TRUNCATE64) | |
2995 | # define truncate truncate64 | |
2996 | # endif | |
2997 | # if defined(USE_FTRUNCATE64) | |
2998 | # define ftruncate ftruncate64 | |
2999 | # endif | |
3000 | #endif | |
3001 | ||
3002 | #ifdef USE_64_BIT_STDIO | |
3003 | # ifdef HAS_FPOS64_T | |
3004 | # undef Fpos_t | |
3005 | # define Fpos_t fpos64_t | |
3006 | # endif | |
3007 | /* Most 64-bit environments have defines like _LARGEFILE_SOURCE that | |
3008 | * will trigger defines like the ones below. Some 64-bit environments, | |
3009 | * however, do not. */ | |
3010 | # if defined(USE_FOPEN64) | |
3011 | # define fopen fopen64 | |
3012 | # endif | |
3013 | # if defined(USE_FSEEK64) | |
6b8eaf93 | 3014 | # define fseek fseek64 /* don't do fseeko here, see perlio.c */ |
d9b3e12d JH |
3015 | # endif |
3016 | # if defined(USE_FTELL64) | |
6b8eaf93 | 3017 | # define ftell ftell64 /* don't do ftello here, see perlio.c */ |
d9b3e12d JH |
3018 | # endif |
3019 | # if defined(USE_FSETPOS64) | |
3020 | # define fsetpos fsetpos64 | |
3021 | # endif | |
3022 | # if defined(USE_FGETPOS64) | |
3023 | # define fgetpos fgetpos64 | |
3024 | # endif | |
3025 | # if defined(USE_TMPFILE64) | |
3026 | # define tmpfile tmpfile64 | |
3027 | # endif | |
3028 | # if defined(USE_FREOPEN64) | |
3029 | # define freopen freopen64 | |
5ff3f7a4 GS |
3030 | # endif |
3031 | #endif | |
3032 | ||
e37778c2 | 3033 | #if defined(OS2) |
2c2d71f5 JH |
3034 | # include "iperlsys.h" |
3035 | #endif | |
3036 | ||
748a9306 | 3037 | #ifdef DOSISH |
19848b3f JH |
3038 | # if defined(OS2) |
3039 | # include "os2ish.h" | |
3040 | # else | |
3041 | # include "dosish.h" | |
3042 | # endif | |
009819bb | 3043 | #elif defined(VMS) |
748a9306 | 3044 | # include "vmsish.h" |
009819bb | 3045 | #elif defined(PLAN9) |
19848b3f | 3046 | # include "./plan9/plan9ish.h" |
009819bb | 3047 | #elif defined(__VOS__) |
196918b0 PG |
3048 | # ifdef __GNUC__ |
3049 | # include "./vos/vosish.h" | |
3050 | # else | |
3051 | # include "vos/vosish.h" | |
3052 | # endif | |
009819bb | 3053 | #elif defined(__HAIKU__) |
df00ff3b | 3054 | # include "haiku/haikuish.h" |
009819bb | 3055 | #else |
19848b3f | 3056 | # include "unixish.h" |
13b6e58c JH |
3057 | #endif |
3058 | ||
ea34f6bd | 3059 | #ifdef __amigaos4__ |
3c0208ad AB |
3060 | # include "amigaos.h" |
3061 | # undef FD_CLOEXEC /* a lie in AmigaOS */ | |
3062 | #endif | |
3063 | ||
2946a158 | 3064 | /* NSIG logic from Configure --> */ |
2946a158 JH |
3065 | #ifndef NSIG |
3066 | # ifdef _NSIG | |
3067 | # define NSIG (_NSIG) | |
da5fdda8 | 3068 | # elif defined(SIGMAX) |
2946a158 | 3069 | # define NSIG (SIGMAX+1) |
da5fdda8 | 3070 | # elif defined(SIG_MAX) |
2946a158 | 3071 | # define NSIG (SIG_MAX+1) |
da5fdda8 | 3072 | # elif defined(_SIG_MAX) |
2946a158 | 3073 | # define NSIG (_SIG_MAX+1) |
da5fdda8 | 3074 | # elif defined(MAXSIG) |
2946a158 | 3075 | # define NSIG (MAXSIG+1) |
da5fdda8 | 3076 | # elif defined(MAX_SIG) |
2946a158 | 3077 | # define NSIG (MAX_SIG+1) |
da5fdda8 | 3078 | # elif defined(SIGARRAYSIZE) |
2946a158 | 3079 | # define NSIG SIGARRAYSIZE /* Assume ary[SIGARRAYSIZE] */ |
da5fdda8 | 3080 | # elif defined(_sys_nsig) |
2946a158 | 3081 | # define NSIG (_sys_nsig) /* Solaris 2.5 */ |
da5fdda8 AC |
3082 | # else |
3083 | /* Default to some arbitrary number that's big enough to get most | |
3084 | * of the common signals. */ | |
2946a158 | 3085 | # define NSIG 50 |
da5fdda8 | 3086 | # endif |
2946a158 JH |
3087 | #endif |
3088 | /* <-- NSIG logic from Configure */ | |
3089 | ||
13b6e58c JH |
3090 | #ifndef NO_ENVIRON_ARRAY |
3091 | # define USE_ENVIRON_ARRAY | |
3092 | #endif | |
32f822de | 3093 | |
5e7940ce | 3094 | #if defined(HAS_SIGACTION) && defined(SA_SIGINFO) |
c99d8cd6 DM |
3095 | /* having sigaction(2) means that the OS supports both 1-arg and 3-arg |
3096 | * signal handlers. But the perl core itself only fully supports 1-arg | |
3097 | * handlers, so don't enable for now. | |
3098 | * NB: POSIX::sigaction() supports both. | |
3099 | * | |
3100 | * # define PERL_USE_3ARG_SIGHANDLER | |
3101 | */ | |
5e7940ce DM |
3102 | #endif |
3103 | ||
e7124897 DM |
3104 | /* Siginfo_t: |
3105 | * This is an alias for the OS's siginfo_t, except that where the OS | |
3106 | * doesn't support it, declare a dummy version instead. This allows us to | |
3107 | * have signal handler functions which always have a Siginfo_t parameter | |
3108 | * regardless of platform, (and which will just be passed a NULL value | |
3109 | * where the OS doesn't support HAS_SIGACTION). | |
3110 | */ | |
3111 | ||
3112 | #if defined(HAS_SIGACTION) && defined(SA_SIGINFO) | |
3113 | typedef siginfo_t Siginfo_t; | |
3114 | #else | |
3555a05c LT |
3115 | #ifdef si_signo /* minix */ |
3116 | #undef si_signo | |
3117 | #endif | |
e7124897 DM |
3118 | typedef struct { |
3119 | int si_signo; | |
3120 | } Siginfo_t; | |
3121 | #endif | |
3122 | ||
3123 | ||
c77b533b JH |
3124 | /* |
3125 | * initialise to avoid floating-point exceptions from overflow, etc | |
3126 | */ | |
3127 | #ifndef PERL_FPU_INIT | |
3128 | # ifdef HAS_FPSETMASK | |
3129 | # if HAS_FLOATINGPOINT_H | |
3130 | # include <floatingpoint.h> | |
3131 | # endif | |
ad3a8c67 NC |
3132 | /* Some operating systems have this as a macro, which in turn expands to a comma |
3133 | expression, and the last sub-expression is something that gets calculated, | |
3134 | and then they have the gall to warn that a value computed is not used. Hence | |
3135 | cast to void. */ | |
3136 | # define PERL_FPU_INIT (void)fpsetmask(0) | |
da5fdda8 AC |
3137 | # elif defined(SIGFPE) && defined(SIG_IGN) && !defined(PERL_MICRO) |
3138 | # define PERL_FPU_INIT PL_sigfpe_saved = (Sighandler_t) signal(SIGFPE, SIG_IGN) | |
3139 | # define PERL_FPU_PRE_EXEC { Sigsave_t xfpe; rsignal_save(SIGFPE, PL_sigfpe_saved, &xfpe); | |
3140 | # define PERL_FPU_POST_EXEC rsignal_restore(SIGFPE, &xfpe); } | |
c77b533b | 3141 | # else |
da5fdda8 | 3142 | # define PERL_FPU_INIT |
c77b533b JH |
3143 | # endif |
3144 | #endif | |
b35112e7 CS |
3145 | #ifndef PERL_FPU_PRE_EXEC |
3146 | # define PERL_FPU_PRE_EXEC { | |
3147 | # define PERL_FPU_POST_EXEC } | |
3148 | #endif | |
c77b533b | 3149 | |
a308b05a JH |
3150 | /* In Tru64 the cc -ieee enables the IEEE math but disables traps. |
3151 | * We need to reenable the "invalid" trap because otherwise generation | |
3152 | * of NaN values leaves the IEEE fp flags in bad state, leaving any further | |
3153 | * fp ops behaving strangely (Inf + 1 resulting in zero, for example). */ | |
3154 | #ifdef __osf__ | |
3155 | # include <machine/fpu.h> | |
3156 | # define PERL_SYS_FPU_INIT \ | |
3157 | STMT_START { \ | |
3158 | ieee_set_fp_control(IEEE_TRAP_ENABLE_INV); \ | |
3159 | signal(SIGFPE, SIG_IGN); \ | |
3160 | } STMT_END | |
3161 | #endif | |
94a08944 JH |
3162 | /* In IRIX the default for Flush to Zero bit is true, |
3163 | * which means that results going below the minimum of normal | |
3164 | * floating points go to zero, instead of going denormal/subnormal. | |
3165 | * This is unlike almost any other system running Perl, so let's clear it. | |
3166 | * [perl #123767] IRIX64 blead (ddce084a) opbasic/arith.t failure, originally | |
3167 | * [perl #120426] small numbers shouldn't round to zero if they have extra floating digits | |
3168 | * | |
3169 | * XXX The flush-to-zero behaviour should be a Configure scan. | |
3170 | * To change the behaviour usually requires some system-specific | |
3171 | * incantation, though, like the below. */ | |
3172 | #ifdef __sgi | |
3173 | # include <sys/fpu.h> | |
3174 | # define PERL_SYS_FPU_INIT \ | |
3175 | STMT_START { \ | |
3176 | union fpc_csr csr; \ | |
3177 | csr.fc_word = get_fpc_csr(); \ | |
3178 | csr.fc_struct.flush = 0; \ | |
3179 | set_fpc_csr(csr.fc_word); \ | |
3180 | } STMT_END | |
3181 | #endif | |
a308b05a JH |
3182 | |
3183 | #ifndef PERL_SYS_FPU_INIT | |
3184 | # define PERL_SYS_FPU_INIT NOOP | |
3185 | #endif | |
3186 | ||
cbec8ebe DM |
3187 | #ifndef PERL_SYS_INIT3_BODY |
3188 | # define PERL_SYS_INIT3_BODY(argvp,argcp,envp) PERL_SYS_INIT_BODY(argvp,argcp) | |
ed344e4f IZ |
3189 | #endif |
3190 | ||
eb533572 | 3191 | /* |
3f620621 | 3192 | =for apidoc_section $embedding |
dcccc8ff | 3193 | |
4ad9e498 | 3194 | =for apidoc Am|void|PERL_SYS_INIT|int *argc|char*** argv |
eb533572 | 3195 | Provides system-specific tune up of the C runtime environment necessary to |
72d33970 | 3196 | run Perl interpreters. This should be called only once, before creating |
eb533572 DM |
3197 | any Perl interpreters. |
3198 | ||
4ad9e498 | 3199 | =for apidoc Am|void|PERL_SYS_INIT3|int *argc|char*** argv|char*** env |
eb533572 | 3200 | Provides system-specific tune up of the C runtime environment necessary to |
72d33970 | 3201 | run Perl interpreters. This should be called only once, before creating |
eb533572 DM |
3202 | any Perl interpreters. |
3203 | ||
3204 | =for apidoc Am|void|PERL_SYS_TERM| | |
3205 | Provides system-specific clean up of the C runtime environment after | |
72d33970 | 3206 | running Perl interpreters. This should be called only once, after |
eb533572 DM |
3207 | freeing any remaining Perl interpreters. |
3208 | ||
3209 | =cut | |
3210 | */ | |
3211 | ||
cbec8ebe DM |
3212 | #define PERL_SYS_INIT(argc, argv) Perl_sys_init(argc, argv) |
3213 | #define PERL_SYS_INIT3(argc, argv, env) Perl_sys_init3(argc, argv, env) | |
d0820ef1 | 3214 | #define PERL_SYS_TERM() Perl_sys_term() |
cbec8ebe | 3215 | |
be708cc0 JH |
3216 | #ifndef PERL_WRITE_MSG_TO_CONSOLE |
3217 | # define PERL_WRITE_MSG_TO_CONSOLE(io, msg, len) PerlIO_write(io, msg, len) | |
3218 | #endif | |
3219 | ||
0f31cffe GS |
3220 | #ifndef MAXPATHLEN |
3221 | # ifdef PATH_MAX | |
b990c8b2 JH |
3222 | # ifdef _POSIX_PATH_MAX |
3223 | # if PATH_MAX > _POSIX_PATH_MAX | |
09448d78 JH |
3224 | /* POSIX 1990 (and pre) was ambiguous about whether PATH_MAX |
3225 | * included the null byte or not. Later amendments of POSIX, | |
3226 | * XPG4, the Austin Group, and the Single UNIX Specification | |
3227 | * all explicitly include the null byte in the PATH_MAX. | |
3228 | * Ditto for _POSIX_PATH_MAX. */ | |
3229 | # define MAXPATHLEN PATH_MAX | |
b990c8b2 | 3230 | # else |
09448d78 | 3231 | # define MAXPATHLEN _POSIX_PATH_MAX |
b990c8b2 JH |
3232 | # endif |
3233 | # else | |
3234 | # define MAXPATHLEN (PATH_MAX+1) | |
3235 | # endif | |
0f31cffe | 3236 | # else |
d552bce8 | 3237 | # define MAXPATHLEN 1024 /* Err on the large side. */ |
0f31cffe GS |
3238 | # endif |
3239 | #endif | |
3240 | ||
3baee7cc JH |
3241 | /* clang Thread Safety Analysis/Annotations/Attributes |
3242 | * http://clang.llvm.org/docs/ThreadSafetyAnalysis.html | |
3243 | * | |
bdc795f4 | 3244 | * Available since clang 3.6-ish (appeared in 3.4, but shaky still in 3.5). |
3baee7cc | 3245 | * Apple XCode hijacks __clang_major__ and __clang_minor__ |
bdc795f4 JH |
3246 | * (6.1 means really clang 3.6), so needs extra hijinks |
3247 | * (could probably also test the contents of __apple_build_version__). | |
3baee7cc JH |
3248 | */ |
3249 | #if defined(USE_ITHREADS) && defined(I_PTHREAD) && \ | |
3250 | defined(__clang__) && \ | |
3251 | !defined(SWIG) && \ | |
3252 | ((!defined(__apple_build_version__) && \ | |
bdc795f4 | 3253 | ((__clang_major__ == 3 && __clang_minor__ >= 6) || \ |
8412ccf9 | 3254 | (__clang_major__ >= 4))) || \ |
3baee7cc | 3255 | (defined(__apple_build_version__) && \ |
bdc795f4 JH |
3256 | ((__clang_major__ == 6 && __clang_minor__ >= 1) || \ |
3257 | (__clang_major__ >= 7)))) | |
3baee7cc JH |
3258 | # define PERL_TSA__(x) __attribute__((x)) |
3259 | # define PERL_TSA_ACTIVE | |
3260 | #else | |
3261 | # define PERL_TSA__(x) /* No TSA, make TSA attributes no-ops. */ | |
3262 | # undef PERL_TSA_ACTIVE | |
3263 | #endif | |
3264 | ||
3265 | /* PERL_TSA_CAPABILITY() is used to annotate typedefs. | |
3266 | * typedef old_type PERL_TSA_CAPABILITY("mutex") new_type; | |
3267 | */ | |
3268 | #define PERL_TSA_CAPABILITY(x) \ | |
3269 | PERL_TSA__(capability(x)) | |
3270 | ||
3271 | /* In the below examples the mutex must be lexically visible, usually | |
3272 | * either as global variables, or as function arguments. */ | |
3273 | ||
3274 | /* PERL_TSA_GUARDED_BY() is used to annotate global variables. | |
3275 | * | |
3276 | * Foo foo PERL_TSA_GUARDED_BY(mutex); | |
3277 | */ | |
3278 | #define PERL_TSA_GUARDED_BY(x) \ | |
3279 | PERL_TSA__(guarded_by(x)) | |
3280 | ||
3281 | /* PERL_TSA_PT_GUARDED_BY() is used to annotate global pointers. | |
3282 | * The data _behind_ the pointer is guarded. | |
3283 | * | |
3284 | * Foo* ptr PERL_TSA_PT_GUARDED_BY(mutex); | |
3285 | */ | |
3286 | #define PERL_TSA_PT_GUARDED_BY(x) \ | |
3287 | PERL_TSA__(pt_guarded_by(x)) | |
3288 | ||
3289 | /* PERL_TSA_REQUIRES() is used to annotate functions. | |
3290 | * The caller MUST hold the resource when calling the function. | |
3291 | * | |
3292 | * void Foo() PERL_TSA_REQUIRES(mutex); | |
3293 | */ | |
3294 | #define PERL_TSA_REQUIRES(x) \ | |
3295 | PERL_TSA__(requires_capability(x)) | |
3296 | ||
3297 | /* PERL_TSA_EXCLUDES() is used to annotate functions. | |
3298 | * The caller MUST NOT hold resource when calling the function. | |
3299 | * | |
3300 | * EXCLUDES should be used when the function first acquires | |
3301 | * the resource and then releases it. Use to avoid deadlock. | |
3302 | * | |
3303 | * void Foo() PERL_TSA_EXCLUDES(mutex); | |
3304 | */ | |
3305 | #define PERL_TSA_EXCLUDES(x) \ | |
3306 | PERL_TSA__(locks_excluded(x)) | |
3307 | ||
3308 | /* PERL_TSA_ACQUIRE() is used to annotate functions. | |
3309 | * The caller MUST NOT hold the resource when calling the function, | |
3310 | * and the function will acquire the resource. | |
3311 | * | |
3312 | * void Foo() PERL_TSA_ACQUIRE(mutex); | |
3313 | */ | |
3314 | #define PERL_TSA_ACQUIRE(x) \ | |
3315 | PERL_TSA__(acquire_capability(x)) | |
3316 | ||
3317 | /* PERL_TSA_RELEASE() is used to annotate functions. | |
3318 | * The caller MUST hold the resource when calling the function, | |
3319 | * and the function will release the resource. | |
3320 | * | |
3321 | * void Foo() PERL_TSA_RELEASE(mutex); | |
3322 | */ | |
3323 | #define PERL_TSA_RELEASE(x) \ | |
3324 | PERL_TSA__(release_capability(x)) | |
3325 | ||
3326 | /* PERL_TSA_NO_TSA is used to annotate functions. | |
3327 | * Used when being intentionally unsafe, or when the code is too | |
3328 | * complicated for the analysis. Use sparingly. | |
3329 | * | |
3330 | * void Foo() PERL_TSA_NO_TSA; | |
3331 | */ | |
3332 | #define PERL_TSA_NO_TSA \ | |
3333 | PERL_TSA__(no_thread_safety_analysis) | |
3334 | ||
3335 | /* There are more annotations/attributes available, see the clang | |
3336 | * documentation for details. */ | |
3337 | ||
3db8f154 | 3338 | #if defined(USE_ITHREADS) |
2986a63f | 3339 | # ifdef NETWARE |
da5fdda8 AC |
3340 | # include <nw5thread.h> |
3341 | # elif defined(WIN32) | |
3342 | # include <win32thread.h> | |
3343 | # elif defined(OS2) | |
3344 | # include "os2thread.h" | |
3345 | # elif defined(I_MACH_CTHREADS) | |
3346 | # include <mach/cthreads.h> | |
7f3d1cf1 BH |
3347 | typedef cthread_t perl_os_thread; |
3348 | typedef mutex_t perl_mutex; | |
3349 | typedef condition_t perl_cond; | |
3350 | typedef void * perl_key; | |
da5fdda8 AC |
3351 | # elif defined(I_PTHREAD) /* Posix threads */ |
3352 | # include <pthread.h> | |
7f3d1cf1 | 3353 | typedef pthread_t perl_os_thread; |
3baee7cc | 3354 | typedef pthread_mutex_t PERL_TSA_CAPABILITY("mutex") perl_mutex; |
7f3d1cf1 BH |
3355 | typedef pthread_cond_t perl_cond; |
3356 | typedef pthread_key_t perl_key; | |
da5fdda8 | 3357 | # endif |
5640a370 KW |
3358 | |
3359 | /* Many readers; single writer */ | |
0d601f07 | 3360 | typedef struct { |
5640a370 | 3361 | perl_mutex lock; |
0b83dfe6 | 3362 | perl_cond wakeup; |
41b10d90 | 3363 | SSize_t readers_count; |
0d601f07 | 3364 | } perl_RnW1_mutex_t; |
5640a370 KW |
3365 | |
3366 | ||
3db8f154 | 3367 | #endif /* USE_ITHREADS */ |
c5be433b | 3368 | |
3baee7cc JH |
3369 | #ifdef PERL_TSA_ACTIVE |
3370 | /* Since most pthread mutex interfaces have not been annotated, we | |
3371 | * need to have these wrappers. The NO_TSA annotation is quite ugly | |
3372 | * but it cannot be avoided in plain C, unlike in C++, where one could | |
3373 | * e.g. use ACQUIRE() with no arg on a mutex lock method. | |
3374 | * | |
3375 | * The bodies of these wrappers are in util.c | |
3376 | * | |
3377 | * TODO: however, some platforms are starting to get these clang | |
3378 | * thread safety annotations for pthreads, for example FreeBSD. | |
3379 | * Do we need a way to a bypass these wrappers? */ | |
67083b7b | 3380 | EXTERN_C int perl_tsa_mutex_lock(perl_mutex* mutex) |
3baee7cc JH |
3381 | PERL_TSA_ACQUIRE(*mutex) |
3382 | PERL_TSA_NO_TSA; | |
67083b7b | 3383 | EXTERN_C int perl_tsa_mutex_unlock(perl_mutex* mutex) |
3baee7cc JH |
3384 | PERL_TSA_RELEASE(*mutex) |
3385 | PERL_TSA_NO_TSA; | |
3386 | #endif | |
3387 | ||
66a93824 | 3388 | #if defined(WIN32) |
1feb2720 | 3389 | # include "win32.h" |
c5be433b GS |
3390 | #endif |
3391 | ||
2986a63f JH |
3392 | #ifdef NETWARE |
3393 | # include "netware.h" | |
3394 | #endif | |
3395 | ||
e5218da5 | 3396 | #define STATUS_UNIX PL_statusvalue |
68dc0745 | 3397 | #ifdef VMS |
6b88bc9c | 3398 | # define STATUS_NATIVE PL_statusvalue_vms |
7a7fd8e0 JM |
3399 | /* |
3400 | * vaxc$errno is only guaranteed to be valid if errno == EVMSERR, otherwise | |
ff7298cb | 3401 | * its contents can not be trusted. Unfortunately, Perl seems to check |
7a7fd8e0 JM |
3402 | * it on exit, so it when PL_statusvalue_vms is updated, vaxc$errno should |
3403 | * be updated also. | |
3404 | */ | |
3405 | # include <stsdef.h> | |
3406 | # include <ssdef.h> | |
3407 | /* Presume this because if VMS changes it, it will require a new | |
3408 | * set of APIs for waiting on children for binary compatibility. | |
3409 | */ | |
3410 | # define child_offset_bits (8) | |
3411 | # ifndef C_FAC_POSIX | |
3412 | # define C_FAC_POSIX 0x35A000 | |
3413 | # endif | |
3414 | ||
3415 | /* STATUS_EXIT - validates and returns a NATIVE exit status code for the | |
3416 | * platform from the existing UNIX or Native status values. | |
3417 | */ | |
3418 | ||
37038d91 | 3419 | # define STATUS_EXIT \ |
7a7fd8e0 JM |
3420 | (((I32)PL_statusvalue_vms == -1 ? SS$_ABORT : PL_statusvalue_vms) | \ |
3421 | (VMSISH_HUSHED ? STS$M_INHIB_MSG : 0)) | |
3422 | ||
7a7fd8e0 | 3423 | |
fb38d079 JM |
3424 | /* STATUS_NATIVE_CHILD_SET - Calculate UNIX status that matches the child |
3425 | * exit code and shifts the UNIX value over the correct number of bits to | |
3426 | * be a child status. Usually the number of bits is 8, but that could be | |
3427 | * platform dependent. The NATIVE status code is presumed to have either | |
3428 | * from a child process. | |
7a7fd8e0 JM |
3429 | */ |
3430 | ||
fb38d079 JM |
3431 | /* This is complicated. The child processes return a true native VMS |
3432 | status which must be saved. But there is an assumption in Perl that | |
3433 | the UNIX child status has some relationship to errno values, so | |
00f254e2 | 3434 | Perl tries to translate it to text in some of the tests. |
fb38d079 JM |
3435 | In order to get the string translation correct, for the error, errno |
3436 | must be EVMSERR, but that generates a different text message | |
3437 | than what the test programs are expecting. So an errno value must | |
3438 | be derived from the native status value when an error occurs. | |
3439 | That will hide the true native status message. With this version of | |
3440 | perl, the true native child status can always be retrieved so that | |
3441 | is not a problem. But in this case, Pl_statusvalue and errno may | |
3442 | have different values in them. | |
3443 | */ | |
7a7fd8e0 | 3444 | |
fb38d079 | 3445 | # define STATUS_NATIVE_CHILD_SET(n) \ |
68dc0745 | 3446 | STMT_START { \ |
2fbb330f JM |
3447 | I32 evalue = (I32)n; \ |
3448 | if (evalue == EVMSERR) { \ | |
3449 | PL_statusvalue_vms = vaxc$errno; \ | |
3450 | PL_statusvalue = evalue; \ | |
7a7fd8e0 | 3451 | } else { \ |
2fbb330f | 3452 | PL_statusvalue_vms = evalue; \ |
fb38d079 | 3453 | if (evalue == -1) { \ |
3280af22 | 3454 | PL_statusvalue = -1; \ |
7a7fd8e0 JM |
3455 | PL_statusvalue_vms = SS$_ABORT; /* Should not happen */ \ |
3456 | } else \ | |
fb38d079 | 3457 | PL_statusvalue = Perl_vms_status_to_unix(evalue, 1); \ |
2fbb330f | 3458 | set_vaxc_errno(evalue); \ |
fb38d079 JM |
3459 | if ((PL_statusvalue_vms & C_FAC_POSIX) == C_FAC_POSIX) \ |
3460 | set_errno(EVMSERR); \ | |
3461 | else set_errno(Perl_vms_status_to_unix(evalue, 0)); \ | |
3462 | PL_statusvalue = PL_statusvalue << child_offset_bits; \ | |
2fbb330f | 3463 | } \ |
68dc0745 | 3464 | } STMT_END |
7a7fd8e0 | 3465 | |
68dc0745 | 3466 | # ifdef VMSISH_STATUS |
e5218da5 | 3467 | # define STATUS_CURRENT (VMSISH_STATUS ? STATUS_NATIVE : STATUS_UNIX) |
68dc0745 | 3468 | # else |
e5218da5 | 3469 | # define STATUS_CURRENT STATUS_UNIX |
68dc0745 | 3470 | # endif |
7a7fd8e0 JM |
3471 | |
3472 | /* STATUS_UNIX_SET - takes a UNIX/POSIX errno value and attempts to update | |
3473 | * the NATIVE status to an equivalent value. Can not be used to translate | |
3474 | * exit code values as exit code values are not guaranteed to have any | |
3475 | * relationship at all to errno values. | |
3476 | * This is used when Perl is forcing errno to have a specific value. | |
3477 | */ | |
e5218da5 | 3478 | # define STATUS_UNIX_SET(n) \ |
68dc0745 | 3479 | STMT_START { \ |
7a7fd8e0 | 3480 | I32 evalue = (I32)n; \ |
0968cdad | 3481 | PL_statusvalue = evalue; \ |
3280af22 | 3482 | if (PL_statusvalue != -1) { \ |
0968cdad JM |
3483 | if (PL_statusvalue != EVMSERR) { \ |
3484 | PL_statusvalue &= 0xFFFF; \ | |
3485 | if (MY_POSIX_EXIT) \ | |
3486 | PL_statusvalue_vms=PL_statusvalue ? SS$_ABORT : SS$_NORMAL;\ | |
3487 | else PL_statusvalue_vms = Perl_unix_status_to_vms(evalue); \ | |
3488 | } \ | |
3489 | else { \ | |
3490 | PL_statusvalue_vms = vaxc$errno; \ | |
3491 | } \ | |
68dc0745 | 3492 | } \ |
0968cdad JM |
3493 | else PL_statusvalue_vms = SS$_ABORT; \ |
3494 | set_vaxc_errno(PL_statusvalue_vms); \ | |
7a7fd8e0 JM |
3495 | } STMT_END |
3496 | ||
3497 | /* STATUS_UNIX_EXIT_SET - Takes a UNIX/POSIX exit code and sets | |
e08e1e1d JM |
3498 | * the NATIVE error status based on it. |
3499 | * | |
3500 | * When in the default mode to comply with the Perl VMS documentation, | |
3501 | * 0 is a success and any other code sets the NATIVE status to a failure | |
3502 | * code of SS$_ABORT. | |
fb38d079 JM |
3503 | * |
3504 | * In the new POSIX EXIT mode, native status will be set so that the | |
3505 | * actual exit code will can be retrieved by the calling program or | |
3506 | * shell. | |
3507 | * | |
3508 | * If the exit code is not clearly a UNIX parent or child exit status, | |
3509 | * it will be passed through as a VMS status. | |
7a7fd8e0 JM |
3510 | */ |
3511 | ||
fb38d079 | 3512 | # define STATUS_UNIX_EXIT_SET(n) \ |
7a7fd8e0 JM |
3513 | STMT_START { \ |
3514 | I32 evalue = (I32)n; \ | |
3515 | PL_statusvalue = evalue; \ | |
e08e1e1d JM |
3516 | if (MY_POSIX_EXIT) { \ |
3517 | if (evalue <= 0xFF00) { \ | |
3518 | if (evalue > 0xFF) \ | |
3519 | evalue = (evalue >> child_offset_bits) & 0xFF; \ | |
3520 | PL_statusvalue_vms = \ | |
3521 | (C_FAC_POSIX | (evalue << 3 ) | \ | |
3522 | ((evalue == 1) ? (STS$K_ERROR | STS$M_INHIB_MSG) : 1)); \ | |
3523 | } else /* forgive them Perl, for they have sinned */ \ | |
3524 | PL_statusvalue_vms = evalue; \ | |
3525 | } else { \ | |
3526 | if (evalue == 0) \ | |
3527 | PL_statusvalue_vms = SS$_NORMAL; \ | |
3528 | else if (evalue <= 0xFF00) \ | |
3529 | PL_statusvalue_vms = SS$_ABORT; \ | |
3530 | else { /* forgive them Perl, for they have sinned */ \ | |
3531 | if (evalue != EVMSERR) PL_statusvalue_vms = evalue; \ | |
3532 | else PL_statusvalue_vms = vaxc$errno; \ | |
3533 | /* And obviously used a VMS status value instead of UNIX */ \ | |
3534 | PL_statusvalue = EVMSERR; \ | |
3535 | } \ | |
3536 | set_vaxc_errno(PL_statusvalue_vms); \ | |
3537 | } \ | |
68dc0745 | 3538 | } STMT_END |
fb38d079 | 3539 | |
e08e1e1d | 3540 | |
6ac6a52b JM |
3541 | /* STATUS_EXIT_SET - Takes a NATIVE/UNIX/POSIX exit code |
3542 | * and sets the NATIVE error status based on it. This special case | |
3543 | * is needed to maintain compatibility with past VMS behavior. | |
3544 | * | |
3545 | * In the default mode on VMS, this number is passed through as | |
3546 | * both the NATIVE and UNIX status. Which makes it different | |
3547 | * that the STATUS_UNIX_EXIT_SET. | |
3548 | * | |
3549 | * In the new POSIX EXIT mode, native status will be set so that the | |
3550 | * actual exit code will can be retrieved by the calling program or | |
3551 | * shell. | |
3552 | * | |
1a3aec58 JM |
3553 | * A POSIX exit code is from 0 to 255. If the exit code is higher |
3554 | * than this, it needs to be assumed that it is a VMS exit code and | |
3555 | * passed through. | |
6ac6a52b JM |
3556 | */ |
3557 | ||
3558 | # define STATUS_EXIT_SET(n) \ | |
3559 | STMT_START { \ | |
3560 | I32 evalue = (I32)n; \ | |
3561 | PL_statusvalue = evalue; \ | |
3562 | if (MY_POSIX_EXIT) \ | |
1a3aec58 JM |
3563 | if (evalue > 255) PL_statusvalue_vms = evalue; else { \ |
3564 | PL_statusvalue_vms = \ | |
3565 | (C_FAC_POSIX | (evalue << 3 ) | \ | |
3566 | ((evalue == 1) ? (STS$K_ERROR | STS$M_INHIB_MSG) : 1));} \ | |
6ac6a52b JM |
3567 | else \ |
3568 | PL_statusvalue_vms = evalue ? evalue : SS$_NORMAL; \ | |
3569 | set_vaxc_errno(PL_statusvalue_vms); \ | |
3570 | } STMT_END | |
3571 | ||
fb38d079 JM |
3572 | |
3573 | /* This macro forces a success status */ | |
7a7fd8e0 JM |
3574 | # define STATUS_ALL_SUCCESS \ |
3575 | (PL_statusvalue = 0, PL_statusvalue_vms = SS$_NORMAL) | |
fb38d079 JM |
3576 | |
3577 | /* This macro forces a failure status */ | |
7a7fd8e0 JM |
3578 | # define STATUS_ALL_FAILURE (PL_statusvalue = 1, \ |
3579 | vaxc$errno = PL_statusvalue_vms = MY_POSIX_EXIT ? \ | |
3580 | (C_FAC_POSIX | (1 << 3) | STS$K_ERROR | STS$M_INHIB_MSG) : SS$_ABORT) | |
fb38d079 | 3581 | |
738ab09f AB |
3582 | #elif defined(__amigaos4__) |
3583 | /* A somewhat experimental attempt to simulate posix return code values */ | |
3584 | # define STATUS_NATIVE PL_statusvalue_posix | |
3585 | # define STATUS_NATIVE_CHILD_SET(n) \ | |
3586 | STMT_START { \ | |
3587 | PL_statusvalue_posix = (n); \ | |
3588 | if (PL_statusvalue_posix < 0) { \ | |
3589 | PL_statusvalue = -1; \ | |
3590 | } \ | |
3591 | else { \ | |
3592 | PL_statusvalue = n << 8; \ | |
3593 | } \ | |
3594 | } STMT_END | |
3595 | # define STATUS_UNIX_SET(n) \ | |
3596 | STMT_START { \ | |
3597 | PL_statusvalue = (n); \ | |
3598 | if (PL_statusvalue != -1) \ | |
3599 | PL_statusvalue &= 0xFFFF; \ | |
3600 | } STMT_END | |
3601 | # define STATUS_UNIX_EXIT_SET(n) STATUS_UNIX_SET(n) | |
3602 | # define STATUS_EXIT_SET(n) STATUS_UNIX_SET(n) | |
3603 | # define STATUS_CURRENT STATUS_UNIX | |
3604 | # define STATUS_EXIT STATUS_UNIX | |
3605 | # define STATUS_ALL_SUCCESS (PL_statusvalue = 0, PL_statusvalue_posix = 0) | |
3606 | # define STATUS_ALL_FAILURE (PL_statusvalue = 1, PL_statusvalue_posix = 1) | |
3607 | ||
68dc0745 | 3608 | #else |
e5218da5 | 3609 | # define STATUS_NATIVE PL_statusvalue_posix |
e5218da5 | 3610 | # if defined(WCOREDUMP) |
37038d91 | 3611 | # define STATUS_NATIVE_CHILD_SET(n) \ |
e5218da5 GA |
3612 | STMT_START { \ |
3613 | PL_statusvalue_posix = (n); \ | |
3614 | if (PL_statusvalue_posix == -1) \ | |
3615 | PL_statusvalue = -1; \ | |
3616 | else { \ | |
3617 | PL_statusvalue = \ | |
3618 | (WIFEXITED(PL_statusvalue_posix) ? (WEXITSTATUS(PL_statusvalue_posix) << 8) : 0) | \ | |
3619 | (WIFSIGNALED(PL_statusvalue_posix) ? (WTERMSIG(PL_statusvalue_posix) & 0x7F) : 0) | \ | |
3620 | (WIFSIGNALED(PL_statusvalue_posix) && WCOREDUMP(PL_statusvalue_posix) ? 0x80 : 0); \ | |
3621 | } \ | |
3622 | } STMT_END | |
3623 | # elif defined(WIFEXITED) | |
37038d91 | 3624 | # define STATUS_NATIVE_CHILD_SET(n) \ |
e5218da5 GA |
3625 | STMT_START { \ |
3626 | PL_statusvalue_posix = (n); \ | |
3627 | if (PL_statusvalue_posix == -1) \ | |
3628 | PL_statusvalue = -1; \ | |
3629 | else { \ | |
3630 | PL_statusvalue = \ | |
3631 | (WIFEXITED(PL_statusvalue_posix) ? (WEXITSTATUS(PL_statusvalue_posix) << 8) : 0) | \ | |
3632 | (WIFSIGNALED(PL_statusvalue_posix) ? (WTERMSIG(PL_statusvalue_posix) & 0x7F) : 0); \ | |
3633 | } \ | |
3634 | } STMT_END | |
3635 | # else | |
37038d91 | 3636 | # define STATUS_NATIVE_CHILD_SET(n) \ |
e5218da5 GA |
3637 | STMT_START { \ |
3638 | PL_statusvalue_posix = (n); \ | |
3639 | if (PL_statusvalue_posix == -1) \ | |
3640 | PL_statusvalue = -1; \ | |
3641 | else { \ | |
3642 | PL_statusvalue = \ | |
3643 | PL_statusvalue_posix & 0xFFFF; \ | |
3644 | } \ | |
3645 | } STMT_END | |
3646 | # endif | |
3647 | # define STATUS_UNIX_SET(n) \ | |
68dc0745 | 3648 | STMT_START { \ |
3280af22 NIS |
3649 | PL_statusvalue = (n); \ |
3650 | if (PL_statusvalue != -1) \ | |
3651 | PL_statusvalue &= 0xFFFF; \ | |
68dc0745 | 3652 | } STMT_END |
7a7fd8e0 | 3653 | # define STATUS_UNIX_EXIT_SET(n) STATUS_UNIX_SET(n) |
6ac6a52b | 3654 | # define STATUS_EXIT_SET(n) STATUS_UNIX_SET(n) |
e5218da5 | 3655 | # define STATUS_CURRENT STATUS_UNIX |
37038d91 | 3656 | # define STATUS_EXIT STATUS_UNIX |
e5218da5 GA |
3657 | # define STATUS_ALL_SUCCESS (PL_statusvalue = 0, PL_statusvalue_posix = 0) |
3658 | # define STATUS_ALL_FAILURE (PL_statusvalue = 1, PL_statusvalue_posix = 1) | |
68dc0745 PP |
3659 | #endif |
3660 | ||
cc3604b1 GS |
3661 | /* flags in PL_exit_flags for nature of exit() */ |
3662 | #define PERL_EXIT_EXPECTED 0x01 | |
31d77e54 | 3663 | #define PERL_EXIT_DESTRUCT_END 0x02 /* Run END in perl_destruct */ |
6136213b JGM |
3664 | #define PERL_EXIT_WARN 0x04 /* Warn if Perl_my_exit() or Perl_my_failure_exit() called */ |
3665 | #define PERL_EXIT_ABORT 0x08 /* Call abort() if Perl_my_exit() or Perl_my_failure_exit() called */ | |
cc3604b1 | 3666 | |
b79b76e0 | 3667 | #ifndef PERL_CORE |
a7cb1f99 | 3668 | /* format to use for version numbers in file/directory names */ |
273cf8d1 | 3669 | /* XXX move to Configure? */ |
b79b76e0 NC |
3670 | /* This was only ever used for the current version, and that can be done at |
3671 | compile time, as PERL_FS_VERSION, so should we just delete it? */ | |
3672 | # ifndef PERL_FS_VER_FMT | |
3673 | # define PERL_FS_VER_FMT "%d.%d.%d" | |
3674 | # endif | |
3675 | #endif | |
3676 | ||
3677 | #ifndef PERL_FS_VERSION | |
3678 | # define PERL_FS_VERSION PERL_VERSION_STRING | |
0b94c7bb GS |
3679 | #endif |
3680 | ||
45bc9206 | 3681 | /* This defines a way to flush all output buffers. This may be a |
76549fef JH |
3682 | * performance issue, so we allow people to disable it. Also, if |
3683 | * we are using stdio, there are broken implementations of fflush(NULL) | |
3684 | * out there, Solaris being the most prominent. | |
45bc9206 GS |
3685 | */ |
3686 | #ifndef PERL_FLUSHALL_FOR_CHILD | |
97cb92d6 | 3687 | # if defined(USE_PERLIO) || defined(FFLUSH_NULL) |
66fe083f | 3688 | # define PERL_FLUSHALL_FOR_CHILD PerlIO_flush((PerlIO*)NULL) |
da5fdda8 AC |
3689 | # elif defined(FFLUSH_ALL) |
3690 | # define PERL_FLUSHALL_FOR_CHILD my_fflush_all() | |
767df6a1 | 3691 | # else |
da5fdda8 | 3692 | # define PERL_FLUSHALL_FOR_CHILD NOOP |
66fe083f | 3693 | # endif |
45bc9206 GS |
3694 | #endif |
3695 | ||
7766f137 GS |
3696 | #ifndef PERL_WAIT_FOR_CHILDREN |
3697 | # define PERL_WAIT_FOR_CHILDREN NOOP | |
3698 | #endif | |
3699 | ||
ba869deb | 3700 | /* the traditional thread-unsafe notion of "current interpreter". */ |
c5be433b GS |
3701 | #ifndef PERL_SET_INTERP |
3702 | # define PERL_SET_INTERP(i) (PL_curinterp = (PerlInterpreter*)(i)) | |
3703 | #endif | |
3704 | ||
3705 | #ifndef PERL_GET_INTERP | |
3706 | # define PERL_GET_INTERP (PL_curinterp) | |
3707 | #endif | |
3708 | ||
54aff467 | 3709 | #if defined(PERL_IMPLICIT_CONTEXT) && !defined(PERL_GET_THX) |
54aff467 | 3710 | # ifdef MULTIPLICITY |
ba869deb | 3711 | # define PERL_GET_THX ((PerlInterpreter *)PERL_GET_CONTEXT) |
54aff467 | 3712 | # endif |
ba869deb GS |
3713 | # define PERL_SET_THX(t) PERL_SET_CONTEXT(t) |
3714 | #endif | |
3715 | ||
00f254e2 | 3716 | /* |
8896765a | 3717 | This replaces the previous %_ "hack" by the "%p" hacks. |
0dbb1585 | 3718 | All that is required is that the perl source does not |
00f254e2 KW |
3719 | use "%-p" or "%-<number>p" or "%<number>p" formats. |
3720 | These formats will still work in perl code. | |
486ec47a | 3721 | See comments in sv.c for further details. |
8896765a | 3722 | |
8896765a | 3723 | Robin Barker 2005-07-14 |
f46d31f2 | 3724 | |
00f254e2 | 3725 | No longer use %1p for VDf = %vd. RMB 2007-10-19 |
0dbb1585 | 3726 | */ |
8896765a RB |
3727 | |
3728 | #ifndef SVf_ | |
63ce7bf0 | 3729 | # define SVf_(n) "-" STRINGIFY(n) "p" |
894356b3 GS |
3730 | #endif |
3731 | ||
8896765a | 3732 | #ifndef SVf |
104abab4 | 3733 | # define SVf "-p" |
d2560b70 RB |
3734 | #endif |
3735 | ||
014ead4b | 3736 | #ifndef SVf32 |
8896765a | 3737 | # define SVf32 SVf_(32) |
014ead4b RB |
3738 | #endif |
3739 | ||
3740 | #ifndef SVf256 | |
8896765a RB |
3741 | # define SVf256 SVf_(256) |
3742 | #endif | |
3743 | ||
be2597df MHM |
3744 | #define SVfARG(p) ((void*)(p)) |
3745 | ||
20023040 FC |
3746 | #ifndef HEKf |
3747 | # define HEKf "2p" | |
3748 | #endif | |
3749 | ||
b8fa5213 FC |
3750 | /* Not ideal, but we cannot easily include a number in an already-numeric |
3751 | * format sequence. */ | |
3752 | #ifndef HEKf256 | |
3753 | # define HEKf256 "3p" | |
3754 | #endif | |
3755 | ||
20023040 FC |
3756 | #define HEKfARG(p) ((void*)(p)) |
3757 | ||
5c29a976 KW |
3758 | /* Documented in perlguts |
3759 | * | |
eafff229 KW |
3760 | * %4p is a custom format |
3761 | */ | |
b17a0679 | 3762 | #ifndef UTF8f |
61608bb7 | 3763 | # define UTF8f "d%" UVuf "%4p" |
b17a0679 FC |
3764 | #endif |
3765 | #define UTF8fARG(u,l,p) (int)cBOOL(u), (UV)(l), (void*)(p) | |
3766 | ||
0f94cb1f FC |
3767 | #define PNf UTF8f |
3768 | #define PNfARG(pn) (int)1, (UV)PadnameLEN(pn), (void *)PadnamePV(pn) | |
0d1e9135 | 3769 | |
f46d31f2 | 3770 | #ifdef PER |