Mercurial > repo
comparison perl-5.22.2/sv.h @ 8045:a16537d2fe07
<xfix> tar xf perl-5.22.2.tar.gz # Ah, whatever, I\'m doing it anyway
author | HackBot |
---|---|
date | Sat, 14 May 2016 14:54:38 +0000 |
parents | |
children |
comparison
equal
deleted
inserted
replaced
8044:711c038a7dce | 8045:a16537d2fe07 |
---|---|
1 /* sv.h | |
2 * | |
3 * Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, | |
4 * 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 by Larry Wall and others | |
5 * | |
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. | |
8 * | |
9 */ | |
10 | |
11 #ifdef sv_flags | |
12 #undef sv_flags /* Convex has this in <signal.h> for sigvec() */ | |
13 #endif | |
14 | |
15 /* | |
16 =head1 SV Flags | |
17 | |
18 =for apidoc AmU||svtype | |
19 An enum of flags for Perl types. These are found in the file B<sv.h> | |
20 in the C<svtype> enum. Test these flags with the C<SvTYPE> macro. | |
21 | |
22 The types are: | |
23 | |
24 SVt_NULL | |
25 SVt_IV | |
26 SVt_NV | |
27 SVt_RV | |
28 SVt_PV | |
29 SVt_PVIV | |
30 SVt_PVNV | |
31 SVt_PVMG | |
32 SVt_INVLIST | |
33 SVt_REGEXP | |
34 SVt_PVGV | |
35 SVt_PVLV | |
36 SVt_PVAV | |
37 SVt_PVHV | |
38 SVt_PVCV | |
39 SVt_PVFM | |
40 SVt_PVIO | |
41 | |
42 These are most easily explained from the bottom up. | |
43 | |
44 SVt_PVIO is for I/O objects, SVt_PVFM for formats, SVt_PVCV for | |
45 subroutines, SVt_PVHV for hashes and SVt_PVAV for arrays. | |
46 | |
47 All the others are scalar types, that is, things that can be bound to a | |
48 C<$> variable. For these, the internal types are mostly orthogonal to | |
49 types in the Perl language. | |
50 | |
51 Hence, checking C<< SvTYPE(sv) < SVt_PVAV >> is the best way to see whether | |
52 something is a scalar. | |
53 | |
54 SVt_PVGV represents a typeglob. If !SvFAKE(sv), then it is a real, | |
55 incoercible typeglob. If SvFAKE(sv), then it is a scalar to which a | |
56 typeglob has been assigned. Assigning to it again will stop it from being | |
57 a typeglob. SVt_PVLV represents a scalar that delegates to another scalar | |
58 behind the scenes. It is used, e.g., for the return value of C<substr> and | |
59 for tied hash and array elements. It can hold any scalar value, including | |
60 a typeglob. SVt_REGEXP is for regular | |
61 expressions. SVt_INVLIST is for Perl | |
62 core internal use only. | |
63 | |
64 SVt_PVMG represents a "normal" scalar (not a typeglob, regular expression, | |
65 or delegate). Since most scalars do not need all the internal fields of a | |
66 PVMG, we save memory by allocating smaller structs when possible. All the | |
67 other types are just simpler forms of SVt_PVMG, with fewer internal fields. | |
68 SVt_NULL can only hold undef. SVt_IV can hold undef, an integer, or a | |
69 reference. (SVt_RV is an alias for SVt_IV, which exists for backward | |
70 compatibility.) SVt_NV can hold any of those or a double. SVt_PV can only | |
71 hold undef or a string. SVt_PVIV is a superset of SVt_PV and SVt_IV. | |
72 SVt_PVNV is similar. SVt_PVMG can hold anything SVt_PVNV can hold, but it | |
73 can, but does not have to, be blessed or magical. | |
74 | |
75 =for apidoc AmU||SVt_NULL | |
76 Type flag for scalars. See L</svtype>. | |
77 | |
78 =for apidoc AmU||SVt_IV | |
79 Type flag for scalars. See L</svtype>. | |
80 | |
81 =for apidoc AmU||SVt_NV | |
82 Type flag for scalars. See L</svtype>. | |
83 | |
84 =for apidoc AmU||SVt_PV | |
85 Type flag for scalars. See L</svtype>. | |
86 | |
87 =for apidoc AmU||SVt_PVIV | |
88 Type flag for scalars. See L</svtype>. | |
89 | |
90 =for apidoc AmU||SVt_PVNV | |
91 Type flag for scalars. See L</svtype>. | |
92 | |
93 =for apidoc AmU||SVt_PVMG | |
94 Type flag for scalars. See L</svtype>. | |
95 | |
96 =for apidoc AmU||SVt_INVLIST | |
97 Type flag for scalars. See L</svtype>. | |
98 | |
99 =for apidoc AmU||SVt_REGEXP | |
100 Type flag for regular expressions. See L</svtype>. | |
101 | |
102 =for apidoc AmU||SVt_PVGV | |
103 Type flag for typeglobs. See L</svtype>. | |
104 | |
105 =for apidoc AmU||SVt_PVLV | |
106 Type flag for scalars. See L</svtype>. | |
107 | |
108 =for apidoc AmU||SVt_PVAV | |
109 Type flag for arrays. See L</svtype>. | |
110 | |
111 =for apidoc AmU||SVt_PVHV | |
112 Type flag for hashes. See L</svtype>. | |
113 | |
114 =for apidoc AmU||SVt_PVCV | |
115 Type flag for subroutines. See L</svtype>. | |
116 | |
117 =for apidoc AmU||SVt_PVFM | |
118 Type flag for formats. See L</svtype>. | |
119 | |
120 =for apidoc AmU||SVt_PVIO | |
121 Type flag for I/O objects. See L</svtype>. | |
122 | |
123 =cut | |
124 | |
125 These are ordered so that the simpler types have a lower value; SvUPGRADE | |
126 doesn't allow you to upgrade from a higher numbered type to a lower numbered | |
127 one; also there is code that assumes that anything that has as a PV component | |
128 has a type numbered >= SVt_PV. | |
129 */ | |
130 | |
131 | |
132 typedef enum { | |
133 SVt_NULL, /* 0 */ | |
134 /* BIND was here, before INVLIST replaced it. */ | |
135 SVt_IV, /* 1 */ | |
136 SVt_NV, /* 2 */ | |
137 /* RV was here, before it was merged with IV. */ | |
138 SVt_PV, /* 3 */ | |
139 SVt_INVLIST, /* 4, implemented as a PV */ | |
140 SVt_PVIV, /* 5 */ | |
141 SVt_PVNV, /* 6 */ | |
142 SVt_PVMG, /* 7 */ | |
143 SVt_REGEXP, /* 8 */ | |
144 /* PVBM was here, before BIND replaced it. */ | |
145 SVt_PVGV, /* 9 */ | |
146 SVt_PVLV, /* 10 */ | |
147 SVt_PVAV, /* 11 */ | |
148 SVt_PVHV, /* 12 */ | |
149 SVt_PVCV, /* 13 */ | |
150 SVt_PVFM, /* 14 */ | |
151 SVt_PVIO, /* 15 */ | |
152 SVt_LAST /* keep last in enum. used to size arrays */ | |
153 } svtype; | |
154 | |
155 /* *** any alterations to the SV types above need to be reflected in | |
156 * SVt_MASK and the various PL_valid_types_* tables. As of this writing those | |
157 * tables are in perl.h. There are also two affected names tables in dump.c, | |
158 * one in B.xs, and 'bodies_by_type[]' in sv.c */ | |
159 | |
160 #define SVt_MASK 0xf /* smallest bitmask that covers all types */ | |
161 | |
162 #ifndef PERL_CORE | |
163 /* Although Fast Boyer Moore tables are now being stored in PVGVs, for most | |
164 purposes external code wanting to consider PVBM probably needs to think of | |
165 PVMG instead. */ | |
166 # define SVt_PVBM SVt_PVMG | |
167 /* Anything wanting to create a reference from clean should ensure that it has | |
168 a scalar of type SVt_IV now: */ | |
169 # define SVt_RV SVt_IV | |
170 #endif | |
171 | |
172 /* There is collusion here with sv_clear - sv_clear exits early for SVt_NULL | |
173 so never reaches the clause at the end that uses sv_type_details->body_size | |
174 to determine whether to call safefree(). Hence body_size can be set | |
175 non-zero to record the size of HEs, without fear of bogus frees. */ | |
176 #if defined(PERL_IN_HV_C) || defined(PERL_IN_XS_APITEST) | |
177 #define HE_SVSLOT SVt_NULL | |
178 #endif | |
179 #ifdef PERL_IN_SV_C | |
180 # define SVt_FIRST SVt_NULL /* the type of SV that new_SV() in sv.c returns */ | |
181 #endif | |
182 | |
183 #define PERL_ARENA_ROOTS_SIZE (SVt_LAST) | |
184 | |
185 /* typedefs to eliminate some typing */ | |
186 typedef struct he HE; | |
187 typedef struct hek HEK; | |
188 | |
189 /* Using C's structural equivalence to help emulate C++ inheritance here... */ | |
190 | |
191 /* start with 2 sv-head building blocks */ | |
192 #define _SV_HEAD(ptrtype) \ | |
193 ptrtype sv_any; /* pointer to body */ \ | |
194 U32 sv_refcnt; /* how many references to us */ \ | |
195 U32 sv_flags /* what we are */ | |
196 | |
197 #if NVSIZE <= IVSIZE | |
198 # define _NV_BODYLESS_UNION NV svu_nv; | |
199 #else | |
200 # define _NV_BODYLESS_UNION | |
201 #endif | |
202 | |
203 #define _SV_HEAD_UNION \ | |
204 union { \ | |
205 char* svu_pv; /* pointer to malloced string */ \ | |
206 IV svu_iv; \ | |
207 UV svu_uv; \ | |
208 _NV_BODYLESS_UNION \ | |
209 SV* svu_rv; /* pointer to another SV */ \ | |
210 struct regexp* svu_rx; \ | |
211 SV** svu_array; \ | |
212 HE** svu_hash; \ | |
213 GP* svu_gp; \ | |
214 PerlIO *svu_fp; \ | |
215 } sv_u | |
216 | |
217 | |
218 struct STRUCT_SV { /* struct sv { */ | |
219 _SV_HEAD(void*); | |
220 _SV_HEAD_UNION; | |
221 #ifdef DEBUG_LEAKING_SCALARS | |
222 PERL_BITFIELD32 sv_debug_optype:9; /* the type of OP that allocated us */ | |
223 PERL_BITFIELD32 sv_debug_inpad:1; /* was allocated in a pad for an OP */ | |
224 PERL_BITFIELD32 sv_debug_line:16; /* the line where we were allocated */ | |
225 UV sv_debug_serial; /* serial number of sv allocation */ | |
226 char * sv_debug_file; /* the file where we were allocated */ | |
227 SV * sv_debug_parent; /* what we were cloned from (ithreads)*/ | |
228 #endif | |
229 }; | |
230 | |
231 struct gv { | |
232 _SV_HEAD(XPVGV*); /* pointer to xpvgv body */ | |
233 _SV_HEAD_UNION; | |
234 }; | |
235 | |
236 struct cv { | |
237 _SV_HEAD(XPVCV*); /* pointer to xpvcv body */ | |
238 _SV_HEAD_UNION; | |
239 }; | |
240 | |
241 struct av { | |
242 _SV_HEAD(XPVAV*); /* pointer to xpvav body */ | |
243 _SV_HEAD_UNION; | |
244 }; | |
245 | |
246 struct hv { | |
247 _SV_HEAD(XPVHV*); /* pointer to xpvhv body */ | |
248 _SV_HEAD_UNION; | |
249 }; | |
250 | |
251 struct io { | |
252 _SV_HEAD(XPVIO*); /* pointer to xpvio body */ | |
253 _SV_HEAD_UNION; | |
254 }; | |
255 | |
256 struct p5rx { | |
257 _SV_HEAD(struct regexp*); /* pointer to regexp body */ | |
258 _SV_HEAD_UNION; | |
259 }; | |
260 | |
261 #undef _SV_HEAD | |
262 #undef _SV_HEAD_UNION /* ensure no pollution */ | |
263 | |
264 /* | |
265 =head1 SV Manipulation Functions | |
266 | |
267 =for apidoc Am|U32|SvREFCNT|SV* sv | |
268 Returns the value of the object's reference count. | |
269 | |
270 =for apidoc Am|SV*|SvREFCNT_inc|SV* sv | |
271 Increments the reference count of the given SV, returning the SV. | |
272 | |
273 All of the following SvREFCNT_inc* macros are optimized versions of | |
274 SvREFCNT_inc, and can be replaced with SvREFCNT_inc. | |
275 | |
276 =for apidoc Am|SV*|SvREFCNT_inc_NN|SV* sv | |
277 Same as SvREFCNT_inc, but can only be used if you know I<sv> | |
278 is not NULL. Since we don't have to check the NULLness, it's faster | |
279 and smaller. | |
280 | |
281 =for apidoc Am|void|SvREFCNT_inc_void|SV* sv | |
282 Same as SvREFCNT_inc, but can only be used if you don't need the | |
283 return value. The macro doesn't need to return a meaningful value. | |
284 | |
285 =for apidoc Am|void|SvREFCNT_inc_void_NN|SV* sv | |
286 Same as SvREFCNT_inc, but can only be used if you don't need the return | |
287 value, and you know that I<sv> is not NULL. The macro doesn't need | |
288 to return a meaningful value, or check for NULLness, so it's smaller | |
289 and faster. | |
290 | |
291 =for apidoc Am|SV*|SvREFCNT_inc_simple|SV* sv | |
292 Same as SvREFCNT_inc, but can only be used with expressions without side | |
293 effects. Since we don't have to store a temporary value, it's faster. | |
294 | |
295 =for apidoc Am|SV*|SvREFCNT_inc_simple_NN|SV* sv | |
296 Same as SvREFCNT_inc_simple, but can only be used if you know I<sv> | |
297 is not NULL. Since we don't have to check the NULLness, it's faster | |
298 and smaller. | |
299 | |
300 =for apidoc Am|void|SvREFCNT_inc_simple_void|SV* sv | |
301 Same as SvREFCNT_inc_simple, but can only be used if you don't need the | |
302 return value. The macro doesn't need to return a meaningful value. | |
303 | |
304 =for apidoc Am|void|SvREFCNT_inc_simple_void_NN|SV* sv | |
305 Same as SvREFCNT_inc, but can only be used if you don't need the return | |
306 value, and you know that I<sv> is not NULL. The macro doesn't need | |
307 to return a meaningful value, or check for NULLness, so it's smaller | |
308 and faster. | |
309 | |
310 =for apidoc Am|void|SvREFCNT_dec|SV* sv | |
311 Decrements the reference count of the given SV. I<sv> may be NULL. | |
312 | |
313 =for apidoc Am|void|SvREFCNT_dec_NN|SV* sv | |
314 Same as SvREFCNT_dec, but can only be used if you know I<sv> | |
315 is not NULL. Since we don't have to check the NULLness, it's faster | |
316 and smaller. | |
317 | |
318 =for apidoc Am|svtype|SvTYPE|SV* sv | |
319 Returns the type of the SV. See C<svtype>. | |
320 | |
321 =for apidoc Am|void|SvUPGRADE|SV* sv|svtype type | |
322 Used to upgrade an SV to a more complex form. Uses C<sv_upgrade> to | |
323 perform the upgrade if necessary. See C<svtype>. | |
324 | |
325 =cut | |
326 */ | |
327 | |
328 #define SvANY(sv) (sv)->sv_any | |
329 #define SvFLAGS(sv) (sv)->sv_flags | |
330 #define SvREFCNT(sv) (sv)->sv_refcnt | |
331 | |
332 #define SvREFCNT_inc(sv) S_SvREFCNT_inc(MUTABLE_SV(sv)) | |
333 #define SvREFCNT_inc_simple(sv) SvREFCNT_inc(sv) | |
334 #define SvREFCNT_inc_NN(sv) S_SvREFCNT_inc_NN(MUTABLE_SV(sv)) | |
335 #define SvREFCNT_inc_void(sv) S_SvREFCNT_inc_void(MUTABLE_SV(sv)) | |
336 | |
337 /* These guys don't need the curly blocks */ | |
338 #define SvREFCNT_inc_simple_void(sv) STMT_START { if (sv) SvREFCNT(sv)++; } STMT_END | |
339 #define SvREFCNT_inc_simple_NN(sv) (++(SvREFCNT(sv)),MUTABLE_SV(sv)) | |
340 #define SvREFCNT_inc_void_NN(sv) (void)(++SvREFCNT(MUTABLE_SV(sv))) | |
341 #define SvREFCNT_inc_simple_void_NN(sv) (void)(++SvREFCNT(MUTABLE_SV(sv))) | |
342 | |
343 #define SvREFCNT_dec(sv) S_SvREFCNT_dec(aTHX_ MUTABLE_SV(sv)) | |
344 #define SvREFCNT_dec_NN(sv) S_SvREFCNT_dec_NN(aTHX_ MUTABLE_SV(sv)) | |
345 | |
346 #define SVTYPEMASK 0xff | |
347 #define SvTYPE(sv) ((svtype)((sv)->sv_flags & SVTYPEMASK)) | |
348 | |
349 /* Sadly there are some parts of the core that have pointers to already-freed | |
350 SV heads, and rely on being able to tell that they are now free. So mark | |
351 them all by using a consistent macro. */ | |
352 #define SvIS_FREED(sv) UNLIKELY(((sv)->sv_flags == SVTYPEMASK)) | |
353 | |
354 /* this is defined in this peculiar way to avoid compiler warnings. | |
355 * See the <20121213131428.GD1842@iabyn.com> thread in p5p */ | |
356 #define SvUPGRADE(sv, mt) \ | |
357 ((void)(SvTYPE(sv) >= (mt) || (sv_upgrade(sv, mt),1))) | |
358 | |
359 #define SVf_IOK 0x00000100 /* has valid public integer value */ | |
360 #define SVf_NOK 0x00000200 /* has valid public numeric value */ | |
361 #define SVf_POK 0x00000400 /* has valid public pointer value */ | |
362 #define SVf_ROK 0x00000800 /* has a valid reference pointer */ | |
363 | |
364 #define SVp_IOK 0x00001000 /* has valid non-public integer value */ | |
365 #define SVp_NOK 0x00002000 /* has valid non-public numeric value */ | |
366 #define SVp_POK 0x00004000 /* has valid non-public pointer value */ | |
367 #define SVp_SCREAM 0x00008000 /* method name is DOES */ | |
368 #define SVphv_CLONEABLE SVp_SCREAM /* PVHV (stashes) clone its objects */ | |
369 #define SVpgv_GP SVp_SCREAM /* GV has a valid GP */ | |
370 #define SVprv_PCS_IMPORTED SVp_SCREAM /* RV is a proxy for a constant | |
371 subroutine in another package. Set the | |
372 GvIMPORTED_CV_on() if it needs to be | |
373 expanded to a real GV */ | |
374 #define SVf_PROTECT 0x00010000 /* very read-only */ | |
375 #define SVs_PADTMP 0x00020000 /* in use as tmp */ | |
376 #define SVs_PADSTALE 0x00040000 /* lexical has gone out of scope; | |
377 only used when !PADTMP */ | |
378 #define SVs_TEMP 0x00080000 /* mortal (implies string is stealable) */ | |
379 #define SVs_OBJECT 0x00100000 /* is "blessed" */ | |
380 #define SVs_GMG 0x00200000 /* has magical get method */ | |
381 #define SVs_SMG 0x00400000 /* has magical set method */ | |
382 #define SVs_RMG 0x00800000 /* has random magical methods */ | |
383 | |
384 #define SVf_FAKE 0x01000000 /* 0: glob is just a copy | |
385 1: SV head arena wasn't malloc()ed | |
386 2: For PVCV, whether CvUNIQUE(cv) | |
387 refers to an eval or once only | |
388 [CvEVAL(cv), CvSPECIAL(cv)] | |
389 3: HV: informally reserved by DAPM | |
390 for vtables */ | |
391 #define SVf_OOK 0x02000000 /* has valid offset value. For a PVHV this | |
392 means that a hv_aux struct is present | |
393 after the main array */ | |
394 #define SVf_BREAK 0x04000000 /* refcnt is artificially low - used by | |
395 SVs in final arena cleanup. | |
396 Set in S_regtry on PL_reg_curpm, so that | |
397 perl_destruct will skip it. */ | |
398 #define SVf_READONLY 0x08000000 /* may not be modified */ | |
399 | |
400 | |
401 | |
402 | |
403 #define SVf_THINKFIRST (SVf_READONLY|SVf_PROTECT|SVf_ROK|SVf_FAKE \ | |
404 |SVs_RMG|SVf_IsCOW) | |
405 | |
406 #define SVf_OK (SVf_IOK|SVf_NOK|SVf_POK|SVf_ROK| \ | |
407 SVp_IOK|SVp_NOK|SVp_POK|SVpgv_GP) | |
408 | |
409 #define PRIVSHIFT 4 /* (SVp_?OK >> PRIVSHIFT) == SVf_?OK */ | |
410 | |
411 /* Note that SVf_AMAGIC is now only set on stashes. */ | |
412 #define SVf_AMAGIC 0x10000000 /* has magical overloaded methods */ | |
413 #define SVf_IsCOW 0x10000000 /* copy on write (shared hash key if | |
414 SvLEN == 0) */ | |
415 | |
416 /* Ensure this value does not clash with the GV_ADD* flags in gv.h, or the | |
417 CV_CKPROTO_* flags in op.c, or the padadd_* flags in pad.h: */ | |
418 #define SVf_UTF8 0x20000000 /* SvPV is UTF-8 encoded | |
419 This is also set on RVs whose overloaded | |
420 stringification is UTF-8. This might | |
421 only happen as a side effect of SvPV() */ | |
422 /* PVHV */ | |
423 #define SVphv_SHAREKEYS 0x20000000 /* PVHV keys live on shared string table */ | |
424 | |
425 /* PVAV could probably use 0x2000000 without conflict. I assume that PVFM can | |
426 be UTF-8 encoded, and PVCVs could well have UTF-8 prototypes. PVIOs haven't | |
427 been restructured, so sometimes get used as string buffers. */ | |
428 | |
429 | |
430 /* Some private flags. */ | |
431 | |
432 | |
433 /* The SVp_SCREAM|SVpbm_VALID (0x40008000) combination is up for grabs. | |
434 Formerly it was used for pad names, but now it is available. The core | |
435 is careful to avoid setting both flags. | |
436 | |
437 SVf_POK, SVp_POK also set: | |
438 0x00004400 Normal | |
439 0x0000C400 method name for DOES (SvSCREAM) | |
440 0x40004400 FBM compiled (SvVALID) | |
441 0x4000C400 *** Formerly used for pad names *** | |
442 | |
443 0x00008000 GV with GP | |
444 0x00008800 RV with PCS imported | |
445 */ | |
446 /* PVAV */ | |
447 #define SVpav_REAL 0x40000000 /* free old entries */ | |
448 /* PVHV */ | |
449 #define SVphv_LAZYDEL 0x40000000 /* entry in xhv_eiter must be deleted */ | |
450 /* This is only set true on a PVGV when it's playing "PVBM", but is tested for | |
451 on any regular scalar (anything <= PVLV) */ | |
452 #define SVpbm_VALID 0x40000000 | |
453 /* Only used in toke.c on an SV stored in PL_lex_repl */ | |
454 #define SVrepl_EVAL 0x40000000 /* Replacement part of s///e */ | |
455 | |
456 /* IV, PVIV, PVNV, PVMG, PVGV and (I assume) PVLV */ | |
457 #define SVf_IVisUV 0x80000000 /* use XPVUV instead of XPVIV */ | |
458 /* PVAV */ | |
459 #define SVpav_REIFY 0x80000000 /* can become real */ | |
460 /* PVHV */ | |
461 #define SVphv_HASKFLAGS 0x80000000 /* keys have flag byte after hash */ | |
462 /* PVGV when SVpbm_VALID is true */ | |
463 #define SVpbm_TAIL 0x80000000 | |
464 /* RV upwards. However, SVf_ROK and SVp_IOK are exclusive */ | |
465 #define SVprv_WEAKREF 0x80000000 /* Weak reference */ | |
466 /* pad name vars only */ | |
467 | |
468 #define _XPV_HEAD \ | |
469 HV* xmg_stash; /* class package */ \ | |
470 union _xmgu xmg_u; \ | |
471 STRLEN xpv_cur; /* length of svu_pv as a C string */ \ | |
472 union { \ | |
473 STRLEN xpvlenu_len; /* allocated size */ \ | |
474 char * xpvlenu_pv; /* regexp string */ \ | |
475 } xpv_len_u | |
476 | |
477 #define xpv_len xpv_len_u.xpvlenu_len | |
478 | |
479 union _xnvu { | |
480 NV xnv_nv; /* numeric value, if any */ | |
481 HV * xgv_stash; | |
482 struct { | |
483 U32 xlow; | |
484 U32 xhigh; | |
485 } xpad_cop_seq; /* used by pad.c for cop_sequence */ | |
486 }; | |
487 | |
488 union _xivu { | |
489 IV xivu_iv; /* integer value */ | |
490 UV xivu_uv; | |
491 HEK * xivu_namehek; /* xpvlv, xpvgv: GvNAME */ | |
492 }; | |
493 | |
494 union _xmgu { | |
495 MAGIC* xmg_magic; /* linked list of magicalness */ | |
496 STRLEN xmg_hash_index; /* used while freeing hash entries */ | |
497 }; | |
498 | |
499 struct xpv { | |
500 _XPV_HEAD; | |
501 }; | |
502 | |
503 struct xpviv { | |
504 _XPV_HEAD; | |
505 union _xivu xiv_u; | |
506 }; | |
507 | |
508 #define xiv_iv xiv_u.xivu_iv | |
509 | |
510 struct xpvuv { | |
511 _XPV_HEAD; | |
512 union _xivu xuv_u; | |
513 }; | |
514 | |
515 #define xuv_uv xuv_u.xivu_uv | |
516 | |
517 struct xpvnv { | |
518 _XPV_HEAD; | |
519 union _xivu xiv_u; | |
520 union _xnvu xnv_u; | |
521 }; | |
522 | |
523 /* This structure must match the beginning of struct xpvhv in hv.h. */ | |
524 struct xpvmg { | |
525 _XPV_HEAD; | |
526 union _xivu xiv_u; | |
527 union _xnvu xnv_u; | |
528 }; | |
529 | |
530 struct xpvlv { | |
531 _XPV_HEAD; | |
532 union _xivu xiv_u; | |
533 union _xnvu xnv_u; | |
534 union { | |
535 STRLEN xlvu_targoff; | |
536 SSize_t xlvu_stargoff; | |
537 } xlv_targoff_u; | |
538 STRLEN xlv_targlen; | |
539 SV* xlv_targ; | |
540 char xlv_type; /* k=keys .=pos x=substr v=vec /=join/re | |
541 * y=alem/helem/iter t=tie T=tied HE */ | |
542 char xlv_flags; /* 1 = negative offset 2 = negative len */ | |
543 }; | |
544 | |
545 #define xlv_targoff xlv_targoff_u.xlvu_targoff | |
546 | |
547 struct xpvinvlist { | |
548 _XPV_HEAD; | |
549 IV prev_index; /* caches result of previous invlist_search() */ | |
550 STRLEN iterator; /* Stores where we are in iterating */ | |
551 bool is_offset; /* The data structure for all inversion lists | |
552 begins with an element for code point U+0000. | |
553 If this bool is set, the actual list contains | |
554 that 0; otherwise, the list actually begins | |
555 with the following element. Thus to invert | |
556 the list, merely toggle this flag */ | |
557 }; | |
558 | |
559 /* This structure works in 3 ways - regular scalar, GV with GP, or fast | |
560 Boyer-Moore. */ | |
561 struct xpvgv { | |
562 _XPV_HEAD; | |
563 union _xivu xiv_u; | |
564 union _xnvu xnv_u; | |
565 }; | |
566 | |
567 typedef U32 cv_flags_t; | |
568 | |
569 #define _XPVCV_COMMON \ | |
570 HV * xcv_stash; \ | |
571 union { \ | |
572 OP * xcv_start; \ | |
573 ANY xcv_xsubany; \ | |
574 } xcv_start_u; \ | |
575 union { \ | |
576 OP * xcv_root; \ | |
577 void (*xcv_xsub) (pTHX_ CV*); \ | |
578 } xcv_root_u; \ | |
579 union { \ | |
580 GV * xcv_gv; \ | |
581 HEK * xcv_hek; \ | |
582 } xcv_gv_u; \ | |
583 char * xcv_file; \ | |
584 union { \ | |
585 PADLIST * xcv_padlist; \ | |
586 void * xcv_hscxt; \ | |
587 } xcv_padlist_u; \ | |
588 CV * xcv_outside; \ | |
589 U32 xcv_outside_seq; /* the COP sequence (at the point of our \ | |
590 * compilation) in the lexically enclosing \ | |
591 * sub */ \ | |
592 cv_flags_t xcv_flags; \ | |
593 I32 xcv_depth /* >= 2 indicates recursive call */ | |
594 | |
595 /* This structure must match XPVCV in cv.h */ | |
596 | |
597 struct xpvfm { | |
598 _XPV_HEAD; | |
599 _XPVCV_COMMON; | |
600 }; | |
601 | |
602 | |
603 struct xpvio { | |
604 _XPV_HEAD; | |
605 union _xivu xiv_u; | |
606 /* ifp and ofp are normally the same, but sockets need separate streams */ | |
607 PerlIO * xio_ofp; | |
608 /* Cray addresses everything by word boundaries (64 bits) and | |
609 * code and data pointers cannot be mixed (which is exactly what | |
610 * Perl_filter_add() tries to do with the dirp), hence the | |
611 * following union trick (as suggested by Gurusamy Sarathy). | |
612 * For further information see Geir Johansen's problem report | |
613 * titled [ID 20000612.002] Perl problem on Cray system | |
614 * The any pointer (known as IoANY()) will also be a good place | |
615 * to hang any IO disciplines to. | |
616 */ | |
617 union { | |
618 DIR * xiou_dirp; /* for opendir, readdir, etc */ | |
619 void * xiou_any; /* for alignment */ | |
620 } xio_dirpu; | |
621 /* IV xio_lines is now in IVX $. */ | |
622 IV xio_page; /* $% */ | |
623 IV xio_page_len; /* $= */ | |
624 IV xio_lines_left; /* $- */ | |
625 char * xio_top_name; /* $^ */ | |
626 GV * xio_top_gv; /* $^ */ | |
627 char * xio_fmt_name; /* $~ */ | |
628 GV * xio_fmt_gv; /* $~ */ | |
629 char * xio_bottom_name;/* $^B */ | |
630 GV * xio_bottom_gv; /* $^B */ | |
631 char xio_type; | |
632 U8 xio_flags; | |
633 }; | |
634 | |
635 #define xio_dirp xio_dirpu.xiou_dirp | |
636 #define xio_any xio_dirpu.xiou_any | |
637 | |
638 #define IOf_ARGV 1 /* this fp iterates over ARGV */ | |
639 #define IOf_START 2 /* check for null ARGV and substitute '-' */ | |
640 #define IOf_FLUSH 4 /* this fp wants a flush after write op */ | |
641 #define IOf_DIDTOP 8 /* just did top of form */ | |
642 #define IOf_UNTAINT 16 /* consider this fp (and its data) "safe" */ | |
643 #define IOf_NOLINE 32 /* slurped a pseudo-line from empty file */ | |
644 #define IOf_FAKE_DIRP 64 /* xio_dirp is fake (source filters kludge) | |
645 Also, when this is set, SvPVX() is valid */ | |
646 | |
647 /* The following macros define implementation-independent predicates on SVs. */ | |
648 | |
649 /* | |
650 =for apidoc Am|U32|SvNIOK|SV* sv | |
651 Returns a U32 value indicating whether the SV contains a number, integer or | |
652 double. | |
653 | |
654 =for apidoc Am|U32|SvNIOKp|SV* sv | |
655 Returns a U32 value indicating whether the SV contains a number, integer or | |
656 double. Checks the B<private> setting. Use C<SvNIOK> instead. | |
657 | |
658 =for apidoc Am|void|SvNIOK_off|SV* sv | |
659 Unsets the NV/IV status of an SV. | |
660 | |
661 =for apidoc Am|U32|SvOK|SV* sv | |
662 Returns a U32 value indicating whether the value is defined. This is | |
663 only meaningful for scalars. | |
664 | |
665 =for apidoc Am|U32|SvIOKp|SV* sv | |
666 Returns a U32 value indicating whether the SV contains an integer. Checks | |
667 the B<private> setting. Use C<SvIOK> instead. | |
668 | |
669 =for apidoc Am|U32|SvNOKp|SV* sv | |
670 Returns a U32 value indicating whether the SV contains a double. Checks the | |
671 B<private> setting. Use C<SvNOK> instead. | |
672 | |
673 =for apidoc Am|U32|SvPOKp|SV* sv | |
674 Returns a U32 value indicating whether the SV contains a character string. | |
675 Checks the B<private> setting. Use C<SvPOK> instead. | |
676 | |
677 =for apidoc Am|U32|SvIOK|SV* sv | |
678 Returns a U32 value indicating whether the SV contains an integer. | |
679 | |
680 =for apidoc Am|void|SvIOK_on|SV* sv | |
681 Tells an SV that it is an integer. | |
682 | |
683 =for apidoc Am|void|SvIOK_off|SV* sv | |
684 Unsets the IV status of an SV. | |
685 | |
686 =for apidoc Am|void|SvIOK_only|SV* sv | |
687 Tells an SV that it is an integer and disables all other OK bits. | |
688 | |
689 =for apidoc Am|void|SvIOK_only_UV|SV* sv | |
690 Tells an SV that it is an unsigned integer and disables all other OK bits. | |
691 | |
692 =for apidoc Am|bool|SvIOK_UV|SV* sv | |
693 Returns a boolean indicating whether the SV contains an integer that must be | |
694 interpreted as unsigned. A non-negative integer whose value is within the | |
695 range of both an IV and a UV may be be flagged as either SvUOK or SVIOK. | |
696 | |
697 =for apidoc Am|bool|SvUOK|SV* sv | |
698 Returns a boolean indicating whether the SV contains an integer that must be | |
699 interpreted as unsigned. A non-negative integer whose value is within the | |
700 range of both an IV and a UV may be be flagged as either SvUOK or SVIOK. | |
701 | |
702 =for apidoc Am|bool|SvIOK_notUV|SV* sv | |
703 Returns a boolean indicating whether the SV contains a signed integer. | |
704 | |
705 =for apidoc Am|U32|SvNOK|SV* sv | |
706 Returns a U32 value indicating whether the SV contains a double. | |
707 | |
708 =for apidoc Am|void|SvNOK_on|SV* sv | |
709 Tells an SV that it is a double. | |
710 | |
711 =for apidoc Am|void|SvNOK_off|SV* sv | |
712 Unsets the NV status of an SV. | |
713 | |
714 =for apidoc Am|void|SvNOK_only|SV* sv | |
715 Tells an SV that it is a double and disables all other OK bits. | |
716 | |
717 =for apidoc Am|U32|SvPOK|SV* sv | |
718 Returns a U32 value indicating whether the SV contains a character | |
719 string. | |
720 | |
721 =for apidoc Am|void|SvPOK_on|SV* sv | |
722 Tells an SV that it is a string. | |
723 | |
724 =for apidoc Am|void|SvPOK_off|SV* sv | |
725 Unsets the PV status of an SV. | |
726 | |
727 =for apidoc Am|void|SvPOK_only|SV* sv | |
728 Tells an SV that it is a string and disables all other OK bits. | |
729 Will also turn off the UTF-8 status. | |
730 | |
731 =for apidoc Am|bool|SvVOK|SV* sv | |
732 Returns a boolean indicating whether the SV contains a v-string. | |
733 | |
734 =for apidoc Am|U32|SvOOK|SV* sv | |
735 Returns a U32 indicating whether the pointer to the string buffer is offset. | |
736 This hack is used internally to speed up removal of characters from the | |
737 beginning of a SvPV. When SvOOK is true, then the start of the | |
738 allocated string buffer is actually C<SvOOK_offset()> bytes before SvPVX. | |
739 This offset used to be stored in SvIVX, but is now stored within the spare | |
740 part of the buffer. | |
741 | |
742 =for apidoc Am|U32|SvROK|SV* sv | |
743 Tests if the SV is an RV. | |
744 | |
745 =for apidoc Am|void|SvROK_on|SV* sv | |
746 Tells an SV that it is an RV. | |
747 | |
748 =for apidoc Am|void|SvROK_off|SV* sv | |
749 Unsets the RV status of an SV. | |
750 | |
751 =for apidoc Am|SV*|SvRV|SV* sv | |
752 Dereferences an RV to return the SV. | |
753 | |
754 =for apidoc Am|IV|SvIVX|SV* sv | |
755 Returns the raw value in the SV's IV slot, without checks or conversions. | |
756 Only use when you are sure SvIOK is true. See also C<SvIV()>. | |
757 | |
758 =for apidoc Am|UV|SvUVX|SV* sv | |
759 Returns the raw value in the SV's UV slot, without checks or conversions. | |
760 Only use when you are sure SvIOK is true. See also C<SvUV()>. | |
761 | |
762 =for apidoc Am|NV|SvNVX|SV* sv | |
763 Returns the raw value in the SV's NV slot, without checks or conversions. | |
764 Only use when you are sure SvNOK is true. See also C<SvNV()>. | |
765 | |
766 =for apidoc Am|char*|SvPVX|SV* sv | |
767 Returns a pointer to the physical string in the SV. The SV must contain a | |
768 string. Prior to 5.9.3 it is not safe | |
769 to execute this macro unless the SV's | |
770 type >= SVt_PV. | |
771 | |
772 This is also used to store the name of an autoloaded subroutine in an XS | |
773 AUTOLOAD routine. See L<perlguts/Autoloading with XSUBs>. | |
774 | |
775 =for apidoc Am|STRLEN|SvCUR|SV* sv | |
776 Returns the length of the string which is in the SV. See C<SvLEN>. | |
777 | |
778 =for apidoc Am|STRLEN|SvLEN|SV* sv | |
779 Returns the size of the string buffer in the SV, not including any part | |
780 attributable to C<SvOOK>. See C<SvCUR>. | |
781 | |
782 =for apidoc Am|char*|SvEND|SV* sv | |
783 Returns a pointer to the spot just after the last character in | |
784 the string which is in the SV, where there is usually a trailing | |
785 C<NUL> character (even though Perl scalars do not strictly require it). | |
786 See C<SvCUR>. Access the character as *(SvEND(sv)). | |
787 | |
788 Warning: If C<SvCUR> is equal to C<SvLEN>, then C<SvEND> points to | |
789 unallocated memory. | |
790 | |
791 =for apidoc Am|HV*|SvSTASH|SV* sv | |
792 Returns the stash of the SV. | |
793 | |
794 =for apidoc Am|void|SvIV_set|SV* sv|IV val | |
795 Set the value of the IV pointer in sv to val. It is possible to perform | |
796 the same function of this macro with an lvalue assignment to C<SvIVX>. | |
797 With future Perls, however, it will be more efficient to use | |
798 C<SvIV_set> instead of the lvalue assignment to C<SvIVX>. | |
799 | |
800 =for apidoc Am|void|SvNV_set|SV* sv|NV val | |
801 Set the value of the NV pointer in sv to val. See C<SvIV_set>. | |
802 | |
803 =for apidoc Am|void|SvPV_set|SV* sv|char* val | |
804 This is probably not what you want to use, you probably wanted | |
805 L</sv_usepvn_flags> or L</sv_setpvn> or L</sv_setpvs>. | |
806 | |
807 Set the value of the PV pointer in C<sv> to the Perl allocated | |
808 C<NUL>-terminated string C<val>. See also C<SvIV_set>. | |
809 | |
810 Remember to free the previous PV buffer. There are many things to check. | |
811 Beware that the existing pointer may be involved in copy-on-write or other | |
812 mischief, so do C<SvOOK_off(sv)> and use C<sv_force_normal> or | |
813 C<SvPV_force> (or check the SvIsCOW flag) first to make sure this | |
814 modification is safe. Then finally, if it is not a COW, call C<SvPV_free> to | |
815 free the previous PV buffer. | |
816 | |
817 =for apidoc Am|void|SvUV_set|SV* sv|UV val | |
818 Set the value of the UV pointer in sv to val. See C<SvIV_set>. | |
819 | |
820 =for apidoc Am|void|SvRV_set|SV* sv|SV* val | |
821 Set the value of the RV pointer in sv to val. See C<SvIV_set>. | |
822 | |
823 =for apidoc Am|void|SvMAGIC_set|SV* sv|MAGIC* val | |
824 Set the value of the MAGIC pointer in sv to val. See C<SvIV_set>. | |
825 | |
826 =for apidoc Am|void|SvSTASH_set|SV* sv|HV* val | |
827 Set the value of the STASH pointer in sv to val. See C<SvIV_set>. | |
828 | |
829 =for apidoc Am|void|SvCUR_set|SV* sv|STRLEN len | |
830 Set the current length of the string which is in the SV. See C<SvCUR> | |
831 and C<SvIV_set>. | |
832 | |
833 =for apidoc Am|void|SvLEN_set|SV* sv|STRLEN len | |
834 Set the size of the string buffer for the SV. See C</SvLEN>. | |
835 | |
836 =cut | |
837 */ | |
838 | |
839 #define SvNIOK(sv) (SvFLAGS(sv) & (SVf_IOK|SVf_NOK)) | |
840 #define SvNIOKp(sv) (SvFLAGS(sv) & (SVp_IOK|SVp_NOK)) | |
841 #define SvNIOK_off(sv) (SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK| \ | |
842 SVp_IOK|SVp_NOK|SVf_IVisUV)) | |
843 | |
844 #define assert_not_ROK(sv) assert_(!SvROK(sv) || !SvRV(sv)) | |
845 #define assert_not_glob(sv) assert_(!isGV_with_GP(sv)) | |
846 | |
847 #define SvOK(sv) (SvFLAGS(sv) & SVf_OK || isREGEXP(sv)) | |
848 #define SvOK_off(sv) (assert_not_ROK(sv) assert_not_glob(sv) \ | |
849 SvFLAGS(sv) &= ~(SVf_OK| \ | |
850 SVf_IVisUV|SVf_UTF8), \ | |
851 SvOOK_off(sv)) | |
852 #define SvOK_off_exc_UV(sv) (assert_not_ROK(sv) \ | |
853 SvFLAGS(sv) &= ~(SVf_OK| \ | |
854 SVf_UTF8), \ | |
855 SvOOK_off(sv)) | |
856 | |
857 #define SvOKp(sv) (SvFLAGS(sv) & (SVp_IOK|SVp_NOK|SVp_POK)) | |
858 #define SvIOKp(sv) (SvFLAGS(sv) & SVp_IOK) | |
859 #define SvIOKp_on(sv) (assert_not_glob(sv) SvRELEASE_IVX_(sv) \ | |
860 SvFLAGS(sv) |= SVp_IOK) | |
861 #define SvNOKp(sv) (SvFLAGS(sv) & SVp_NOK) | |
862 #define SvNOKp_on(sv) (assert_not_glob(sv) SvFLAGS(sv) |= SVp_NOK) | |
863 #define SvPOKp(sv) (SvFLAGS(sv) & SVp_POK) | |
864 #define SvPOKp_on(sv) (assert_not_ROK(sv) assert_not_glob(sv) \ | |
865 SvFLAGS(sv) |= SVp_POK) | |
866 | |
867 #define SvIOK(sv) (SvFLAGS(sv) & SVf_IOK) | |
868 #define SvIOK_on(sv) (assert_not_glob(sv) SvRELEASE_IVX_(sv) \ | |
869 SvFLAGS(sv) |= (SVf_IOK|SVp_IOK)) | |
870 #define SvIOK_off(sv) (SvFLAGS(sv) &= ~(SVf_IOK|SVp_IOK|SVf_IVisUV)) | |
871 #define SvIOK_only(sv) (SvOK_off(sv), \ | |
872 SvFLAGS(sv) |= (SVf_IOK|SVp_IOK)) | |
873 #define SvIOK_only_UV(sv) (assert_not_glob(sv) SvOK_off_exc_UV(sv), \ | |
874 SvFLAGS(sv) |= (SVf_IOK|SVp_IOK)) | |
875 | |
876 #define SvIOK_UV(sv) ((SvFLAGS(sv) & (SVf_IOK|SVf_IVisUV)) \ | |
877 == (SVf_IOK|SVf_IVisUV)) | |
878 #define SvUOK(sv) SvIOK_UV(sv) | |
879 #define SvIOK_notUV(sv) ((SvFLAGS(sv) & (SVf_IOK|SVf_IVisUV)) \ | |
880 == SVf_IOK) | |
881 | |
882 #define SvIsUV(sv) (SvFLAGS(sv) & SVf_IVisUV) | |
883 #define SvIsUV_on(sv) (SvFLAGS(sv) |= SVf_IVisUV) | |
884 #define SvIsUV_off(sv) (SvFLAGS(sv) &= ~SVf_IVisUV) | |
885 | |
886 #define SvNOK(sv) (SvFLAGS(sv) & SVf_NOK) | |
887 #define SvNOK_on(sv) (assert_not_glob(sv) \ | |
888 SvFLAGS(sv) |= (SVf_NOK|SVp_NOK)) | |
889 #define SvNOK_off(sv) (SvFLAGS(sv) &= ~(SVf_NOK|SVp_NOK)) | |
890 #define SvNOK_only(sv) (SvOK_off(sv), \ | |
891 SvFLAGS(sv) |= (SVf_NOK|SVp_NOK)) | |
892 | |
893 /* | |
894 =for apidoc Am|U32|SvUTF8|SV* sv | |
895 Returns a U32 value indicating the UTF-8 status of an SV. If things are set-up | |
896 properly, this indicates whether or not the SV contains UTF-8 encoded data. | |
897 You should use this I<after> a call to SvPV() or one of its variants, in | |
898 case any call to string overloading updates the internal flag. | |
899 | |
900 If you want to take into account the L<bytes> pragma, use C<L</DO_UTF8>> | |
901 instead. | |
902 | |
903 =for apidoc Am|void|SvUTF8_on|SV *sv | |
904 Turn on the UTF-8 status of an SV (the data is not changed, just the flag). | |
905 Do not use frivolously. | |
906 | |
907 =for apidoc Am|void|SvUTF8_off|SV *sv | |
908 Unsets the UTF-8 status of an SV (the data is not changed, just the flag). | |
909 Do not use frivolously. | |
910 | |
911 =for apidoc Am|void|SvPOK_only_UTF8|SV* sv | |
912 Tells an SV that it is a string and disables all other OK bits, | |
913 and leaves the UTF-8 status as it was. | |
914 | |
915 =cut | |
916 */ | |
917 | |
918 /* Ensure the return value of this macro does not clash with the GV_ADD* flags | |
919 in gv.h: */ | |
920 #define SvUTF8(sv) (SvFLAGS(sv) & SVf_UTF8) | |
921 #define SvUTF8_on(sv) (SvFLAGS(sv) |= (SVf_UTF8)) | |
922 #define SvUTF8_off(sv) (SvFLAGS(sv) &= ~(SVf_UTF8)) | |
923 | |
924 #define SvPOK(sv) (SvFLAGS(sv) & SVf_POK) | |
925 #define SvPOK_on(sv) (assert_not_ROK(sv) assert_not_glob(sv) \ | |
926 SvFLAGS(sv) |= (SVf_POK|SVp_POK)) | |
927 #define SvPOK_off(sv) (SvFLAGS(sv) &= ~(SVf_POK|SVp_POK)) | |
928 #define SvPOK_only(sv) (assert_not_ROK(sv) assert_not_glob(sv) \ | |
929 SvFLAGS(sv) &= ~(SVf_OK| \ | |
930 SVf_IVisUV|SVf_UTF8), \ | |
931 SvFLAGS(sv) |= (SVf_POK|SVp_POK)) | |
932 #define SvPOK_only_UTF8(sv) (assert_not_ROK(sv) assert_not_glob(sv) \ | |
933 SvFLAGS(sv) &= ~(SVf_OK| \ | |
934 SVf_IVisUV), \ | |
935 SvFLAGS(sv) |= (SVf_POK|SVp_POK)) | |
936 | |
937 #define SvVOK(sv) (SvMAGICAL(sv) \ | |
938 && mg_find(sv,PERL_MAGIC_vstring)) | |
939 /* returns the vstring magic, if any */ | |
940 #define SvVSTRING_mg(sv) (SvMAGICAL(sv) \ | |
941 ? mg_find(sv,PERL_MAGIC_vstring) : NULL) | |
942 | |
943 #define SvOOK(sv) (SvFLAGS(sv) & SVf_OOK) | |
944 #define SvOOK_on(sv) (SvFLAGS(sv) |= SVf_OOK) | |
945 #define SvOOK_off(sv) ((void)(SvOOK(sv) && sv_backoff(sv))) | |
946 | |
947 #define SvFAKE(sv) (SvFLAGS(sv) & SVf_FAKE) | |
948 #define SvFAKE_on(sv) (SvFLAGS(sv) |= SVf_FAKE) | |
949 #define SvFAKE_off(sv) (SvFLAGS(sv) &= ~SVf_FAKE) | |
950 | |
951 #define SvROK(sv) (SvFLAGS(sv) & SVf_ROK) | |
952 #define SvROK_on(sv) (SvFLAGS(sv) |= SVf_ROK) | |
953 #define SvROK_off(sv) (SvFLAGS(sv) &= ~(SVf_ROK)) | |
954 | |
955 #define SvMAGICAL(sv) (SvFLAGS(sv) & (SVs_GMG|SVs_SMG|SVs_RMG)) | |
956 #define SvMAGICAL_on(sv) (SvFLAGS(sv) |= (SVs_GMG|SVs_SMG|SVs_RMG)) | |
957 #define SvMAGICAL_off(sv) (SvFLAGS(sv) &= ~(SVs_GMG|SVs_SMG|SVs_RMG)) | |
958 | |
959 #define SvGMAGICAL(sv) (SvFLAGS(sv) & SVs_GMG) | |
960 #define SvGMAGICAL_on(sv) (SvFLAGS(sv) |= SVs_GMG) | |
961 #define SvGMAGICAL_off(sv) (SvFLAGS(sv) &= ~SVs_GMG) | |
962 | |
963 #define SvSMAGICAL(sv) (SvFLAGS(sv) & SVs_SMG) | |
964 #define SvSMAGICAL_on(sv) (SvFLAGS(sv) |= SVs_SMG) | |
965 #define SvSMAGICAL_off(sv) (SvFLAGS(sv) &= ~SVs_SMG) | |
966 | |
967 #define SvRMAGICAL(sv) (SvFLAGS(sv) & SVs_RMG) | |
968 #define SvRMAGICAL_on(sv) (SvFLAGS(sv) |= SVs_RMG) | |
969 #define SvRMAGICAL_off(sv) (SvFLAGS(sv) &= ~SVs_RMG) | |
970 | |
971 #define SvAMAGIC(sv) (SvROK(sv) && SvOBJECT(SvRV(sv)) && \ | |
972 HvAMAGIC(SvSTASH(SvRV(sv)))) | |
973 | |
974 /* To be used on the stashes themselves: */ | |
975 #define HvAMAGIC(hv) (SvFLAGS(hv) & SVf_AMAGIC) | |
976 #define HvAMAGIC_on(hv) (SvFLAGS(hv) |= SVf_AMAGIC) | |
977 #define HvAMAGIC_off(hv) (SvFLAGS(hv) &=~ SVf_AMAGIC) | |
978 | |
979 | |
980 /* "nog" means "doesn't have get magic" */ | |
981 #define SvPOK_nog(sv) ((SvFLAGS(sv) & (SVf_POK|SVs_GMG)) == SVf_POK) | |
982 #define SvIOK_nog(sv) ((SvFLAGS(sv) & (SVf_IOK|SVs_GMG)) == SVf_IOK) | |
983 #define SvUOK_nog(sv) ((SvFLAGS(sv) & (SVf_IOK|SVf_IVisUV|SVs_GMG)) == (SVf_IOK|SVf_IVisUV)) | |
984 #define SvNOK_nog(sv) ((SvFLAGS(sv) & (SVf_NOK|SVs_GMG)) == SVf_NOK) | |
985 #define SvNIOK_nog(sv) (SvNIOK(sv) && !(SvFLAGS(sv) & SVs_GMG)) | |
986 | |
987 #define SvPOK_nogthink(sv) ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST|SVs_GMG)) == SVf_POK) | |
988 #define SvIOK_nogthink(sv) ((SvFLAGS(sv) & (SVf_IOK|SVf_THINKFIRST|SVs_GMG)) == SVf_IOK) | |
989 #define SvUOK_nogthink(sv) ((SvFLAGS(sv) & (SVf_IOK|SVf_IVisUV|SVf_THINKFIRST|SVs_GMG)) == (SVf_IOK|SVf_IVisUV)) | |
990 #define SvNOK_nogthink(sv) ((SvFLAGS(sv) & (SVf_NOK|SVf_THINKFIRST|SVs_GMG)) == SVf_NOK) | |
991 #define SvNIOK_nogthink(sv) (SvNIOK(sv) && !(SvFLAGS(sv) & (SVf_THINKFIRST|SVs_GMG))) | |
992 | |
993 #define SvPOK_utf8_nog(sv) ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8|SVs_GMG)) == (SVf_POK|SVf_UTF8)) | |
994 #define SvPOK_utf8_nogthink(sv) ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8|SVf_THINKFIRST|SVs_GMG)) == (SVf_POK|SVf_UTF8)) | |
995 | |
996 #define SvPOK_byte_nog(sv) ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8|SVs_GMG)) == SVf_POK) | |
997 #define SvPOK_byte_nogthink(sv) ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8|SVf_THINKFIRST|SVs_GMG)) == SVf_POK) | |
998 | |
999 #define SvPOK_pure_nogthink(sv) \ | |
1000 ((SvFLAGS(sv) & (SVf_POK|SVf_IOK|SVf_NOK|SVf_ROK|SVpgv_GP|SVf_THINKFIRST|SVs_GMG)) == SVf_POK) | |
1001 #define SvPOK_utf8_pure_nogthink(sv) \ | |
1002 ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8|SVf_IOK|SVf_NOK|SVf_ROK|SVpgv_GP|SVf_THINKFIRST|SVs_GMG)) == (SVf_POK|SVf_UTF8)) | |
1003 #define SvPOK_byte_pure_nogthink(sv) \ | |
1004 ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8|SVf_IOK|SVf_NOK|SVf_ROK|SVpgv_GP|SVf_THINKFIRST|SVs_GMG)) == SVf_POK) | |
1005 | |
1006 /* | |
1007 =for apidoc Am|U32|SvGAMAGIC|SV* sv | |
1008 | |
1009 Returns true if the SV has get magic or | |
1010 overloading. If either is true then | |
1011 the scalar is active data, and has the potential to return a new value every | |
1012 time it is accessed. Hence you must be careful to | |
1013 only read it once per user logical operation and work | |
1014 with that returned value. If neither is true then | |
1015 the scalar's value cannot change unless written to. | |
1016 | |
1017 =cut | |
1018 */ | |
1019 | |
1020 #define SvGAMAGIC(sv) (SvGMAGICAL(sv) || SvAMAGIC(sv)) | |
1021 | |
1022 #define Gv_AMG(stash) \ | |
1023 (HvNAME(stash) && Gv_AMupdate(stash,FALSE) \ | |
1024 ? 1 \ | |
1025 : (HvAMAGIC_off(stash), 0)) | |
1026 | |
1027 #define SvWEAKREF(sv) ((SvFLAGS(sv) & (SVf_ROK|SVprv_WEAKREF)) \ | |
1028 == (SVf_ROK|SVprv_WEAKREF)) | |
1029 #define SvWEAKREF_on(sv) (SvFLAGS(sv) |= (SVf_ROK|SVprv_WEAKREF)) | |
1030 #define SvWEAKREF_off(sv) (SvFLAGS(sv) &= ~(SVf_ROK|SVprv_WEAKREF)) | |
1031 | |
1032 #define SvPCS_IMPORTED(sv) ((SvFLAGS(sv) & (SVf_ROK|SVprv_PCS_IMPORTED)) \ | |
1033 == (SVf_ROK|SVprv_PCS_IMPORTED)) | |
1034 #define SvPCS_IMPORTED_on(sv) (SvFLAGS(sv) |= (SVf_ROK|SVprv_PCS_IMPORTED)) | |
1035 #define SvPCS_IMPORTED_off(sv) (SvFLAGS(sv) &= ~(SVf_ROK|SVprv_PCS_IMPORTED)) | |
1036 | |
1037 /* | |
1038 =for apidoc m|U32|SvTHINKFIRST|SV *sv | |
1039 | |
1040 A quick flag check to see whether an sv should be passed to sv_force_normal | |
1041 to be "downgraded" before SvIVX or SvPVX can be modified directly. | |
1042 | |
1043 For example, if your scalar is a reference and you want to modify the SvIVX | |
1044 slot, you can't just do SvROK_off, as that will leak the referent. | |
1045 | |
1046 This is used internally by various sv-modifying functions, such as | |
1047 sv_setsv, sv_setiv and sv_pvn_force. | |
1048 | |
1049 One case that this does not handle is a gv without SvFAKE set. After | |
1050 | |
1051 if (SvTHINKFIRST(gv)) sv_force_normal(gv); | |
1052 | |
1053 it will still be a gv. | |
1054 | |
1055 SvTHINKFIRST sometimes produces false positives. In those cases | |
1056 sv_force_normal does nothing. | |
1057 | |
1058 =cut | |
1059 */ | |
1060 | |
1061 #define SvTHINKFIRST(sv) (SvFLAGS(sv) & SVf_THINKFIRST) | |
1062 | |
1063 #define SVs_PADMY 0 | |
1064 #define SvPADMY(sv) !(SvFLAGS(sv) & SVs_PADTMP) | |
1065 #ifndef PERL_CORE | |
1066 # define SvPADMY_on(sv) SvPADTMP_off(sv) | |
1067 #endif | |
1068 | |
1069 #define SvPADTMP(sv) (SvFLAGS(sv) & (SVs_PADTMP)) | |
1070 #define SvPADSTALE(sv) (SvFLAGS(sv) & (SVs_PADSTALE)) | |
1071 | |
1072 #define SvPADTMP_on(sv) (SvFLAGS(sv) |= SVs_PADTMP) | |
1073 #define SvPADTMP_off(sv) (SvFLAGS(sv) &= ~SVs_PADTMP) | |
1074 #define SvPADSTALE_on(sv) S_SvPADSTALE_on(MUTABLE_SV(sv)) | |
1075 #define SvPADSTALE_off(sv) S_SvPADSTALE_off(MUTABLE_SV(sv)) | |
1076 | |
1077 #define SvTEMP(sv) (SvFLAGS(sv) & SVs_TEMP) | |
1078 #define SvTEMP_on(sv) (SvFLAGS(sv) |= SVs_TEMP) | |
1079 #define SvTEMP_off(sv) (SvFLAGS(sv) &= ~SVs_TEMP) | |
1080 | |
1081 #define SvOBJECT(sv) (SvFLAGS(sv) & SVs_OBJECT) | |
1082 #define SvOBJECT_on(sv) (SvFLAGS(sv) |= SVs_OBJECT) | |
1083 #define SvOBJECT_off(sv) (SvFLAGS(sv) &= ~SVs_OBJECT) | |
1084 | |
1085 #define SvREADONLY(sv) (SvFLAGS(sv) & (SVf_READONLY|SVf_PROTECT)) | |
1086 #ifdef PERL_CORE | |
1087 # define SvREADONLY_on(sv) (SvFLAGS(sv) |= (SVf_READONLY|SVf_PROTECT)) | |
1088 # define SvREADONLY_off(sv) (SvFLAGS(sv) &=~(SVf_READONLY|SVf_PROTECT)) | |
1089 #else | |
1090 # define SvREADONLY_on(sv) (SvFLAGS(sv) |= SVf_READONLY) | |
1091 # define SvREADONLY_off(sv) (SvFLAGS(sv) &= ~SVf_READONLY) | |
1092 #endif | |
1093 | |
1094 #define SvSCREAM(sv) ((SvFLAGS(sv) & (SVp_SCREAM|SVp_POK)) == (SVp_SCREAM|SVp_POK)) | |
1095 #define SvSCREAM_on(sv) (SvFLAGS(sv) |= SVp_SCREAM) | |
1096 #define SvSCREAM_off(sv) (SvFLAGS(sv) &= ~SVp_SCREAM) | |
1097 | |
1098 #ifndef PERL_CORE | |
1099 # define SvCOMPILED(sv) 0 | |
1100 # define SvCOMPILED_on(sv) | |
1101 # define SvCOMPILED_off(sv) | |
1102 #endif | |
1103 | |
1104 #define SvEVALED(sv) (SvFLAGS(sv) & SVrepl_EVAL) | |
1105 #define SvEVALED_on(sv) (SvFLAGS(sv) |= SVrepl_EVAL) | |
1106 #define SvEVALED_off(sv) (SvFLAGS(sv) &= ~SVrepl_EVAL) | |
1107 | |
1108 #if defined (DEBUGGING) && defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) | |
1109 # define SvVALID(sv) ({ const SV *const _svvalid = (const SV*)(sv); \ | |
1110 if (SvFLAGS(_svvalid) & SVpbm_VALID && !SvSCREAM(_svvalid)) \ | |
1111 assert(!isGV_with_GP(_svvalid)); \ | |
1112 (SvFLAGS(_svvalid) & SVpbm_VALID); \ | |
1113 }) | |
1114 # define SvVALID_on(sv) ({ SV *const _svvalid = MUTABLE_SV(sv); \ | |
1115 assert(!isGV_with_GP(_svvalid)); \ | |
1116 assert(!SvSCREAM(_svvalid)); \ | |
1117 (SvFLAGS(_svvalid) |= SVpbm_VALID); \ | |
1118 }) | |
1119 # define SvVALID_off(sv) ({ SV *const _svvalid = MUTABLE_SV(sv); \ | |
1120 assert(!isGV_with_GP(_svvalid)); \ | |
1121 assert(!SvSCREAM(_svvalid)); \ | |
1122 (SvFLAGS(_svvalid) &= ~SVpbm_VALID); \ | |
1123 }) | |
1124 | |
1125 # define SvTAIL(sv) ({ const SV *const _svtail = (const SV *)(sv); \ | |
1126 assert(SvTYPE(_svtail) != SVt_PVAV); \ | |
1127 assert(SvTYPE(_svtail) != SVt_PVHV); \ | |
1128 assert(!SvSCREAM(_svtail)); \ | |
1129 (SvFLAGS(sv) & (SVpbm_TAIL|SVpbm_VALID)) \ | |
1130 == (SVpbm_TAIL|SVpbm_VALID); \ | |
1131 }) | |
1132 #else | |
1133 # define SvVALID(sv) ((SvFLAGS(sv) & SVpbm_VALID) && !SvSCREAM(sv)) | |
1134 # define SvVALID_on(sv) (SvFLAGS(sv) |= SVpbm_VALID) | |
1135 # define SvVALID_off(sv) (SvFLAGS(sv) &= ~SVpbm_VALID) | |
1136 # define SvTAIL(sv) ((SvFLAGS(sv) & (SVpbm_TAIL|SVpbm_VALID)) \ | |
1137 == (SVpbm_TAIL|SVpbm_VALID)) | |
1138 | |
1139 #endif | |
1140 #define SvTAIL_on(sv) (SvFLAGS(sv) |= SVpbm_TAIL) | |
1141 #define SvTAIL_off(sv) (SvFLAGS(sv) &= ~SVpbm_TAIL) | |
1142 | |
1143 #define SvRVx(sv) SvRV(sv) | |
1144 | |
1145 #ifdef PERL_DEBUG_COW | |
1146 /* Need -0.0 for SvNVX to preserve IEEE FP "negative zero" because | |
1147 +0.0 + -0.0 => +0.0 but -0.0 + -0.0 => -0.0 */ | |
1148 # define SvIVX(sv) (0 + ((XPVIV*) SvANY(sv))->xiv_iv) | |
1149 # define SvUVX(sv) (0 + ((XPVUV*) SvANY(sv))->xuv_uv) | |
1150 # define SvNVX(sv) (-0.0 + ((XPVNV*) SvANY(sv))->xnv_u.xnv_nv) | |
1151 # define SvRV(sv) (0 + (sv)->sv_u.svu_rv) | |
1152 # define SvRV_const(sv) (0 + (sv)->sv_u.svu_rv) | |
1153 /* Don't test the core XS code yet. */ | |
1154 # if defined (PERL_CORE) && PERL_DEBUG_COW > 1 | |
1155 # define SvPVX(sv) (0 + (assert_(!SvREADONLY(sv)) (sv)->sv_u.svu_pv)) | |
1156 # else | |
1157 # define SvPVX(sv) SvPVX_mutable(sv) | |
1158 # endif | |
1159 # define SvCUR(sv) (0 + ((XPV*) SvANY(sv))->xpv_cur) | |
1160 # define SvLEN(sv) (0 + ((XPV*) SvANY(sv))->xpv_len) | |
1161 # define SvEND(sv) ((sv)->sv_u.svu_pv + ((XPV*)SvANY(sv))->xpv_cur) | |
1162 | |
1163 # define SvMAGIC(sv) (0 + *(assert_(SvTYPE(sv) >= SVt_PVMG) &((XPVMG*) SvANY(sv))->xmg_u.xmg_magic)) | |
1164 # define SvSTASH(sv) (0 + *(assert_(SvTYPE(sv) >= SVt_PVMG) &((XPVMG*) SvANY(sv))->xmg_stash)) | |
1165 #else | |
1166 # define SvLEN(sv) ((XPV*) SvANY(sv))->xpv_len | |
1167 # define SvEND(sv) ((sv)->sv_u.svu_pv + ((XPV*)SvANY(sv))->xpv_cur) | |
1168 | |
1169 # if defined (DEBUGGING) && defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) | |
1170 /* These get expanded inside other macros that already use a variable _sv */ | |
1171 # define SvPVX(sv) \ | |
1172 (*({ SV *const _svpvx = MUTABLE_SV(sv); \ | |
1173 assert(PL_valid_types_PVX[SvTYPE(_svpvx) & SVt_MASK]); \ | |
1174 assert(!isGV_with_GP(_svpvx)); \ | |
1175 assert(!(SvTYPE(_svpvx) == SVt_PVIO \ | |
1176 && !(IoFLAGS(_svpvx) & IOf_FAKE_DIRP))); \ | |
1177 &((_svpvx)->sv_u.svu_pv); \ | |
1178 })) | |
1179 # define SvCUR(sv) \ | |
1180 (*({ const SV *const _svcur = (const SV *)(sv); \ | |
1181 assert(PL_valid_types_PVX[SvTYPE(_svcur) & SVt_MASK] \ | |
1182 || SvTYPE(_svcur) == SVt_REGEXP); \ | |
1183 assert(!isGV_with_GP(_svcur)); \ | |
1184 assert(!(SvTYPE(_svcur) == SVt_PVIO \ | |
1185 && !(IoFLAGS(_svcur) & IOf_FAKE_DIRP))); \ | |
1186 &(((XPV*) MUTABLE_PTR(SvANY(_svcur)))->xpv_cur); \ | |
1187 })) | |
1188 # define SvIVX(sv) \ | |
1189 (*({ const SV *const _svivx = (const SV *)(sv); \ | |
1190 assert(PL_valid_types_IVX[SvTYPE(_svivx) & SVt_MASK]); \ | |
1191 assert(!isGV_with_GP(_svivx)); \ | |
1192 &(((XPVIV*) MUTABLE_PTR(SvANY(_svivx)))->xiv_iv); \ | |
1193 })) | |
1194 # define SvUVX(sv) \ | |
1195 (*({ const SV *const _svuvx = (const SV *)(sv); \ | |
1196 assert(PL_valid_types_IVX[SvTYPE(_svuvx) & SVt_MASK]); \ | |
1197 assert(!isGV_with_GP(_svuvx)); \ | |
1198 &(((XPVUV*) MUTABLE_PTR(SvANY(_svuvx)))->xuv_uv); \ | |
1199 })) | |
1200 # define SvNVX(sv) \ | |
1201 (*({ const SV *const _svnvx = (const SV *)(sv); \ | |
1202 assert(PL_valid_types_NVX[SvTYPE(_svnvx) & SVt_MASK]); \ | |
1203 assert(!isGV_with_GP(_svnvx)); \ | |
1204 &(((XPVNV*) MUTABLE_PTR(SvANY(_svnvx)))->xnv_u.xnv_nv); \ | |
1205 })) | |
1206 # define SvRV(sv) \ | |
1207 (*({ SV *const _svrv = MUTABLE_SV(sv); \ | |
1208 assert(PL_valid_types_RV[SvTYPE(_svrv) & SVt_MASK]); \ | |
1209 assert(!isGV_with_GP(_svrv)); \ | |
1210 assert(!(SvTYPE(_svrv) == SVt_PVIO \ | |
1211 && !(IoFLAGS(_svrv) & IOf_FAKE_DIRP))); \ | |
1212 &((_svrv)->sv_u.svu_rv); \ | |
1213 })) | |
1214 # define SvRV_const(sv) \ | |
1215 ({ const SV *const _svrv = (const SV *)(sv); \ | |
1216 assert(PL_valid_types_RV[SvTYPE(_svrv) & SVt_MASK]); \ | |
1217 assert(!isGV_with_GP(_svrv)); \ | |
1218 assert(!(SvTYPE(_svrv) == SVt_PVIO \ | |
1219 && !(IoFLAGS(_svrv) & IOf_FAKE_DIRP))); \ | |
1220 (_svrv)->sv_u.svu_rv; \ | |
1221 }) | |
1222 # define SvMAGIC(sv) \ | |
1223 (*({ const SV *const _svmagic = (const SV *)(sv); \ | |
1224 assert(SvTYPE(_svmagic) >= SVt_PVMG); \ | |
1225 &(((XPVMG*) MUTABLE_PTR(SvANY(_svmagic)))->xmg_u.xmg_magic); \ | |
1226 })) | |
1227 # define SvSTASH(sv) \ | |
1228 (*({ const SV *const _svstash = (const SV *)(sv); \ | |
1229 assert(SvTYPE(_svstash) >= SVt_PVMG); \ | |
1230 &(((XPVMG*) MUTABLE_PTR(SvANY(_svstash)))->xmg_stash); \ | |
1231 })) | |
1232 # else | |
1233 # define SvPVX(sv) ((sv)->sv_u.svu_pv) | |
1234 # define SvCUR(sv) ((XPV*) SvANY(sv))->xpv_cur | |
1235 # define SvIVX(sv) ((XPVIV*) SvANY(sv))->xiv_iv | |
1236 # define SvUVX(sv) ((XPVUV*) SvANY(sv))->xuv_uv | |
1237 # define SvNVX(sv) ((XPVNV*) SvANY(sv))->xnv_u.xnv_nv | |
1238 # define SvRV(sv) ((sv)->sv_u.svu_rv) | |
1239 # define SvRV_const(sv) (0 + (sv)->sv_u.svu_rv) | |
1240 # define SvMAGIC(sv) ((XPVMG*) SvANY(sv))->xmg_u.xmg_magic | |
1241 # define SvSTASH(sv) ((XPVMG*) SvANY(sv))->xmg_stash | |
1242 # endif | |
1243 #endif | |
1244 | |
1245 #ifndef PERL_POISON | |
1246 /* Given that these two are new, there can't be any existing code using them | |
1247 * as LVALUEs */ | |
1248 # define SvPVX_mutable(sv) (0 + (sv)->sv_u.svu_pv) | |
1249 # define SvPVX_const(sv) ((const char*)(0 + (sv)->sv_u.svu_pv)) | |
1250 #else | |
1251 /* Except for the poison code, which uses & to scribble over the pointer after | |
1252 free() is called. */ | |
1253 # define SvPVX_mutable(sv) ((sv)->sv_u.svu_pv) | |
1254 # define SvPVX_const(sv) ((const char*)((sv)->sv_u.svu_pv)) | |
1255 #endif | |
1256 | |
1257 #define SvIVXx(sv) SvIVX(sv) | |
1258 #define SvUVXx(sv) SvUVX(sv) | |
1259 #define SvNVXx(sv) SvNVX(sv) | |
1260 #define SvPVXx(sv) SvPVX(sv) | |
1261 #define SvLENx(sv) SvLEN(sv) | |
1262 #define SvENDx(sv) ((PL_Sv = (sv)), SvEND(PL_Sv)) | |
1263 | |
1264 | |
1265 /* Ask a scalar nicely to try to become an IV, if possible. | |
1266 Not guaranteed to stay returning void */ | |
1267 /* Macro won't actually call sv_2iv if already IOK */ | |
1268 #define SvIV_please(sv) \ | |
1269 STMT_START {if (!SvIOKp(sv) && (SvFLAGS(sv) & (SVf_NOK|SVf_POK))) \ | |
1270 (void) SvIV(sv); } STMT_END | |
1271 #define SvIV_please_nomg(sv) \ | |
1272 (!(SvFLAGS(sv) & (SVf_IOK|SVp_IOK)) && (SvFLAGS(sv) & (SVf_NOK|SVf_POK)) \ | |
1273 ? (sv_2iv_flags(sv, 0), SvIOK(sv)) \ | |
1274 : SvIOK(sv)) | |
1275 #define SvIV_set(sv, val) \ | |
1276 STMT_START { \ | |
1277 assert(PL_valid_types_IV_set[SvTYPE(sv) & SVt_MASK]); \ | |
1278 assert(!isGV_with_GP(sv)); \ | |
1279 (((XPVIV*) SvANY(sv))->xiv_iv = (val)); } STMT_END | |
1280 #define SvNV_set(sv, val) \ | |
1281 STMT_START { \ | |
1282 assert(PL_valid_types_NV_set[SvTYPE(sv) & SVt_MASK]); \ | |
1283 assert(!isGV_with_GP(sv)); \ | |
1284 (((XPVNV*)SvANY(sv))->xnv_u.xnv_nv = (val)); } STMT_END | |
1285 #define SvPV_set(sv, val) \ | |
1286 STMT_START { \ | |
1287 assert(PL_valid_types_PVX[SvTYPE(sv) & SVt_MASK]); \ | |
1288 assert(!isGV_with_GP(sv)); \ | |
1289 assert(!(SvTYPE(sv) == SVt_PVIO \ | |
1290 && !(IoFLAGS(sv) & IOf_FAKE_DIRP))); \ | |
1291 ((sv)->sv_u.svu_pv = (val)); } STMT_END | |
1292 #define SvUV_set(sv, val) \ | |
1293 STMT_START { \ | |
1294 assert(PL_valid_types_IV_set[SvTYPE(sv) & SVt_MASK]); \ | |
1295 assert(!isGV_with_GP(sv)); \ | |
1296 (((XPVUV*)SvANY(sv))->xuv_uv = (val)); } STMT_END | |
1297 #define SvRV_set(sv, val) \ | |
1298 STMT_START { \ | |
1299 assert(PL_valid_types_RV[SvTYPE(sv) & SVt_MASK]); \ | |
1300 assert(!isGV_with_GP(sv)); \ | |
1301 assert(!(SvTYPE(sv) == SVt_PVIO \ | |
1302 && !(IoFLAGS(sv) & IOf_FAKE_DIRP))); \ | |
1303 ((sv)->sv_u.svu_rv = (val)); } STMT_END | |
1304 #define SvMAGIC_set(sv, val) \ | |
1305 STMT_START { assert(SvTYPE(sv) >= SVt_PVMG); \ | |
1306 (((XPVMG*)SvANY(sv))->xmg_u.xmg_magic = (val)); } STMT_END | |
1307 #define SvSTASH_set(sv, val) \ | |
1308 STMT_START { assert(SvTYPE(sv) >= SVt_PVMG); \ | |
1309 (((XPVMG*) SvANY(sv))->xmg_stash = (val)); } STMT_END | |
1310 #define SvCUR_set(sv, val) \ | |
1311 STMT_START { \ | |
1312 assert(PL_valid_types_PVX[SvTYPE(sv) & SVt_MASK] \ | |
1313 || SvTYPE(sv) == SVt_REGEXP); \ | |
1314 assert(!isGV_with_GP(sv)); \ | |
1315 assert(!(SvTYPE(sv) == SVt_PVIO \ | |
1316 && !(IoFLAGS(sv) & IOf_FAKE_DIRP))); \ | |
1317 (((XPV*) SvANY(sv))->xpv_cur = (val)); } STMT_END | |
1318 #define SvLEN_set(sv, val) \ | |
1319 STMT_START { \ | |
1320 assert(PL_valid_types_PVX[SvTYPE(sv) & SVt_MASK]); \ | |
1321 assert(!isGV_with_GP(sv)); \ | |
1322 assert(!(SvTYPE(sv) == SVt_PVIO \ | |
1323 && !(IoFLAGS(sv) & IOf_FAKE_DIRP))); \ | |
1324 (((XPV*) SvANY(sv))->xpv_len = (val)); } STMT_END | |
1325 #define SvEND_set(sv, val) \ | |
1326 STMT_START { assert(SvTYPE(sv) >= SVt_PV); \ | |
1327 SvCUR_set(sv, (val) - SvPVX(sv)); } STMT_END | |
1328 | |
1329 #define SvPV_renew(sv,n) \ | |
1330 STMT_START { SvLEN_set(sv, n); \ | |
1331 SvPV_set((sv), (MEM_WRAP_CHECK_(n,char) \ | |
1332 (char*)saferealloc((Malloc_t)SvPVX(sv), \ | |
1333 (MEM_SIZE)((n))))); \ | |
1334 } STMT_END | |
1335 | |
1336 #define SvPV_shrink_to_cur(sv) STMT_START { \ | |
1337 const STRLEN _lEnGtH = SvCUR(sv) + 1; \ | |
1338 SvPV_renew(sv, _lEnGtH); \ | |
1339 } STMT_END | |
1340 | |
1341 #define SvPV_free(sv) \ | |
1342 STMT_START { \ | |
1343 assert(SvTYPE(sv) >= SVt_PV); \ | |
1344 if (SvLEN(sv)) { \ | |
1345 assert(!SvROK(sv)); \ | |
1346 if(UNLIKELY(SvOOK(sv))) { \ | |
1347 STRLEN zok; \ | |
1348 SvOOK_offset(sv, zok); \ | |
1349 SvPV_set(sv, SvPVX_mutable(sv) - zok); \ | |
1350 SvFLAGS(sv) &= ~SVf_OOK; \ | |
1351 } \ | |
1352 Safefree(SvPVX(sv)); \ | |
1353 } \ | |
1354 } STMT_END | |
1355 | |
1356 #ifdef PERL_CORE | |
1357 /* Code that crops up in three places to take a scalar and ready it to hold | |
1358 a reference */ | |
1359 # define prepare_SV_for_RV(sv) \ | |
1360 STMT_START { \ | |
1361 if (SvTYPE(sv) < SVt_PV && SvTYPE(sv) != SVt_IV) \ | |
1362 sv_upgrade(sv, SVt_IV); \ | |
1363 else if (SvTYPE(sv) >= SVt_PV) { \ | |
1364 SvPV_free(sv); \ | |
1365 SvLEN_set(sv, 0); \ | |
1366 SvCUR_set(sv, 0); \ | |
1367 } \ | |
1368 } STMT_END | |
1369 #endif | |
1370 | |
1371 #ifndef PERL_CORE | |
1372 # define BmFLAGS(sv) (SvTAIL(sv) ? FBMcf_TAIL : 0) | |
1373 #endif | |
1374 | |
1375 #if defined (DEBUGGING) && defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) | |
1376 # define BmUSEFUL(sv) \ | |
1377 (*({ SV *const _bmuseful = MUTABLE_SV(sv); \ | |
1378 assert(SvTYPE(_bmuseful) >= SVt_PVIV); \ | |
1379 assert(SvVALID(_bmuseful)); \ | |
1380 assert(!SvIOK(_bmuseful)); \ | |
1381 &(((XPVIV*) SvANY(_bmuseful))->xiv_u.xivu_iv); \ | |
1382 })) | |
1383 #else | |
1384 # define BmUSEFUL(sv) ((XPVIV*) SvANY(sv))->xiv_u.xivu_iv | |
1385 | |
1386 #endif | |
1387 | |
1388 #ifndef PERL_CORE | |
1389 # define BmRARE(sv) 0 | |
1390 # define BmPREVIOUS(sv) 0 | |
1391 #endif | |
1392 | |
1393 #define FmLINES(sv) ((XPVIV*) SvANY(sv))->xiv_iv | |
1394 | |
1395 #define LvTYPE(sv) ((XPVLV*) SvANY(sv))->xlv_type | |
1396 #define LvTARG(sv) ((XPVLV*) SvANY(sv))->xlv_targ | |
1397 #define LvTARGOFF(sv) ((XPVLV*) SvANY(sv))->xlv_targoff | |
1398 #define LvSTARGOFF(sv) ((XPVLV*) SvANY(sv))->xlv_targoff_u.xlvu_stargoff | |
1399 #define LvTARGLEN(sv) ((XPVLV*) SvANY(sv))->xlv_targlen | |
1400 #define LvFLAGS(sv) ((XPVLV*) SvANY(sv))->xlv_flags | |
1401 | |
1402 #define IoIFP(sv) (sv)->sv_u.svu_fp | |
1403 #define IoOFP(sv) ((XPVIO*) SvANY(sv))->xio_ofp | |
1404 #define IoDIRP(sv) ((XPVIO*) SvANY(sv))->xio_dirp | |
1405 #define IoANY(sv) ((XPVIO*) SvANY(sv))->xio_any | |
1406 #define IoLINES(sv) ((XPVIO*) SvANY(sv))->xiv_u.xivu_iv | |
1407 #define IoPAGE(sv) ((XPVIO*) SvANY(sv))->xio_page | |
1408 #define IoPAGE_LEN(sv) ((XPVIO*) SvANY(sv))->xio_page_len | |
1409 #define IoLINES_LEFT(sv)((XPVIO*) SvANY(sv))->xio_lines_left | |
1410 #define IoTOP_NAME(sv) ((XPVIO*) SvANY(sv))->xio_top_name | |
1411 #define IoTOP_GV(sv) ((XPVIO*) SvANY(sv))->xio_top_gv | |
1412 #define IoFMT_NAME(sv) ((XPVIO*) SvANY(sv))->xio_fmt_name | |
1413 #define IoFMT_GV(sv) ((XPVIO*) SvANY(sv))->xio_fmt_gv | |
1414 #define IoBOTTOM_NAME(sv)((XPVIO*) SvANY(sv))->xio_bottom_name | |
1415 #define IoBOTTOM_GV(sv) ((XPVIO*) SvANY(sv))->xio_bottom_gv | |
1416 #define IoTYPE(sv) ((XPVIO*) SvANY(sv))->xio_type | |
1417 #define IoFLAGS(sv) ((XPVIO*) SvANY(sv))->xio_flags | |
1418 | |
1419 /* IoTYPE(sv) is a single character telling the type of I/O connection. */ | |
1420 #define IoTYPE_RDONLY '<' | |
1421 #define IoTYPE_WRONLY '>' | |
1422 #define IoTYPE_RDWR '+' | |
1423 #define IoTYPE_APPEND 'a' | |
1424 #define IoTYPE_PIPE '|' | |
1425 #define IoTYPE_STD '-' /* stdin or stdout */ | |
1426 #define IoTYPE_SOCKET 's' | |
1427 #define IoTYPE_CLOSED ' ' | |
1428 #define IoTYPE_IMPLICIT 'I' /* stdin or stdout or stderr */ | |
1429 #define IoTYPE_NUMERIC '#' /* fdopen */ | |
1430 | |
1431 /* | |
1432 =for apidoc Am|bool|SvTAINTED|SV* sv | |
1433 Checks to see if an SV is tainted. Returns TRUE if it is, FALSE if | |
1434 not. | |
1435 | |
1436 =for apidoc Am|void|SvTAINTED_on|SV* sv | |
1437 Marks an SV as tainted if tainting is enabled. | |
1438 | |
1439 =for apidoc Am|void|SvTAINTED_off|SV* sv | |
1440 Untaints an SV. Be I<very> careful with this routine, as it short-circuits | |
1441 some of Perl's fundamental security features. XS module authors should not | |
1442 use this function unless they fully understand all the implications of | |
1443 unconditionally untainting the value. Untainting should be done in the | |
1444 standard perl fashion, via a carefully crafted regexp, rather than directly | |
1445 untainting variables. | |
1446 | |
1447 =for apidoc Am|void|SvTAINT|SV* sv | |
1448 Taints an SV if tainting is enabled, and if some input to the current | |
1449 expression is tainted--usually a variable, but possibly also implicit | |
1450 inputs such as locale settings. C<SvTAINT> propagates that taintedness to | |
1451 the outputs of an expression in a pessimistic fashion; i.e., without paying | |
1452 attention to precisely which outputs are influenced by which inputs. | |
1453 | |
1454 =cut | |
1455 */ | |
1456 | |
1457 #define sv_taint(sv) sv_magic((sv), NULL, PERL_MAGIC_taint, NULL, 0) | |
1458 | |
1459 #ifdef NO_TAINT_SUPPORT | |
1460 # define SvTAINTED(sv) 0 | |
1461 #else | |
1462 # define SvTAINTED(sv) (SvMAGICAL(sv) && sv_tainted(sv)) | |
1463 #endif | |
1464 #define SvTAINTED_on(sv) STMT_START{ if(UNLIKELY(TAINTING_get)){sv_taint(sv);} }STMT_END | |
1465 #define SvTAINTED_off(sv) STMT_START{ if(UNLIKELY(TAINTING_get)){sv_untaint(sv);} }STMT_END | |
1466 | |
1467 #define SvTAINT(sv) \ | |
1468 STMT_START { \ | |
1469 if (UNLIKELY(TAINTING_get)) { \ | |
1470 if (UNLIKELY(TAINT_get)) \ | |
1471 SvTAINTED_on(sv); \ | |
1472 } \ | |
1473 } STMT_END | |
1474 | |
1475 /* | |
1476 =for apidoc Am|char*|SvPV_force|SV* sv|STRLEN len | |
1477 Like C<SvPV> but will force the SV into containing a string (C<SvPOK>), and | |
1478 only a string (C<SvPOK_only>), by hook or by crook. You need force if you are | |
1479 going to update the C<SvPVX> directly. Processes get magic. | |
1480 | |
1481 Note that coercing an arbitrary scalar into a plain PV will potentially | |
1482 strip useful data from it. For example if the SV was C<SvROK>, then the | |
1483 referent will have its reference count decremented, and the SV itself may | |
1484 be converted to an C<SvPOK> scalar with a string buffer containing a value | |
1485 such as C<"ARRAY(0x1234)">. | |
1486 | |
1487 =for apidoc Am|char*|SvPV_force_nomg|SV* sv|STRLEN len | |
1488 Like C<SvPV_force>, but doesn't process get magic. | |
1489 | |
1490 =for apidoc Am|char*|SvPV|SV* sv|STRLEN len | |
1491 Returns a pointer to the string in the SV, or a stringified form of | |
1492 the SV if the SV does not contain a string. The SV may cache the | |
1493 stringified version becoming C<SvPOK>. Handles 'get' magic. The | |
1494 C<len> variable will be set to the length of the string (this is a macro, so | |
1495 don't use C<&len>). See also C<SvPVx> for a version which guarantees to | |
1496 evaluate sv only once. | |
1497 | |
1498 Note that there is no guarantee that the return value of C<SvPV()> is | |
1499 equal to C<SvPVX(sv)>, or that C<SvPVX(sv)> contains valid data, or that | |
1500 successive calls to C<SvPV(sv)> will return the same pointer value each | |
1501 time. This is due to the way that things like overloading and | |
1502 Copy-On-Write are handled. In these cases, the return value may point to | |
1503 a temporary buffer or similar. If you absolutely need the SvPVX field to | |
1504 be valid (for example, if you intend to write to it), then see | |
1505 L</SvPV_force>. | |
1506 | |
1507 =for apidoc Am|char*|SvPVx|SV* sv|STRLEN len | |
1508 A version of C<SvPV> which guarantees to evaluate C<sv> only once. | |
1509 Only use this if C<sv> is an expression with side effects, otherwise use the | |
1510 more efficient C<SvPV>. | |
1511 | |
1512 =for apidoc Am|char*|SvPV_nomg|SV* sv|STRLEN len | |
1513 Like C<SvPV> but doesn't process magic. | |
1514 | |
1515 =for apidoc Am|char*|SvPV_nolen|SV* sv | |
1516 Like C<SvPV> but doesn't set a length variable. | |
1517 | |
1518 =for apidoc Am|char*|SvPV_nomg_nolen|SV* sv | |
1519 Like C<SvPV_nolen> but doesn't process magic. | |
1520 | |
1521 =for apidoc Am|IV|SvIV|SV* sv | |
1522 Coerces the given SV to an integer and returns it. See C<SvIVx> for a | |
1523 version which guarantees to evaluate sv only once. | |
1524 | |
1525 =for apidoc Am|IV|SvIV_nomg|SV* sv | |
1526 Like C<SvIV> but doesn't process magic. | |
1527 | |
1528 =for apidoc Am|IV|SvIVx|SV* sv | |
1529 Coerces the given SV to an integer and returns it. | |
1530 Guarantees to evaluate C<sv> only once. Only use | |
1531 this if C<sv> is an expression with side effects, | |
1532 otherwise use the more efficient C<SvIV>. | |
1533 | |
1534 =for apidoc Am|NV|SvNV|SV* sv | |
1535 Coerce the given SV to a double and return it. See C<SvNVx> for a version | |
1536 which guarantees to evaluate sv only once. | |
1537 | |
1538 =for apidoc Am|NV|SvNV_nomg|SV* sv | |
1539 Like C<SvNV> but doesn't process magic. | |
1540 | |
1541 =for apidoc Am|NV|SvNVx|SV* sv | |
1542 Coerces the given SV to a double and returns it. | |
1543 Guarantees to evaluate C<sv> only once. Only use | |
1544 this if C<sv> is an expression with side effects, | |
1545 otherwise use the more efficient C<SvNV>. | |
1546 | |
1547 =for apidoc Am|UV|SvUV|SV* sv | |
1548 Coerces the given SV to an unsigned integer and returns it. See C<SvUVx> | |
1549 for a version which guarantees to evaluate sv only once. | |
1550 | |
1551 =for apidoc Am|UV|SvUV_nomg|SV* sv | |
1552 Like C<SvUV> but doesn't process magic. | |
1553 | |
1554 =for apidoc Am|UV|SvUVx|SV* sv | |
1555 Coerces the given SV to an unsigned integer and | |
1556 returns it. Guarantees to evaluate C<sv> only once. Only | |
1557 use this if C<sv> is an expression with side effects, | |
1558 otherwise use the more efficient C<SvUV>. | |
1559 | |
1560 =for apidoc Am|bool|SvTRUE|SV* sv | |
1561 Returns a boolean indicating whether Perl would evaluate the SV as true or | |
1562 false. See SvOK() for a defined/undefined test. Handles 'get' magic | |
1563 unless the scalar is already SvPOK, SvIOK or SvNOK (the public, not the | |
1564 private flags). | |
1565 | |
1566 =for apidoc Am|bool|SvTRUE_nomg|SV* sv | |
1567 Returns a boolean indicating whether Perl would evaluate the SV as true or | |
1568 false. See SvOK() for a defined/undefined test. Does not handle 'get' magic. | |
1569 | |
1570 =for apidoc Am|char*|SvPVutf8_force|SV* sv|STRLEN len | |
1571 Like C<SvPV_force>, but converts sv to utf8 first if necessary. | |
1572 | |
1573 =for apidoc Am|char*|SvPVutf8|SV* sv|STRLEN len | |
1574 Like C<SvPV>, but converts sv to utf8 first if necessary. | |
1575 | |
1576 =for apidoc Am|char*|SvPVutf8_nolen|SV* sv | |
1577 Like C<SvPV_nolen>, but converts sv to utf8 first if necessary. | |
1578 | |
1579 =for apidoc Am|char*|SvPVbyte_force|SV* sv|STRLEN len | |
1580 Like C<SvPV_force>, but converts sv to byte representation first if necessary. | |
1581 | |
1582 =for apidoc Am|char*|SvPVbyte|SV* sv|STRLEN len | |
1583 Like C<SvPV>, but converts sv to byte representation first if necessary. | |
1584 | |
1585 =for apidoc Am|char*|SvPVbyte_nolen|SV* sv | |
1586 Like C<SvPV_nolen>, but converts sv to byte representation first if necessary. | |
1587 | |
1588 =for apidoc Am|char*|SvPVutf8x_force|SV* sv|STRLEN len | |
1589 Like C<SvPV_force>, but converts sv to utf8 first if necessary. | |
1590 Guarantees to evaluate sv only once; use the more efficient C<SvPVutf8_force> | |
1591 otherwise. | |
1592 | |
1593 =for apidoc Am|char*|SvPVutf8x|SV* sv|STRLEN len | |
1594 Like C<SvPV>, but converts sv to utf8 first if necessary. | |
1595 Guarantees to evaluate sv only once; use the more efficient C<SvPVutf8> | |
1596 otherwise. | |
1597 | |
1598 =for apidoc Am|char*|SvPVbytex_force|SV* sv|STRLEN len | |
1599 Like C<SvPV_force>, but converts sv to byte representation first if necessary. | |
1600 Guarantees to evaluate sv only once; use the more efficient C<SvPVbyte_force> | |
1601 otherwise. | |
1602 | |
1603 =for apidoc Am|char*|SvPVbytex|SV* sv|STRLEN len | |
1604 Like C<SvPV>, but converts sv to byte representation first if necessary. | |
1605 Guarantees to evaluate sv only once; use the more efficient C<SvPVbyte> | |
1606 otherwise. | |
1607 | |
1608 =for apidoc Am|U32|SvIsCOW|SV* sv | |
1609 Returns a U32 value indicating whether the SV is Copy-On-Write (either shared | |
1610 hash key scalars, or full Copy On Write scalars if 5.9.0 is configured for | |
1611 COW). | |
1612 | |
1613 =for apidoc Am|bool|SvIsCOW_shared_hash|SV* sv | |
1614 Returns a boolean indicating whether the SV is Copy-On-Write shared hash key | |
1615 scalar. | |
1616 | |
1617 =for apidoc Am|void|sv_catpvn_nomg|SV* sv|const char* ptr|STRLEN len | |
1618 Like C<sv_catpvn> but doesn't process magic. | |
1619 | |
1620 =for apidoc Am|void|sv_catpv_nomg|SV* sv|const char* ptr | |
1621 Like C<sv_catpv> but doesn't process magic. | |
1622 | |
1623 =for apidoc Am|void|sv_setsv_nomg|SV* dsv|SV* ssv | |
1624 Like C<sv_setsv> but doesn't process magic. | |
1625 | |
1626 =for apidoc Am|void|sv_catsv_nomg|SV* dsv|SV* ssv | |
1627 Like C<sv_catsv> but doesn't process magic. | |
1628 | |
1629 =for apidoc Amdb|STRLEN|sv_utf8_upgrade_nomg|NN SV *sv | |
1630 | |
1631 Like sv_utf8_upgrade, but doesn't do magic on C<sv>. | |
1632 | |
1633 =cut | |
1634 */ | |
1635 | |
1636 /* Let us hope that bitmaps for UV and IV are the same */ | |
1637 #define SvIV(sv) (SvIOK_nog(sv) ? SvIVX(sv) : sv_2iv(sv)) | |
1638 #define SvUV(sv) (SvUOK_nog(sv) ? SvUVX(sv) : sv_2uv(sv)) | |
1639 #define SvNV(sv) (SvNOK_nog(sv) ? SvNVX(sv) : sv_2nv(sv)) | |
1640 | |
1641 #define SvIV_nomg(sv) (SvIOK(sv) ? SvIVX(sv) : sv_2iv_flags(sv, 0)) | |
1642 #define SvUV_nomg(sv) (SvIOK(sv) ? SvUVX(sv) : sv_2uv_flags(sv, 0)) | |
1643 #define SvNV_nomg(sv) (SvNOK(sv) ? SvNVX(sv) : sv_2nv_flags(sv, 0)) | |
1644 | |
1645 /* ----*/ | |
1646 | |
1647 #define SvPV(sv, lp) SvPV_flags(sv, lp, SV_GMAGIC) | |
1648 #define SvPV_const(sv, lp) SvPV_flags_const(sv, lp, SV_GMAGIC) | |
1649 #define SvPV_mutable(sv, lp) SvPV_flags_mutable(sv, lp, SV_GMAGIC) | |
1650 | |
1651 #define SvPV_flags(sv, lp, flags) \ | |
1652 (SvPOK_nog(sv) \ | |
1653 ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pv_flags(sv, &lp, flags)) | |
1654 #define SvPV_flags_const(sv, lp, flags) \ | |
1655 (SvPOK_nog(sv) \ | |
1656 ? ((lp = SvCUR(sv)), SvPVX_const(sv)) : \ | |
1657 (const char*) sv_2pv_flags(sv, &lp, (flags|SV_CONST_RETURN))) | |
1658 #define SvPV_flags_const_nolen(sv, flags) \ | |
1659 (SvPOK_nog(sv) \ | |
1660 ? SvPVX_const(sv) : \ | |
1661 (const char*) sv_2pv_flags(sv, 0, (flags|SV_CONST_RETURN))) | |
1662 #define SvPV_flags_mutable(sv, lp, flags) \ | |
1663 (SvPOK_nog(sv) \ | |
1664 ? ((lp = SvCUR(sv)), SvPVX_mutable(sv)) : \ | |
1665 sv_2pv_flags(sv, &lp, (flags|SV_MUTABLE_RETURN))) | |
1666 | |
1667 #define SvPV_force(sv, lp) SvPV_force_flags(sv, lp, SV_GMAGIC) | |
1668 #define SvPV_force_nolen(sv) SvPV_force_flags_nolen(sv, SV_GMAGIC) | |
1669 #define SvPV_force_mutable(sv, lp) SvPV_force_flags_mutable(sv, lp, SV_GMAGIC) | |
1670 | |
1671 #define SvPV_force_nomg(sv, lp) SvPV_force_flags(sv, lp, 0) | |
1672 #define SvPV_force_nomg_nolen(sv) SvPV_force_flags_nolen(sv, 0) | |
1673 | |
1674 #define SvPV_force_flags(sv, lp, flags) \ | |
1675 (SvPOK_pure_nogthink(sv) \ | |
1676 ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_pvn_force_flags(sv, &lp, flags)) | |
1677 | |
1678 #define SvPV_force_flags_nolen(sv, flags) \ | |
1679 (SvPOK_pure_nogthink(sv) \ | |
1680 ? SvPVX(sv) : sv_pvn_force_flags(sv, 0, flags)) | |
1681 | |
1682 #define SvPV_force_flags_mutable(sv, lp, flags) \ | |
1683 (SvPOK_pure_nogthink(sv) \ | |
1684 ? ((lp = SvCUR(sv)), SvPVX_mutable(sv)) \ | |
1685 : sv_pvn_force_flags(sv, &lp, flags|SV_MUTABLE_RETURN)) | |
1686 | |
1687 #define SvPV_nolen(sv) \ | |
1688 (SvPOK_nog(sv) \ | |
1689 ? SvPVX(sv) : sv_2pv_flags(sv, 0, SV_GMAGIC)) | |
1690 | |
1691 /* "_nomg" in these defines means no mg_get() */ | |
1692 #define SvPV_nomg_nolen(sv) \ | |
1693 (SvPOK_nog(sv) \ | |
1694 ? SvPVX(sv) : sv_2pv_flags(sv, 0, 0)) | |
1695 | |
1696 #define SvPV_nolen_const(sv) \ | |
1697 (SvPOK_nog(sv) \ | |
1698 ? SvPVX_const(sv) : sv_2pv_flags(sv, 0, SV_GMAGIC|SV_CONST_RETURN)) | |
1699 | |
1700 #define SvPV_nomg(sv, lp) SvPV_flags(sv, lp, 0) | |
1701 #define SvPV_nomg_const(sv, lp) SvPV_flags_const(sv, lp, 0) | |
1702 #define SvPV_nomg_const_nolen(sv) SvPV_flags_const_nolen(sv, 0) | |
1703 | |
1704 /* ----*/ | |
1705 | |
1706 #define SvPVutf8(sv, lp) \ | |
1707 (SvPOK_utf8_nog(sv) \ | |
1708 ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pvutf8(sv, &lp)) | |
1709 | |
1710 #define SvPVutf8_force(sv, lp) \ | |
1711 (SvPOK_utf8_pure_nogthink(sv) \ | |
1712 ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_pvutf8n_force(sv, &lp)) | |
1713 | |
1714 #define SvPVutf8_nolen(sv) \ | |
1715 (SvPOK_utf8_nog(sv) \ | |
1716 ? SvPVX(sv) : sv_2pvutf8(sv, 0)) | |
1717 | |
1718 /* ----*/ | |
1719 | |
1720 #define SvPVbyte(sv, lp) \ | |
1721 (SvPOK_byte_nog(sv) \ | |
1722 ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pvbyte(sv, &lp)) | |
1723 | |
1724 #define SvPVbyte_force(sv, lp) \ | |
1725 (SvPOK_byte_pure_nogthink(sv) \ | |
1726 ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_pvbyten_force(sv, &lp)) | |
1727 | |
1728 #define SvPVbyte_nolen(sv) \ | |
1729 (SvPOK_byte_nog(sv) \ | |
1730 ? SvPVX(sv) : sv_2pvbyte(sv, 0)) | |
1731 | |
1732 | |
1733 /* define FOOx(): idempotent versions of FOO(). If possible, use a local | |
1734 * var to evaluate the arg once; failing that, use a global if possible; | |
1735 * failing that, call a function to do the work | |
1736 */ | |
1737 | |
1738 #define SvPVx_force(sv, lp) sv_pvn_force(sv, &lp) | |
1739 #define SvPVutf8x_force(sv, lp) sv_pvutf8n_force(sv, &lp) | |
1740 #define SvPVbytex_force(sv, lp) sv_pvbyten_force(sv, &lp) | |
1741 | |
1742 #define SvTRUE(sv) (LIKELY(sv) && (UNLIKELY(SvGMAGICAL(sv)) ? sv_2bool(sv) : SvTRUE_common(sv, sv_2bool_nomg(sv)))) | |
1743 #define SvTRUE_nomg(sv) (LIKELY(sv) && ( SvTRUE_common(sv, sv_2bool_nomg(sv)))) | |
1744 #define SvTRUE_NN(sv) (UNLIKELY(SvGMAGICAL(sv)) ? sv_2bool(sv) : SvTRUE_common(sv, sv_2bool_nomg(sv))) | |
1745 #define SvTRUE_nomg_NN(sv) ( SvTRUE_common(sv, sv_2bool_nomg(sv))) | |
1746 #define SvTRUE_common(sv,fallback) ( \ | |
1747 !SvOK(sv) \ | |
1748 ? 0 \ | |
1749 : SvPOK(sv) \ | |
1750 ? SvPVXtrue(sv) \ | |
1751 : (SvFLAGS(sv) & (SVf_IOK|SVf_NOK)) \ | |
1752 ? ( (SvIOK(sv) && SvIVX(sv) != 0) \ | |
1753 || (SvNOK(sv) && SvNVX(sv) != 0.0)) \ | |
1754 : (fallback)) | |
1755 | |
1756 #if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) | |
1757 | |
1758 # define SvIVx(sv) ({SV *_sv = MUTABLE_SV(sv); SvIV(_sv); }) | |
1759 # define SvUVx(sv) ({SV *_sv = MUTABLE_SV(sv); SvUV(_sv); }) | |
1760 # define SvNVx(sv) ({SV *_sv = MUTABLE_SV(sv); SvNV(_sv); }) | |
1761 # define SvPVx(sv, lp) ({SV *_sv = (sv); SvPV(_sv, lp); }) | |
1762 # define SvPVx_const(sv, lp) ({SV *_sv = (sv); SvPV_const(_sv, lp); }) | |
1763 # define SvPVx_nolen(sv) ({SV *_sv = (sv); SvPV_nolen(_sv); }) | |
1764 # define SvPVx_nolen_const(sv) ({SV *_sv = (sv); SvPV_nolen_const(_sv); }) | |
1765 # define SvPVutf8x(sv, lp) ({SV *_sv = (sv); SvPVutf8(_sv, lp); }) | |
1766 # define SvPVbytex(sv, lp) ({SV *_sv = (sv); SvPVbyte(_sv, lp); }) | |
1767 # define SvPVbytex_nolen(sv) ({SV *_sv = (sv); SvPVbyte_nolen(_sv); }) | |
1768 # define SvTRUEx(sv) ({SV *_sv = (sv); SvTRUE(_sv); }) | |
1769 # define SvTRUEx_nomg(sv) ({SV *_sv = (sv); SvTRUE_nomg(_sv); }) | |
1770 | |
1771 #else /* __GNUC__ */ | |
1772 | |
1773 /* These inlined macros use globals, which will require a thread | |
1774 * declaration in user code, so we avoid them under threads */ | |
1775 | |
1776 # define SvIVx(sv) ((PL_Sv = (sv)), SvIV(PL_Sv)) | |
1777 # define SvUVx(sv) ((PL_Sv = (sv)), SvUV(PL_Sv)) | |
1778 # define SvNVx(sv) ((PL_Sv = (sv)), SvNV(PL_Sv)) | |
1779 # define SvPVx(sv, lp) ((PL_Sv = (sv)), SvPV(PL_Sv, lp)) | |
1780 # define SvPVx_const(sv, lp) ((PL_Sv = (sv)), SvPV_const(PL_Sv, lp)) | |
1781 # define SvPVx_nolen(sv) ((PL_Sv = (sv)), SvPV_nolen(PL_Sv)) | |
1782 # define SvPVx_nolen_const(sv) ((PL_Sv = (sv)), SvPV_nolen_const(PL_Sv)) | |
1783 # define SvPVutf8x(sv, lp) ((PL_Sv = (sv)), SvPVutf8(PL_Sv, lp)) | |
1784 # define SvPVbytex(sv, lp) ((PL_Sv = (sv)), SvPVbyte(PL_Sv, lp)) | |
1785 # define SvPVbytex_nolen(sv) ((PL_Sv = (sv)), SvPVbyte_nolen(PL_Sv)) | |
1786 # define SvTRUEx(sv) ((PL_Sv = (sv)), SvTRUE(PL_Sv)) | |
1787 # define SvTRUEx_nomg(sv) ((PL_Sv = (sv)), SvTRUE_nomg(PL_Sv)) | |
1788 #endif /* __GNU__ */ | |
1789 | |
1790 #define SvPVXtrue(sv) ( \ | |
1791 ((XPV*)SvANY((sv))) \ | |
1792 && ( \ | |
1793 ((XPV*)SvANY((sv)))->xpv_cur > 1 \ | |
1794 || ( \ | |
1795 ((XPV*)SvANY((sv)))->xpv_cur \ | |
1796 && *(sv)->sv_u.svu_pv != '0' \ | |
1797 ) \ | |
1798 ) \ | |
1799 ) | |
1800 | |
1801 #define SvIsCOW(sv) (SvFLAGS(sv) & SVf_IsCOW) | |
1802 #define SvIsCOW_on(sv) (SvFLAGS(sv) |= SVf_IsCOW) | |
1803 #define SvIsCOW_off(sv) (SvFLAGS(sv) &= ~SVf_IsCOW) | |
1804 #define SvIsCOW_shared_hash(sv) (SvIsCOW(sv) && SvLEN(sv) == 0) | |
1805 | |
1806 #define SvSHARED_HEK_FROM_PV(pvx) \ | |
1807 ((struct hek*)(pvx - STRUCT_OFFSET(struct hek, hek_key))) | |
1808 #define SvSHARED_HASH(sv) (0 + SvSHARED_HEK_FROM_PV(SvPVX_const(sv))->hek_hash) | |
1809 | |
1810 /* flag values for sv_*_flags functions */ | |
1811 #define SV_IMMEDIATE_UNREF 1 | |
1812 #define SV_GMAGIC 2 | |
1813 #define SV_COW_DROP_PV 4 | |
1814 #define SV_UTF8_NO_ENCODING 8 | |
1815 #define SV_NOSTEAL 16 | |
1816 #define SV_CONST_RETURN 32 | |
1817 #define SV_MUTABLE_RETURN 64 | |
1818 #define SV_SMAGIC 128 | |
1819 #define SV_HAS_TRAILING_NUL 256 | |
1820 #define SV_COW_SHARED_HASH_KEYS 512 | |
1821 /* This one is only enabled for PERL_OLD_COPY_ON_WRITE */ | |
1822 #define SV_COW_OTHER_PVS 1024 | |
1823 /* Make sv_2pv_flags return NULL if something is undefined. */ | |
1824 #define SV_UNDEF_RETURNS_NULL 2048 | |
1825 /* Tell sv_utf8_upgrade() to not check to see if an upgrade is really needed. | |
1826 * This is used when the caller has already determined it is, and avoids | |
1827 * redundant work */ | |
1828 #define SV_FORCE_UTF8_UPGRADE 4096 | |
1829 /* if (after resolving magic etc), the SV is found to be overloaded, | |
1830 * don't call the overload magic, just return as-is */ | |
1831 #define SV_SKIP_OVERLOAD 8192 | |
1832 #define SV_CATBYTES 16384 | |
1833 #define SV_CATUTF8 32768 | |
1834 | |
1835 /* The core is safe for this COW optimisation. XS code on CPAN may not be. | |
1836 So only default to doing the COW setup if we're in the core. | |
1837 */ | |
1838 #ifdef PERL_CORE | |
1839 # ifndef SV_DO_COW_SVSETSV | |
1840 # define SV_DO_COW_SVSETSV SV_COW_SHARED_HASH_KEYS|SV_COW_OTHER_PVS | |
1841 # endif | |
1842 #endif | |
1843 | |
1844 #ifndef SV_DO_COW_SVSETSV | |
1845 # define SV_DO_COW_SVSETSV 0 | |
1846 #endif | |
1847 | |
1848 | |
1849 #define sv_unref(sv) sv_unref_flags(sv, 0) | |
1850 #define sv_force_normal(sv) sv_force_normal_flags(sv, 0) | |
1851 #define sv_usepvn(sv, p, l) sv_usepvn_flags(sv, p, l, 0) | |
1852 #define sv_usepvn_mg(sv, p, l) sv_usepvn_flags(sv, p, l, SV_SMAGIC) | |
1853 | |
1854 /* We are about to replace the SV's current value. So if it's copy on write | |
1855 we need to normalise it. Use the SV_COW_DROP_PV flag hint to say that | |
1856 the value is about to get thrown away, so drop the PV rather than go to | |
1857 the effort of making a read-write copy only for it to get immediately | |
1858 discarded. */ | |
1859 | |
1860 #define SV_CHECK_THINKFIRST_COW_DROP(sv) if (SvTHINKFIRST(sv)) \ | |
1861 sv_force_normal_flags(sv, SV_COW_DROP_PV) | |
1862 | |
1863 #ifdef PERL_OLD_COPY_ON_WRITE | |
1864 #define SvRELEASE_IVX(sv) \ | |
1865 ((SvIsCOW(sv) ? sv_force_normal_flags(sv, 0) : (void) 0), 0) | |
1866 # define SvIsCOW_normal(sv) (SvIsCOW(sv) && SvLEN(sv)) | |
1867 # define SvRELEASE_IVX_(sv) SvRELEASE_IVX(sv), | |
1868 # define SvCANCOW(sv) \ | |
1869 (SvIsCOW(sv) || (SvFLAGS(sv) & CAN_COW_MASK) == CAN_COW_FLAGS) | |
1870 /* This is a pessimistic view. Scalar must be purely a read-write PV to copy- | |
1871 on-write. */ | |
1872 # define CAN_COW_MASK (SVs_OBJECT|SVs_GMG|SVs_SMG|SVs_RMG|SVf_IOK|SVf_NOK| \ | |
1873 SVf_POK|SVf_ROK|SVp_IOK|SVp_NOK|SVp_POK|SVf_FAKE| \ | |
1874 SVf_OOK|SVf_BREAK|SVf_READONLY|SVf_PROTECT) | |
1875 #else | |
1876 # define SvRELEASE_IVX(sv) 0 | |
1877 /* This little game brought to you by the need to shut this warning up: | |
1878 mg.c: In function 'Perl_magic_get': | |
1879 mg.c:1024: warning: left-hand operand of comma expression has no effect | |
1880 */ | |
1881 # define SvRELEASE_IVX_(sv) /**/ | |
1882 # ifdef PERL_NEW_COPY_ON_WRITE | |
1883 # define SvCANCOW(sv) \ | |
1884 (SvIsCOW(sv) \ | |
1885 ? SvLEN(sv) ? CowREFCNT(sv) != SV_COW_REFCNT_MAX : 1 \ | |
1886 : (SvFLAGS(sv) & CAN_COW_MASK) == CAN_COW_FLAGS \ | |
1887 && SvCUR(sv)+1 < SvLEN(sv)) | |
1888 /* Note: To allow 256 COW "copies", a refcnt of 0 means 1. */ | |
1889 # define CowREFCNT(sv) (*(U8 *)(SvPVX(sv)+SvLEN(sv)-1)) | |
1890 # define SV_COW_REFCNT_MAX ((1 << sizeof(U8)*8) - 1) | |
1891 # define CAN_COW_MASK (SVf_POK|SVf_ROK|SVp_POK|SVf_FAKE| \ | |
1892 SVf_OOK|SVf_BREAK|SVf_READONLY|SVf_PROTECT) | |
1893 # endif | |
1894 #endif /* PERL_OLD_COPY_ON_WRITE */ | |
1895 | |
1896 #define CAN_COW_FLAGS (SVp_POK|SVf_POK) | |
1897 | |
1898 #define SV_CHECK_THINKFIRST(sv) if (SvTHINKFIRST(sv)) \ | |
1899 sv_force_normal_flags(sv, 0) | |
1900 | |
1901 | |
1902 /* all these 'functions' are now just macros */ | |
1903 | |
1904 #define sv_pv(sv) SvPV_nolen(sv) | |
1905 #define sv_pvutf8(sv) SvPVutf8_nolen(sv) | |
1906 #define sv_pvbyte(sv) SvPVbyte_nolen(sv) | |
1907 | |
1908 #define sv_pvn_force_nomg(sv, lp) sv_pvn_force_flags(sv, lp, 0) | |
1909 #define sv_utf8_upgrade_flags(sv, flags) sv_utf8_upgrade_flags_grow(sv, flags, 0) | |
1910 #define sv_utf8_upgrade_nomg(sv) sv_utf8_upgrade_flags(sv, 0) | |
1911 #define sv_catpvn_nomg(dsv, sstr, slen) sv_catpvn_flags(dsv, sstr, slen, 0) | |
1912 #define sv_catpv_nomg(dsv, sstr) sv_catpv_flags(dsv, sstr, 0) | |
1913 #define sv_setsv(dsv, ssv) \ | |
1914 sv_setsv_flags(dsv, ssv, SV_GMAGIC|SV_DO_COW_SVSETSV) | |
1915 #define sv_setsv_nomg(dsv, ssv) sv_setsv_flags(dsv, ssv, SV_DO_COW_SVSETSV) | |
1916 #define sv_catsv(dsv, ssv) sv_catsv_flags(dsv, ssv, SV_GMAGIC) | |
1917 #define sv_catsv_nomg(dsv, ssv) sv_catsv_flags(dsv, ssv, 0) | |
1918 #define sv_catsv_mg(dsv, ssv) sv_catsv_flags(dsv, ssv, SV_GMAGIC|SV_SMAGIC) | |
1919 #define sv_catpvn(dsv, sstr, slen) sv_catpvn_flags(dsv, sstr, slen, SV_GMAGIC) | |
1920 #define sv_catpvn_mg(sv, sstr, slen) sv_catpvn_flags(sv, sstr, slen, SV_GMAGIC|SV_SMAGIC); | |
1921 #define sv_copypv(dsv, ssv) sv_copypv_flags(dsv, ssv, SV_GMAGIC) | |
1922 #define sv_copypv_nomg(dsv, ssv) sv_copypv_flags(dsv, ssv, 0) | |
1923 #define sv_2pv(sv, lp) sv_2pv_flags(sv, lp, SV_GMAGIC) | |
1924 #define sv_2pv_nolen(sv) sv_2pv(sv, 0) | |
1925 #define sv_2pvbyte_nolen(sv) sv_2pvbyte(sv, 0) | |
1926 #define sv_2pvutf8_nolen(sv) sv_2pvutf8(sv, 0) | |
1927 #define sv_2pv_nomg(sv, lp) sv_2pv_flags(sv, lp, 0) | |
1928 #define sv_pvn_force(sv, lp) sv_pvn_force_flags(sv, lp, SV_GMAGIC) | |
1929 #define sv_utf8_upgrade(sv) sv_utf8_upgrade_flags(sv, SV_GMAGIC) | |
1930 #define sv_2iv(sv) sv_2iv_flags(sv, SV_GMAGIC) | |
1931 #define sv_2uv(sv) sv_2uv_flags(sv, SV_GMAGIC) | |
1932 #define sv_2nv(sv) sv_2nv_flags(sv, SV_GMAGIC) | |
1933 #define sv_eq(sv1, sv2) sv_eq_flags(sv1, sv2, SV_GMAGIC) | |
1934 #define sv_cmp(sv1, sv2) sv_cmp_flags(sv1, sv2, SV_GMAGIC) | |
1935 #define sv_cmp_locale(sv1, sv2) sv_cmp_locale_flags(sv1, sv2, SV_GMAGIC) | |
1936 #define sv_collxfrm(sv, nxp) sv_cmp_flags(sv, nxp, SV_GMAGIC) | |
1937 #define sv_2bool(sv) sv_2bool_flags(sv, SV_GMAGIC) | |
1938 #define sv_2bool_nomg(sv) sv_2bool_flags(sv, 0) | |
1939 #define sv_insert(bigstr, offset, len, little, littlelen) \ | |
1940 Perl_sv_insert_flags(aTHX_ (bigstr),(offset), (len), (little), \ | |
1941 (littlelen), SV_GMAGIC) | |
1942 #define sv_mortalcopy(sv) \ | |
1943 Perl_sv_mortalcopy_flags(aTHX_ sv, SV_GMAGIC|SV_DO_COW_SVSETSV) | |
1944 #define sv_cathek(sv,hek) \ | |
1945 STMT_START { \ | |
1946 HEK * const bmxk = hek; \ | |
1947 sv_catpvn_flags(sv, HEK_KEY(bmxk), HEK_LEN(bmxk), \ | |
1948 HEK_UTF8(bmxk) ? SV_CATUTF8 : SV_CATBYTES); \ | |
1949 } STMT_END | |
1950 | |
1951 /* Should be named SvCatPVN_utf8_upgrade? */ | |
1952 #define sv_catpvn_nomg_utf8_upgrade(dsv, sstr, slen, nsv) \ | |
1953 STMT_START { \ | |
1954 if (!(nsv)) \ | |
1955 nsv = newSVpvn_flags(sstr, slen, SVs_TEMP); \ | |
1956 else \ | |
1957 sv_setpvn(nsv, sstr, slen); \ | |
1958 SvUTF8_off(nsv); \ | |
1959 sv_utf8_upgrade(nsv); \ | |
1960 sv_catsv_nomg(dsv, nsv); \ | |
1961 } STMT_END | |
1962 #define sv_catpvn_nomg_maybeutf8(dsv, sstr, slen, is_utf8) \ | |
1963 sv_catpvn_flags(dsv, sstr, slen, (is_utf8)?SV_CATUTF8:SV_CATBYTES) | |
1964 | |
1965 #if defined(PERL_CORE) || defined(PERL_EXT) | |
1966 # define sv_or_pv_len_utf8(sv, pv, bytelen) \ | |
1967 (SvGAMAGIC(sv) \ | |
1968 ? utf8_length((U8 *)(pv), (U8 *)(pv)+(bytelen)) \ | |
1969 : sv_len_utf8(sv)) | |
1970 #endif | |
1971 | |
1972 /* | |
1973 =for apidoc Am|SV*|newRV_inc|SV* sv | |
1974 | |
1975 Creates an RV wrapper for an SV. The reference count for the original SV is | |
1976 incremented. | |
1977 | |
1978 =cut | |
1979 */ | |
1980 | |
1981 #define newRV_inc(sv) newRV(sv) | |
1982 | |
1983 /* the following macros update any magic values this sv is associated with */ | |
1984 | |
1985 /* | |
1986 =head1 Magical Functions | |
1987 | |
1988 =for apidoc Am|void|SvGETMAGIC|SV* sv | |
1989 Invokes C<mg_get> on an SV if it has 'get' magic. For example, this | |
1990 will call C<FETCH> on a tied variable. This macro evaluates its | |
1991 argument more than once. | |
1992 | |
1993 =for apidoc Am|void|SvSETMAGIC|SV* sv | |
1994 Invokes C<mg_set> on an SV if it has 'set' magic. This is necessary | |
1995 after modifying a scalar, in case it is a magical variable like C<$|> | |
1996 or a tied variable (it calls C<STORE>). This macro evaluates its | |
1997 argument more than once. | |
1998 | |
1999 =for apidoc Am|void|SvSetSV|SV* dsv|SV* ssv | |
2000 Calls C<sv_setsv> if dsv is not the same as ssv. May evaluate arguments | |
2001 more than once. Does not handle 'set' magic on the destination SV. | |
2002 | |
2003 =for apidoc Am|void|SvSetSV_nosteal|SV* dsv|SV* ssv | |
2004 Calls a non-destructive version of C<sv_setsv> if dsv is not the same as | |
2005 ssv. May evaluate arguments more than once. | |
2006 | |
2007 =for apidoc Am|void|SvSetMagicSV|SV* dsv|SV* ssv | |
2008 Like C<SvSetSV>, but does any set magic required afterwards. | |
2009 | |
2010 =for apidoc Am|void|SvSetMagicSV_nosteal|SV* dsv|SV* ssv | |
2011 Like C<SvSetSV_nosteal>, but does any set magic required afterwards. | |
2012 | |
2013 =for apidoc Am|void|SvSHARE|SV* sv | |
2014 Arranges for sv to be shared between threads if a suitable module | |
2015 has been loaded. | |
2016 | |
2017 =for apidoc Am|void|SvLOCK|SV* sv | |
2018 Arranges for a mutual exclusion lock to be obtained on sv if a suitable module | |
2019 has been loaded. | |
2020 | |
2021 =for apidoc Am|void|SvUNLOCK|SV* sv | |
2022 Releases a mutual exclusion lock on sv if a suitable module | |
2023 has been loaded. | |
2024 | |
2025 =head1 SV Manipulation Functions | |
2026 | |
2027 =for apidoc Am|char *|SvGROW|SV* sv|STRLEN len | |
2028 Expands the character buffer in the SV so that it has room for the | |
2029 indicated number of bytes (remember to reserve space for an extra trailing | |
2030 C<NUL> character). Calls C<sv_grow> to perform the expansion if necessary. | |
2031 Returns a pointer to the character | |
2032 buffer. SV must be of type >= SVt_PV. One | |
2033 alternative is to call C<sv_grow> if you are not sure of the type of SV. | |
2034 | |
2035 =cut | |
2036 */ | |
2037 | |
2038 #define SvSHARE(sv) PL_sharehook(aTHX_ sv) | |
2039 #define SvLOCK(sv) PL_lockhook(aTHX_ sv) | |
2040 #define SvUNLOCK(sv) PL_unlockhook(aTHX_ sv) | |
2041 #define SvDESTROYABLE(sv) PL_destroyhook(aTHX_ sv) | |
2042 | |
2043 #define SvGETMAGIC(x) ((void)(UNLIKELY(SvGMAGICAL(x)) && mg_get(x))) | |
2044 #define SvSETMAGIC(x) STMT_START { if (UNLIKELY(SvSMAGICAL(x))) mg_set(x); } STMT_END | |
2045 | |
2046 #define SvSetSV_and(dst,src,finally) \ | |
2047 STMT_START { \ | |
2048 if (LIKELY((dst) != (src))) { \ | |
2049 sv_setsv(dst, src); \ | |
2050 finally; \ | |
2051 } \ | |
2052 } STMT_END | |
2053 #define SvSetSV_nosteal_and(dst,src,finally) \ | |
2054 STMT_START { \ | |
2055 if (LIKELY((dst) != (src))) { \ | |
2056 sv_setsv_flags(dst, src, SV_GMAGIC | SV_NOSTEAL | SV_DO_COW_SVSETSV); \ | |
2057 finally; \ | |
2058 } \ | |
2059 } STMT_END | |
2060 | |
2061 #define SvSetSV(dst,src) \ | |
2062 SvSetSV_and(dst,src,/*nothing*/;) | |
2063 #define SvSetSV_nosteal(dst,src) \ | |
2064 SvSetSV_nosteal_and(dst,src,/*nothing*/;) | |
2065 | |
2066 #define SvSetMagicSV(dst,src) \ | |
2067 SvSetSV_and(dst,src,SvSETMAGIC(dst)) | |
2068 #define SvSetMagicSV_nosteal(dst,src) \ | |
2069 SvSetSV_nosteal_and(dst,src,SvSETMAGIC(dst)) | |
2070 | |
2071 | |
2072 #if !defined(SKIP_DEBUGGING) | |
2073 #define SvPEEK(sv) sv_peek(sv) | |
2074 #else | |
2075 #define SvPEEK(sv) "" | |
2076 #endif | |
2077 | |
2078 #define SvIMMORTAL(sv) (SvREADONLY(sv) && ((sv)==&PL_sv_undef || (sv)==&PL_sv_yes || (sv)==&PL_sv_no || (sv)==&PL_sv_placeholder)) | |
2079 | |
2080 #ifdef DEBUGGING | |
2081 /* exercise the immortal resurrection code in sv_free2() */ | |
2082 # define SvREFCNT_IMMORTAL 1000 | |
2083 #else | |
2084 # define SvREFCNT_IMMORTAL ((~(U32)0)/2) | |
2085 #endif | |
2086 | |
2087 /* | |
2088 =for apidoc Am|SV *|boolSV|bool b | |
2089 | |
2090 Returns a true SV if C<b> is a true value, or a false SV if C<b> is 0. | |
2091 | |
2092 See also C<PL_sv_yes> and C<PL_sv_no>. | |
2093 | |
2094 =cut | |
2095 */ | |
2096 | |
2097 #define boolSV(b) ((b) ? &PL_sv_yes : &PL_sv_no) | |
2098 | |
2099 #define isGV(sv) (SvTYPE(sv) == SVt_PVGV) | |
2100 /* If I give every macro argument a different name, then there won't be bugs | |
2101 where nested macros get confused. Been there, done that. */ | |
2102 #define isGV_with_GP(pwadak) \ | |
2103 (((SvFLAGS(pwadak) & (SVp_POK|SVpgv_GP)) == SVpgv_GP) \ | |
2104 && (SvTYPE(pwadak) == SVt_PVGV || SvTYPE(pwadak) == SVt_PVLV)) | |
2105 #define isGV_with_GP_on(sv) STMT_START { \ | |
2106 assert (SvTYPE(sv) == SVt_PVGV || SvTYPE(sv) == SVt_PVLV); \ | |
2107 assert (!SvPOKp(sv)); \ | |
2108 assert (!SvIOKp(sv)); \ | |
2109 (SvFLAGS(sv) |= SVpgv_GP); \ | |
2110 } STMT_END | |
2111 #define isGV_with_GP_off(sv) STMT_START { \ | |
2112 assert (SvTYPE(sv) == SVt_PVGV || SvTYPE(sv) == SVt_PVLV); \ | |
2113 assert (!SvPOKp(sv)); \ | |
2114 assert (!SvIOKp(sv)); \ | |
2115 (SvFLAGS(sv) &= ~SVpgv_GP); \ | |
2116 } STMT_END | |
2117 #define isREGEXP(sv) \ | |
2118 (SvTYPE(sv) == SVt_REGEXP \ | |
2119 || (SvFLAGS(sv) & (SVTYPEMASK|SVp_POK|SVpgv_GP|SVf_FAKE)) \ | |
2120 == (SVt_PVLV|SVf_FAKE)) | |
2121 | |
2122 | |
2123 #ifdef PERL_ANY_COW | |
2124 # define SvGROW(sv,len) \ | |
2125 (SvIsCOW(sv) || SvLEN(sv) < (len) ? sv_grow(sv,len) : SvPVX(sv)) | |
2126 #else | |
2127 # define SvGROW(sv,len) (SvLEN(sv) < (len) ? sv_grow(sv,len) : SvPVX(sv)) | |
2128 #endif | |
2129 #define SvGROW_mutable(sv,len) \ | |
2130 (SvLEN(sv) < (len) ? sv_grow(sv,len) : SvPVX_mutable(sv)) | |
2131 #define Sv_Grow sv_grow | |
2132 | |
2133 #define CLONEf_COPY_STACKS 1 | |
2134 #define CLONEf_KEEP_PTR_TABLE 2 | |
2135 #define CLONEf_CLONE_HOST 4 | |
2136 #define CLONEf_JOIN_IN 8 | |
2137 | |
2138 struct clone_params { | |
2139 AV* stashes; | |
2140 UV flags; | |
2141 PerlInterpreter *proto_perl; | |
2142 PerlInterpreter *new_perl; | |
2143 AV *unreferenced; | |
2144 }; | |
2145 | |
2146 /* | |
2147 =for apidoc Am|SV*|newSVpvn_utf8|NULLOK const char* s|STRLEN len|U32 utf8 | |
2148 | |
2149 Creates a new SV and copies a string (which may contain C<NUL> (C<\0>) | |
2150 characters) into it. If utf8 is true, calls | |
2151 C<SvUTF8_on> on the new SV. Implemented as a wrapper around C<newSVpvn_flags>. | |
2152 | |
2153 =cut | |
2154 */ | |
2155 | |
2156 #define newSVpvn_utf8(s, len, u) newSVpvn_flags((s), (len), (u) ? SVf_UTF8 : 0) | |
2157 | |
2158 /* | |
2159 =for apidoc Amx|SV*|newSVpadname|PADNAME *pn | |
2160 | |
2161 Creates a new SV containing the pad name. | |
2162 | |
2163 =cut | |
2164 */ | |
2165 | |
2166 #define newSVpadname(pn) newSVpvn_utf8(PadnamePV(pn), PadnameLEN(pn), TRUE) | |
2167 | |
2168 /* | |
2169 =for apidoc Am|void|SvOOK_offset|NN SV*sv|STRLEN len | |
2170 | |
2171 Reads into I<len> the offset from SvPVX back to the true start of the | |
2172 allocated buffer, which will be non-zero if C<sv_chop> has been used to | |
2173 efficiently remove characters from start of the buffer. Implemented as a | |
2174 macro, which takes the address of I<len>, which must be of type C<STRLEN>. | |
2175 Evaluates I<sv> more than once. Sets I<len> to 0 if C<SvOOK(sv)> is false. | |
2176 | |
2177 =cut | |
2178 */ | |
2179 | |
2180 #ifdef DEBUGGING | |
2181 /* Does the bot know something I don't? | |
2182 10:28 <@Nicholas> metabatman | |
2183 10:28 <+meta> Nicholas: crash | |
2184 */ | |
2185 # define SvOOK_offset(sv, offset) STMT_START { \ | |
2186 assert(sizeof(offset) == sizeof(STRLEN)); \ | |
2187 if (SvOOK(sv)) { \ | |
2188 const U8 *_crash = (U8*)SvPVX_const(sv); \ | |
2189 (offset) = *--_crash; \ | |
2190 if (!(offset)) { \ | |
2191 _crash -= sizeof(STRLEN); \ | |
2192 Copy(_crash, (U8 *)&(offset), sizeof(STRLEN), U8); \ | |
2193 } \ | |
2194 { \ | |
2195 /* Validate the preceding buffer's sentinels to \ | |
2196 verify that no-one is using it. */ \ | |
2197 const U8 *const _bonk = (U8*)SvPVX_const(sv) - (offset);\ | |
2198 while (_crash > _bonk) { \ | |
2199 --_crash; \ | |
2200 assert (*_crash == (U8)PTR2UV(_crash)); \ | |
2201 } \ | |
2202 } \ | |
2203 } else { \ | |
2204 (offset) = 0; \ | |
2205 } \ | |
2206 } STMT_END | |
2207 #else | |
2208 /* This is the same code, but avoids using any temporary variables: */ | |
2209 # define SvOOK_offset(sv, offset) STMT_START { \ | |
2210 assert(sizeof(offset) == sizeof(STRLEN)); \ | |
2211 if (SvOOK(sv)) { \ | |
2212 (offset) = ((U8*)SvPVX_const(sv))[-1]; \ | |
2213 if (!(offset)) { \ | |
2214 Copy(SvPVX_const(sv) - 1 - sizeof(STRLEN), \ | |
2215 (U8*)&(offset), sizeof(STRLEN), U8); \ | |
2216 } \ | |
2217 } else { \ | |
2218 (offset) = 0; \ | |
2219 } \ | |
2220 } STMT_END | |
2221 #endif | |
2222 | |
2223 #define newIO() MUTABLE_IO(newSV_type(SVt_PVIO)) | |
2224 | |
2225 #define SV_CONST(name) \ | |
2226 PL_sv_consts[SV_CONST_##name] \ | |
2227 ? PL_sv_consts[SV_CONST_##name] \ | |
2228 : (PL_sv_consts[SV_CONST_##name] = newSVpv_share(#name, 0)) | |
2229 | |
2230 #define SV_CONST_TIESCALAR 0 | |
2231 #define SV_CONST_TIEARRAY 1 | |
2232 #define SV_CONST_TIEHASH 2 | |
2233 #define SV_CONST_TIEHANDLE 3 | |
2234 | |
2235 #define SV_CONST_FETCH 4 | |
2236 #define SV_CONST_FETCHSIZE 5 | |
2237 #define SV_CONST_STORE 6 | |
2238 #define SV_CONST_STORESIZE 7 | |
2239 #define SV_CONST_EXISTS 8 | |
2240 | |
2241 #define SV_CONST_PUSH 9 | |
2242 #define SV_CONST_POP 10 | |
2243 #define SV_CONST_SHIFT 11 | |
2244 #define SV_CONST_UNSHIFT 12 | |
2245 #define SV_CONST_SPLICE 13 | |
2246 #define SV_CONST_EXTEND 14 | |
2247 | |
2248 #define SV_CONST_FIRSTKEY 15 | |
2249 #define SV_CONST_NEXTKEY 16 | |
2250 #define SV_CONST_SCALAR 17 | |
2251 | |
2252 #define SV_CONST_OPEN 18 | |
2253 #define SV_CONST_WRITE 19 | |
2254 #define SV_CONST_PRINT 20 | |
2255 #define SV_CONST_PRINTF 21 | |
2256 #define SV_CONST_READ 22 | |
2257 #define SV_CONST_READLINE 23 | |
2258 #define SV_CONST_GETC 24 | |
2259 #define SV_CONST_SEEK 25 | |
2260 #define SV_CONST_TELL 26 | |
2261 #define SV_CONST_EOF 27 | |
2262 #define SV_CONST_BINMODE 28 | |
2263 #define SV_CONST_FILENO 29 | |
2264 #define SV_CONST_CLOSE 30 | |
2265 | |
2266 #define SV_CONST_DELETE 31 | |
2267 #define SV_CONST_CLEAR 32 | |
2268 #define SV_CONST_UNTIE 33 | |
2269 #define SV_CONST_DESTROY 34 | |
2270 | |
2271 #define SV_CONSTS_COUNT 35 | |
2272 | |
2273 /* | |
2274 * ex: set ts=8 sts=4 sw=4 et: | |
2275 */ |