This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
utf8.c: Use existing macros instead of duplicate code
[perl5.git] / mathoms.c
CommitLineData
7ee2227d
SP
1/* mathoms.c
2 *
2eee27d7
SS
3 * Copyright (C) 2005, 2006, 2007, 2008, 2009, 2010,
4 * 2011, 2012 by Larry Wall and others
7ee2227d
SP
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/*
4ac71550
TC
12 * Anything that Hobbits had no immediate use for, but were unwilling to
13 * throw away, they called a mathom. Their dwellings were apt to become
14 * rather crowded with mathoms, and many of the presents that passed from
15 * hand to hand were of that sort.
16 *
17 * [p.5 of _The Lord of the Rings_: "Prologue"]
7ee2227d
SP
18 */
19
359d40ba 20
20fac488 21
7ee2227d
SP
22/*
23 * This file contains mathoms, various binary artifacts from previous
f2f0f092
NC
24 * versions of Perl. For binary or source compatibility reasons, though,
25 * we cannot completely remove them from the core code.
7ee2227d
SP
26 *
27 * SMP - Oct. 24, 2005
28 *
55cb5ee0
KW
29 * The compilation of this file can be suppressed; see INSTALL
30 *
7ee2227d
SP
31 */
32
33#include "EXTERN.h"
34#define PERL_IN_MATHOMS_C
35#include "perl.h"
36
359d40ba
NC
37#ifdef NO_MATHOMS
38/* ..." warning: ISO C forbids an empty source file"
39 So make sure we have something in here by processing the headers anyway.
40 */
41#else
42
d4478588
CB
43/* Not all of these have prototypes elsewhere, so do this to get
44 * non-mangled names.
45 */
361ec98e 46START_EXTERN_C
d4478588 47
a0c21aa1
JH
48PERL_CALLCONV OP * Perl_ref(pTHX_ OP *o, I32 type);
49PERL_CALLCONV void Perl_sv_unref(pTHX_ SV *sv);
50PERL_CALLCONV void Perl_sv_taint(pTHX_ SV *sv);
5aaab254
KW
51PERL_CALLCONV IV Perl_sv_2iv(pTHX_ SV *sv);
52PERL_CALLCONV UV Perl_sv_2uv(pTHX_ SV *sv);
53PERL_CALLCONV NV Perl_sv_2nv(pTHX_ SV *sv);
54PERL_CALLCONV char * Perl_sv_2pv(pTHX_ SV *sv, STRLEN *lp);
55PERL_CALLCONV char * Perl_sv_2pv_nolen(pTHX_ SV *sv);
56PERL_CALLCONV char * Perl_sv_2pvbyte_nolen(pTHX_ SV *sv);
57PERL_CALLCONV char * Perl_sv_2pvutf8_nolen(pTHX_ SV *sv);
58PERL_CALLCONV void Perl_sv_force_normal(pTHX_ SV *sv);
59PERL_CALLCONV void Perl_sv_setsv(pTHX_ SV *dstr, SV *sstr);
a0c21aa1 60PERL_CALLCONV void Perl_sv_catpvn(pTHX_ SV *dsv, const char* sstr, STRLEN slen);
5aaab254
KW
61PERL_CALLCONV void Perl_sv_catpvn_mg(pTHX_ SV *sv, const char *ptr, STRLEN len);
62PERL_CALLCONV void Perl_sv_catsv(pTHX_ SV *dstr, SV *sstr);
63PERL_CALLCONV void Perl_sv_catsv_mg(pTHX_ SV *dsv, SV *ssv);
a0c21aa1
JH
64PERL_CALLCONV char * Perl_sv_pv(pTHX_ SV *sv);
65PERL_CALLCONV char * Perl_sv_pvn_force(pTHX_ SV *sv, STRLEN *lp);
66PERL_CALLCONV char * Perl_sv_pvbyte(pTHX_ SV *sv);
67PERL_CALLCONV char * Perl_sv_pvutf8(pTHX_ SV *sv);
5aaab254 68PERL_CALLCONV STRLEN Perl_sv_utf8_upgrade(pTHX_ SV *sv);
a0c21aa1
JH
69PERL_CALLCONV NV Perl_huge(void);
70PERL_CALLCONV void Perl_gv_fullname3(pTHX_ SV *sv, const GV *gv, const char *prefix);
71PERL_CALLCONV void Perl_gv_efullname3(pTHX_ SV *sv, const GV *gv, const char *prefix);
72PERL_CALLCONV GV * Perl_gv_fetchmethod(pTHX_ HV *stash, const char *name);
73PERL_CALLCONV HE * Perl_hv_iternext(pTHX_ HV *hv);
74PERL_CALLCONV void Perl_hv_magic(pTHX_ HV *hv, GV *gv, int how);
5aaab254
KW
75PERL_CALLCONV bool Perl_do_open(pTHX_ GV *gv, const char *name, I32 len, int as_raw, int rawmode, int rawperm, PerlIO *supplied_fp);
76PERL_CALLCONV bool Perl_do_aexec(pTHX_ SV *really, SV **mark, SV **sp);
a0c21aa1
JH
77PERL_CALLCONV U8 * Perl_uvuni_to_utf8(pTHX_ U8 *d, UV uv);
78PERL_CALLCONV bool Perl_is_utf8_string_loc(pTHX_ const U8 *s, STRLEN len, const U8 **ep);
79PERL_CALLCONV void Perl_sv_nolocking(pTHX_ SV *sv);
80PERL_CALLCONV void Perl_sv_usepvn_mg(pTHX_ SV *sv, char *ptr, STRLEN len);
81PERL_CALLCONV void Perl_sv_usepvn(pTHX_ SV *sv, char *ptr, STRLEN len);
82PERL_CALLCONV int Perl_fprintf_nocontext(PerlIO *stream, const char *format, ...);
83PERL_CALLCONV int Perl_printf_nocontext(const char *format, ...);
56d7a086 84PERL_CALLCONV int Perl_magic_setglob(pTHX_ SV* sv, MAGIC* mg);
ac572bf4 85PERL_CALLCONV AV * Perl_newAV(pTHX);
78ac7dd9 86PERL_CALLCONV HV * Perl_newHV(pTHX);
85dca89a 87PERL_CALLCONV IO * Perl_newIO(pTHX);
0d7d409d
DM
88PERL_CALLCONV I32 Perl_my_stat(pTHX);
89PERL_CALLCONV I32 Perl_my_lstat(pTHX);
5aaab254 90PERL_CALLCONV I32 Perl_sv_eq(pTHX_ SV *sv1, SV *sv2);
078504b2 91PERL_CALLCONV char * Perl_sv_collxfrm(pTHX_ SV *const sv, STRLEN *const nxp);
5aaab254 92PERL_CALLCONV bool Perl_sv_2bool(pTHX_ SV *const sv);
7bff8c33 93PERL_CALLCONV CV * Perl_newSUB(pTHX_ I32 floor, OP* o, OP* proto, OP* block);
0c9b0438
KW
94PERL_CALLCONV UV Perl_to_utf8_lower(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp);
95PERL_CALLCONV UV Perl_to_utf8_title(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp);
96PERL_CALLCONV UV Perl_to_utf8_upper(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp);
97PERL_CALLCONV UV Perl_to_utf8_fold(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp);
108cb980 98PERL_CALLCONV SV *Perl_sv_mortalcopy(pTHX_ SV *const oldstr);
b5445a23 99
7ee2227d
SP
100/* ref() is now a macro using Perl_doref;
101 * this version provided for binary compatibility only.
102 */
103OP *
104Perl_ref(pTHX_ OP *o, I32 type)
105{
106 return doref(o, type, TRUE);
107}
108
aae9cea0 109/*
174c73e3
NC
110=for apidoc sv_unref
111
112Unsets the RV status of the SV, and decrements the reference count of
113whatever was being referenced by the RV. This can almost be thought of
114as a reversal of C<newSVrv>. This is C<sv_unref_flags> with the C<flag>
115being zero. See C<SvROK_off>.
116
117=cut
118*/
119
120void
121Perl_sv_unref(pTHX_ SV *sv)
122{
7918f24d
NC
123 PERL_ARGS_ASSERT_SV_UNREF;
124
174c73e3
NC
125 sv_unref_flags(sv, 0);
126}
127
128/*
aae9cea0
NC
129=for apidoc sv_taint
130
72d33970 131Taint an SV. Use C<SvTAINTED_on> instead.
dff47061 132
aae9cea0
NC
133=cut
134*/
135
136void
137Perl_sv_taint(pTHX_ SV *sv)
138{
7918f24d
NC
139 PERL_ARGS_ASSERT_SV_TAINT;
140
a0714e2c 141 sv_magic((sv), NULL, PERL_MAGIC_taint, NULL, 0);
aae9cea0
NC
142}
143
7ee2227d
SP
144/* sv_2iv() is now a macro using Perl_sv_2iv_flags();
145 * this function provided for binary compatibility only
146 */
147
148IV
5aaab254 149Perl_sv_2iv(pTHX_ SV *sv)
7ee2227d 150{
1061065f
DD
151 PERL_ARGS_ASSERT_SV_2IV;
152
7ee2227d
SP
153 return sv_2iv_flags(sv, SV_GMAGIC);
154}
155
156/* sv_2uv() is now a macro using Perl_sv_2uv_flags();
157 * this function provided for binary compatibility only
158 */
159
160UV
5aaab254 161Perl_sv_2uv(pTHX_ SV *sv)
7ee2227d 162{
1061065f
DD
163 PERL_ARGS_ASSERT_SV_2UV;
164
7ee2227d
SP
165 return sv_2uv_flags(sv, SV_GMAGIC);
166}
167
39d5de13
DM
168/* sv_2nv() is now a macro using Perl_sv_2nv_flags();
169 * this function provided for binary compatibility only
170 */
171
172NV
5aaab254 173Perl_sv_2nv(pTHX_ SV *sv)
39d5de13
DM
174{
175 return sv_2nv_flags(sv, SV_GMAGIC);
176}
177
178
7ee2227d
SP
179/* sv_2pv() is now a macro using Perl_sv_2pv_flags();
180 * this function provided for binary compatibility only
181 */
182
183char *
5aaab254 184Perl_sv_2pv(pTHX_ SV *sv, STRLEN *lp)
7ee2227d 185{
1061065f
DD
186 PERL_ARGS_ASSERT_SV_2PV;
187
7ee2227d
SP
188 return sv_2pv_flags(sv, lp, SV_GMAGIC);
189}
190
5abc721d 191/*
cb2f1b7b
NC
192=for apidoc sv_2pv_nolen
193
72d33970 194Like C<sv_2pv()>, but doesn't return the length too. You should usually
cb2f1b7b 195use the macro wrapper C<SvPV_nolen(sv)> instead.
dff47061 196
cb2f1b7b
NC
197=cut
198*/
199
200char *
5aaab254 201Perl_sv_2pv_nolen(pTHX_ SV *sv)
cb2f1b7b 202{
c85ae797 203 PERL_ARGS_ASSERT_SV_2PV_NOLEN;
b5445a23 204 return sv_2pv(sv, NULL);
cb2f1b7b
NC
205}
206
207/*
208=for apidoc sv_2pvbyte_nolen
209
210Return a pointer to the byte-encoded representation of the SV.
211May cause the SV to be downgraded from UTF-8 as a side-effect.
212
213Usually accessed via the C<SvPVbyte_nolen> macro.
214
215=cut
216*/
217
218char *
5aaab254 219Perl_sv_2pvbyte_nolen(pTHX_ SV *sv)
cb2f1b7b 220{
7918f24d
NC
221 PERL_ARGS_ASSERT_SV_2PVBYTE_NOLEN;
222
b5445a23 223 return sv_2pvbyte(sv, NULL);
cb2f1b7b
NC
224}
225
226/*
227=for apidoc sv_2pvutf8_nolen
228
229Return a pointer to the UTF-8-encoded representation of the SV.
230May cause the SV to be upgraded to UTF-8 as a side-effect.
231
232Usually accessed via the C<SvPVutf8_nolen> macro.
233
234=cut
235*/
236
237char *
5aaab254 238Perl_sv_2pvutf8_nolen(pTHX_ SV *sv)
cb2f1b7b 239{
7918f24d
NC
240 PERL_ARGS_ASSERT_SV_2PVUTF8_NOLEN;
241
b5445a23 242 return sv_2pvutf8(sv, NULL);
cb2f1b7b
NC
243}
244
245/*
5abc721d
NC
246=for apidoc sv_force_normal
247
248Undo various types of fakery on an SV: if the PV is a shared string, make
249a private copy; if we're a ref, stop refing; if we're a glob, downgrade to
72d33970 250an xpvmg. See also C<sv_force_normal_flags>.
5abc721d
NC
251
252=cut
253*/
254
255void
5aaab254 256Perl_sv_force_normal(pTHX_ SV *sv)
5abc721d 257{
7918f24d
NC
258 PERL_ARGS_ASSERT_SV_FORCE_NORMAL;
259
5abc721d
NC
260 sv_force_normal_flags(sv, 0);
261}
7ee2227d
SP
262
263/* sv_setsv() is now a macro using Perl_sv_setsv_flags();
264 * this function provided for binary compatibility only
265 */
266
267void
5aaab254 268Perl_sv_setsv(pTHX_ SV *dstr, SV *sstr)
7ee2227d 269{
7918f24d
NC
270 PERL_ARGS_ASSERT_SV_SETSV;
271
7ee2227d
SP
272 sv_setsv_flags(dstr, sstr, SV_GMAGIC);
273}
274
275/* sv_catpvn() is now a macro using Perl_sv_catpvn_flags();
276 * this function provided for binary compatibility only
277 */
278
279void
280Perl_sv_catpvn(pTHX_ SV *dsv, const char* sstr, STRLEN slen)
281{
7918f24d
NC
282 PERL_ARGS_ASSERT_SV_CATPVN;
283
7ee2227d
SP
284 sv_catpvn_flags(dsv, sstr, slen, SV_GMAGIC);
285}
286
b347df82
NC
287/*
288=for apidoc sv_catpvn_mg
289
290Like C<sv_catpvn>, but also handles 'set' magic.
291
292=cut
293*/
294
295void
5aaab254 296Perl_sv_catpvn_mg(pTHX_ SV *sv, const char *ptr, STRLEN len)
b347df82 297{
7918f24d
NC
298 PERL_ARGS_ASSERT_SV_CATPVN_MG;
299
b347df82
NC
300 sv_catpvn_flags(sv,ptr,len,SV_GMAGIC|SV_SMAGIC);
301}
302
7ee2227d
SP
303/* sv_catsv() is now a macro using Perl_sv_catsv_flags();
304 * this function provided for binary compatibility only
305 */
306
307void
5aaab254 308Perl_sv_catsv(pTHX_ SV *dstr, SV *sstr)
7ee2227d 309{
7918f24d
NC
310 PERL_ARGS_ASSERT_SV_CATSV;
311
7ee2227d
SP
312 sv_catsv_flags(dstr, sstr, SV_GMAGIC);
313}
314
0feed65a 315/*
b347df82
NC
316=for apidoc sv_catsv_mg
317
318Like C<sv_catsv>, but also handles 'set' magic.
319
320=cut
321*/
322
323void
5aaab254 324Perl_sv_catsv_mg(pTHX_ SV *dsv, SV *ssv)
b347df82 325{
7918f24d
NC
326 PERL_ARGS_ASSERT_SV_CATSV_MG;
327
b347df82
NC
328 sv_catsv_flags(dsv,ssv,SV_GMAGIC|SV_SMAGIC);
329}
330
331/*
0feed65a
NC
332=for apidoc sv_iv
333
334A private implementation of the C<SvIVx> macro for compilers which can't
72d33970 335cope with complex macro expressions. Always use the macro instead.
0feed65a
NC
336
337=cut
338*/
339
340IV
5aaab254 341Perl_sv_iv(pTHX_ SV *sv)
0feed65a 342{
7918f24d
NC
343 PERL_ARGS_ASSERT_SV_IV;
344
0feed65a
NC
345 if (SvIOK(sv)) {
346 if (SvIsUV(sv))
347 return (IV)SvUVX(sv);
348 return SvIVX(sv);
349 }
350 return sv_2iv(sv);
351}
352
353/*
354=for apidoc sv_uv
355
356A private implementation of the C<SvUVx> macro for compilers which can't
72d33970 357cope with complex macro expressions. Always use the macro instead.
0feed65a
NC
358
359=cut
360*/
361
362UV
5aaab254 363Perl_sv_uv(pTHX_ SV *sv)
0feed65a 364{
7918f24d
NC
365 PERL_ARGS_ASSERT_SV_UV;
366
0feed65a
NC
367 if (SvIOK(sv)) {
368 if (SvIsUV(sv))
369 return SvUVX(sv);
370 return (UV)SvIVX(sv);
371 }
372 return sv_2uv(sv);
373}
374
375/*
376=for apidoc sv_nv
377
378A private implementation of the C<SvNVx> macro for compilers which can't
72d33970 379cope with complex macro expressions. Always use the macro instead.
0feed65a
NC
380
381=cut
382*/
383
384NV
5aaab254 385Perl_sv_nv(pTHX_ SV *sv)
0feed65a 386{
7918f24d
NC
387 PERL_ARGS_ASSERT_SV_NV;
388
0feed65a
NC
389 if (SvNOK(sv))
390 return SvNVX(sv);
391 return sv_2nv(sv);
392}
393
394/*
395=for apidoc sv_pv
396
397Use the C<SvPV_nolen> macro instead
398
399=for apidoc sv_pvn
400
401A private implementation of the C<SvPV> macro for compilers which can't
72d33970 402cope with complex macro expressions. Always use the macro instead.
0feed65a
NC
403
404=cut
405*/
406
407char *
408Perl_sv_pvn(pTHX_ SV *sv, STRLEN *lp)
409{
7918f24d
NC
410 PERL_ARGS_ASSERT_SV_PVN;
411
0feed65a
NC
412 if (SvPOK(sv)) {
413 *lp = SvCUR(sv);
414 return SvPVX(sv);
415 }
416 return sv_2pv(sv, lp);
417}
418
419
420char *
5aaab254 421Perl_sv_pvn_nomg(pTHX_ SV *sv, STRLEN *lp)
0feed65a 422{
7918f24d
NC
423 PERL_ARGS_ASSERT_SV_PVN_NOMG;
424
0feed65a
NC
425 if (SvPOK(sv)) {
426 *lp = SvCUR(sv);
427 return SvPVX(sv);
428 }
429 return sv_2pv_flags(sv, lp, 0);
430}
431
7ee2227d
SP
432/* sv_pv() is now a macro using SvPV_nolen();
433 * this function provided for binary compatibility only
434 */
435
436char *
437Perl_sv_pv(pTHX_ SV *sv)
438{
7918f24d
NC
439 PERL_ARGS_ASSERT_SV_PV;
440
7ee2227d
SP
441 if (SvPOK(sv))
442 return SvPVX(sv);
443
b5445a23 444 return sv_2pv(sv, NULL);
7ee2227d
SP
445}
446
447/* sv_pvn_force() is now a macro using Perl_sv_pvn_force_flags();
448 * this function provided for binary compatibility only
449 */
450
451char *
452Perl_sv_pvn_force(pTHX_ SV *sv, STRLEN *lp)
453{
7918f24d
NC
454 PERL_ARGS_ASSERT_SV_PVN_FORCE;
455
7ee2227d
SP
456 return sv_pvn_force_flags(sv, lp, SV_GMAGIC);
457}
458
459/* sv_pvbyte () is now a macro using Perl_sv_2pv_flags();
460 * this function provided for binary compatibility only
461 */
462
463char *
464Perl_sv_pvbyte(pTHX_ SV *sv)
465{
7918f24d
NC
466 PERL_ARGS_ASSERT_SV_PVBYTE;
467
b5445a23 468 sv_utf8_downgrade(sv, FALSE);
7ee2227d
SP
469 return sv_pv(sv);
470}
471
0feed65a
NC
472/*
473=for apidoc sv_pvbyte
474
475Use C<SvPVbyte_nolen> instead.
476
477=for apidoc sv_pvbyten
478
479A private implementation of the C<SvPVbyte> macro for compilers
72d33970 480which can't cope with complex macro expressions. Always use the macro
0feed65a
NC
481instead.
482
483=cut
484*/
485
486char *
487Perl_sv_pvbyten(pTHX_ SV *sv, STRLEN *lp)
488{
7918f24d
NC
489 PERL_ARGS_ASSERT_SV_PVBYTEN;
490
b5445a23 491 sv_utf8_downgrade(sv, FALSE);
0feed65a
NC
492 return sv_pvn(sv,lp);
493}
494
7ee2227d
SP
495/* sv_pvutf8 () is now a macro using Perl_sv_2pv_flags();
496 * this function provided for binary compatibility only
497 */
498
499char *
500Perl_sv_pvutf8(pTHX_ SV *sv)
501{
7918f24d
NC
502 PERL_ARGS_ASSERT_SV_PVUTF8;
503
7ee2227d
SP
504 sv_utf8_upgrade(sv);
505 return sv_pv(sv);
506}
507
0feed65a
NC
508/*
509=for apidoc sv_pvutf8
510
511Use the C<SvPVutf8_nolen> macro instead
512
513=for apidoc sv_pvutf8n
514
515A private implementation of the C<SvPVutf8> macro for compilers
72d33970 516which can't cope with complex macro expressions. Always use the macro
0feed65a
NC
517instead.
518
519=cut
520*/
521
522char *
523Perl_sv_pvutf8n(pTHX_ SV *sv, STRLEN *lp)
524{
7918f24d
NC
525 PERL_ARGS_ASSERT_SV_PVUTF8N;
526
0feed65a
NC
527 sv_utf8_upgrade(sv);
528 return sv_pvn(sv,lp);
529}
530
205c02c2
NC
531/* sv_utf8_upgrade() is now a macro using sv_utf8_upgrade_flags();
532 * this function provided for binary compatibility only
533 */
534
535STRLEN
5aaab254 536Perl_sv_utf8_upgrade(pTHX_ SV *sv)
205c02c2 537{
7918f24d
NC
538 PERL_ARGS_ASSERT_SV_UTF8_UPGRADE;
539
205c02c2
NC
540 return sv_utf8_upgrade_flags(sv, SV_GMAGIC);
541}
542
7ee2227d
SP
543int
544Perl_fprintf_nocontext(PerlIO *stream, const char *format, ...)
545{
546 dTHXs;
547 va_list(arglist);
7918f24d
NC
548
549 /* Easier to special case this here than in embed.pl. (Look at what it
550 generates for proto.h) */
551#ifdef PERL_IMPLICIT_CONTEXT
552 PERL_ARGS_ASSERT_FPRINTF_NOCONTEXT;
553#endif
554
7ee2227d
SP
555 va_start(arglist, format);
556 return PerlIO_vprintf(stream, format, arglist);
557}
558
559int
560Perl_printf_nocontext(const char *format, ...)
561{
562 dTHX;
563 va_list(arglist);
7918f24d
NC
564
565#ifdef PERL_IMPLICIT_CONTEXT
566 PERL_ARGS_ASSERT_PRINTF_NOCONTEXT;
567#endif
568
7ee2227d
SP
569 va_start(arglist, format);
570 return PerlIO_vprintf(PerlIO_stdout(), format, arglist);
571}
572
573#if defined(HUGE_VAL) || (defined(USE_LONG_DOUBLE) && defined(HUGE_VALL))
574/*
575 * This hack is to force load of "huge" support from libm.a
576 * So it is in perl for (say) POSIX to use.
577 * Needed for SunOS with Sun's 'acc' for example.
578 */
579NV
580Perl_huge(void)
581{
c773ee7a 582# if defined(USE_LONG_DOUBLE) && defined(HUGE_VALL)
7ee2227d 583 return HUGE_VALL;
c773ee7a 584# else
7ee2227d 585 return HUGE_VAL;
c773ee7a 586# endif
7ee2227d
SP
587}
588#endif
589
f2f0f092
NC
590/* compatibility with versions <= 5.003. */
591void
592Perl_gv_fullname(pTHX_ SV *sv, const GV *gv)
593{
7918f24d
NC
594 PERL_ARGS_ASSERT_GV_FULLNAME;
595
666ea192 596 gv_fullname3(sv, gv, sv == (const SV*)gv ? "*" : "");
f2f0f092
NC
597}
598
599/* compatibility with versions <= 5.003. */
600void
601Perl_gv_efullname(pTHX_ SV *sv, const GV *gv)
602{
7918f24d
NC
603 PERL_ARGS_ASSERT_GV_EFULLNAME;
604
666ea192 605 gv_efullname3(sv, gv, sv == (const SV*)gv ? "*" : "");
f2f0f092
NC
606}
607
2674aeec
NC
608void
609Perl_gv_fullname3(pTHX_ SV *sv, const GV *gv, const char *prefix)
610{
7918f24d
NC
611 PERL_ARGS_ASSERT_GV_FULLNAME3;
612
2674aeec
NC
613 gv_fullname4(sv, gv, prefix, TRUE);
614}
615
616void
617Perl_gv_efullname3(pTHX_ SV *sv, const GV *gv, const char *prefix)
618{
7918f24d
NC
619 PERL_ARGS_ASSERT_GV_EFULLNAME3;
620
2674aeec
NC
621 gv_efullname4(sv, gv, prefix, TRUE);
622}
623
887986eb
NC
624/*
625=for apidoc gv_fetchmethod
626
ca8b95d7 627See L</gv_fetchmethod_autoload>.
887986eb
NC
628
629=cut
630*/
631
632GV *
633Perl_gv_fetchmethod(pTHX_ HV *stash, const char *name)
634{
7918f24d
NC
635 PERL_ARGS_ASSERT_GV_FETCHMETHOD;
636
887986eb
NC
637 return gv_fetchmethod_autoload(stash, name, TRUE);
638}
639
7a7b9979
NC
640HE *
641Perl_hv_iternext(pTHX_ HV *hv)
642{
7918f24d
NC
643 PERL_ARGS_ASSERT_HV_ITERNEXT;
644
7a7b9979
NC
645 return hv_iternext_flags(hv, 0);
646}
647
bc5cdc23
NC
648void
649Perl_hv_magic(pTHX_ HV *hv, GV *gv, int how)
650{
7918f24d
NC
651 PERL_ARGS_ASSERT_HV_MAGIC;
652
ad64d0ec 653 sv_magic(MUTABLE_SV(hv), MUTABLE_SV(gv), how, NULL, 0);
bc5cdc23
NC
654}
655
34d367cd 656bool
5aaab254 657Perl_do_open(pTHX_ GV *gv, const char *name, I32 len, int as_raw,
e4dba786
NC
658 int rawmode, int rawperm, PerlIO *supplied_fp)
659{
7918f24d
NC
660 PERL_ARGS_ASSERT_DO_OPEN;
661
e4dba786
NC
662 return do_openn(gv, name, len, as_raw, rawmode, rawperm,
663 supplied_fp, (SV **) NULL, 0);
664}
665
666bool
5aaab254 667Perl_do_open9(pTHX_ GV *gv, const char *name, I32 len, int
34d367cd
SP
668as_raw,
669 int rawmode, int rawperm, PerlIO *supplied_fp, SV *svs,
670 I32 num_svs)
671{
7918f24d
NC
672 PERL_ARGS_ASSERT_DO_OPEN9;
673
34d367cd
SP
674 PERL_UNUSED_ARG(num_svs);
675 return do_openn(gv, name, len, as_raw, rawmode, rawperm,
676 supplied_fp, &svs, 1);
677}
678
679int
680Perl_do_binmode(pTHX_ PerlIO *fp, int iotype, int mode)
681{
682 /* The old body of this is now in non-LAYER part of perlio.c
683 * This is a stub for any XS code which might have been calling it.
684 */
685 const char *name = ":raw";
7918f24d
NC
686
687 PERL_ARGS_ASSERT_DO_BINMODE;
688
34d367cd
SP
689#ifdef PERLIO_USING_CRLF
690 if (!(mode & O_BINARY))
691 name = ":crlf";
692#endif
693 return PerlIO_binmode(aTHX_ fp, iotype, mode, name);
694}
695
a9f96b3f
NC
696#ifndef OS2
697bool
5aaab254 698Perl_do_aexec(pTHX_ SV *really, SV **mark, SV **sp)
a9f96b3f 699{
7918f24d
NC
700 PERL_ARGS_ASSERT_DO_AEXEC;
701
a9f96b3f
NC
702 return do_aexec5(really, mark, sp, 0, 0);
703}
704#endif
705
89552e80
NC
706/* Backwards compatibility. */
707int
708Perl_init_i18nl14n(pTHX_ int printwarn)
709{
710 return init_i18nl10n(printwarn);
711}
712
814fafa7
NC
713bool
714Perl_is_utf8_string_loc(pTHX_ const U8 *s, STRLEN len, const U8 **ep)
715{
7918f24d
NC
716 PERL_ARGS_ASSERT_IS_UTF8_STRING_LOC;
717
814fafa7
NC
718 return is_utf8_string_loclen(s, len, ep, 0);
719}
720
7ee2227d 721/*
d5b2b27b
NC
722=for apidoc sv_nolocking
723
724Dummy routine which "locks" an SV when there is no locking module present.
725Exists to avoid test for a NULL function pointer and because it could
726potentially warn under some level of strict-ness.
727
728"Superseded" by sv_nosharing().
729
730=cut
731*/
732
733void
734Perl_sv_nolocking(pTHX_ SV *sv)
735{
96a5add6 736 PERL_UNUSED_CONTEXT;
d5b2b27b
NC
737 PERL_UNUSED_ARG(sv);
738}
739
740
741/*
742=for apidoc sv_nounlocking
743
744Dummy routine which "unlocks" an SV when there is no locking module present.
745Exists to avoid test for a NULL function pointer and because it could
746potentially warn under some level of strict-ness.
747
748"Superseded" by sv_nosharing().
749
750=cut
751*/
752
753void
754Perl_sv_nounlocking(pTHX_ SV *sv)
755{
96a5add6 756 PERL_UNUSED_CONTEXT;
d5b2b27b
NC
757 PERL_UNUSED_ARG(sv);
758}
759
2053acbf
NC
760void
761Perl_save_long(pTHX_ long int *longp)
762{
763 dVAR;
7918f24d
NC
764
765 PERL_ARGS_ASSERT_SAVE_LONG;
766
2053acbf
NC
767 SSCHECK(3);
768 SSPUSHLONG(*longp);
769 SSPUSHPTR(longp);
c6bf6a65 770 SSPUSHUV(SAVEt_LONG);
2053acbf
NC
771}
772
773void
2053acbf
NC
774Perl_save_iv(pTHX_ IV *ivp)
775{
776 dVAR;
7918f24d
NC
777
778 PERL_ARGS_ASSERT_SAVE_IV;
779
2053acbf
NC
780 SSCHECK(3);
781 SSPUSHIV(*ivp);
782 SSPUSHPTR(ivp);
c6bf6a65 783 SSPUSHUV(SAVEt_IV);
2053acbf
NC
784}
785
786void
787Perl_save_nogv(pTHX_ GV *gv)
788{
789 dVAR;
7918f24d
NC
790
791 PERL_ARGS_ASSERT_SAVE_NOGV;
792
2053acbf
NC
793 SSCHECK(2);
794 SSPUSHPTR(gv);
c6bf6a65 795 SSPUSHUV(SAVEt_NSTAB);
2053acbf
NC
796}
797
798void
5aaab254 799Perl_save_list(pTHX_ SV **sarg, I32 maxsarg)
2053acbf
NC
800{
801 dVAR;
eb578fdb 802 I32 i;
2053acbf 803
7918f24d
NC
804 PERL_ARGS_ASSERT_SAVE_LIST;
805
2053acbf 806 for (i = 1; i <= maxsarg; i++) {
3ed356df
FC
807 SV *sv;
808 SvGETMAGIC(sarg[i]);
809 sv = newSV(0);
810 sv_setsv_nomg(sv,sarg[i]);
2053acbf
NC
811 SSCHECK(3);
812 SSPUSHPTR(sarg[i]); /* remember the pointer */
813 SSPUSHPTR(sv); /* remember the value */
c6bf6a65 814 SSPUSHUV(SAVEt_ITEM);
2053acbf
NC
815 }
816}
817
47518d95
NC
818/*
819=for apidoc sv_usepvn_mg
820
821Like C<sv_usepvn>, but also handles 'set' magic.
822
823=cut
824*/
825
826void
827Perl_sv_usepvn_mg(pTHX_ SV *sv, char *ptr, STRLEN len)
828{
7918f24d
NC
829 PERL_ARGS_ASSERT_SV_USEPVN_MG;
830
47518d95
NC
831 sv_usepvn_flags(sv,ptr,len, SV_SMAGIC);
832}
833
834/*
835=for apidoc sv_usepvn
836
72d33970 837Tells an SV to use C<ptr> to find its string value. Implemented by
47518d95 838calling C<sv_usepvn_flags> with C<flags> of 0, hence does not handle 'set'
72d33970 839magic. See C<sv_usepvn_flags>.
47518d95
NC
840
841=cut
842*/
843
844void
845Perl_sv_usepvn(pTHX_ SV *sv, char *ptr, STRLEN len)
846{
7918f24d
NC
847 PERL_ARGS_ASSERT_SV_USEPVN;
848
47518d95
NC
849 sv_usepvn_flags(sv,ptr,len, 0);
850}
851
c03e83bf
NC
852/*
853=for apidoc unpack_str
854
72d33970
FC
855The engine implementing unpack() Perl function. Note: parameters strbeg,
856new_s and ocnt are not used. This call should not be used, use
857unpackstring instead.
c03e83bf
NC
858
859=cut */
860
861I32
862Perl_unpack_str(pTHX_ const char *pat, const char *patend, const char *s,
863 const char *strbeg, const char *strend, char **new_s, I32 ocnt,
864 U32 flags)
865{
7918f24d
NC
866 PERL_ARGS_ASSERT_UNPACK_STR;
867
c03e83bf
NC
868 PERL_UNUSED_ARG(strbeg);
869 PERL_UNUSED_ARG(new_s);
870 PERL_UNUSED_ARG(ocnt);
871
872 return unpackstring(pat, patend, s, strend, flags);
873}
b47163a2
NC
874
875/*
876=for apidoc pack_cat
877
72d33970
FC
878The engine implementing pack() Perl function. Note: parameters
879next_in_list and flags are not used. This call should not be used; use
880packlist instead.
b47163a2
NC
881
882=cut
883*/
884
885void
5aaab254 886Perl_pack_cat(pTHX_ SV *cat, const char *pat, const char *patend, SV **beglist, SV **endlist, SV ***next_in_list, U32 flags)
b47163a2 887{
7918f24d
NC
888 PERL_ARGS_ASSERT_PACK_CAT;
889
b47163a2
NC
890 PERL_UNUSED_ARG(next_in_list);
891 PERL_UNUSED_ARG(flags);
892
893 packlist(cat, pat, patend, beglist, endlist);
894}
4c2df08c
NC
895
896HE *
897Perl_hv_store_ent(pTHX_ HV *hv, SV *keysv, SV *val, U32 hash)
898{
59af68cc 899 return (HE *)hv_common(hv, keysv, NULL, 0, 0, HV_FETCH_ISSTORE, val, hash);
4c2df08c
NC
900}
901
902bool
903Perl_hv_exists_ent(pTHX_ HV *hv, SV *keysv, U32 hash)
904{
7918f24d
NC
905 PERL_ARGS_ASSERT_HV_EXISTS_ENT;
906
4c2df08c
NC
907 return hv_common(hv, keysv, NULL, 0, 0, HV_FETCH_ISEXISTS, 0, hash)
908 ? TRUE : FALSE;
909}
910
911HE *
912Perl_hv_fetch_ent(pTHX_ HV *hv, SV *keysv, I32 lval, U32 hash)
913{
7918f24d
NC
914 PERL_ARGS_ASSERT_HV_FETCH_ENT;
915
59af68cc 916 return (HE *)hv_common(hv, keysv, NULL, 0, 0,
4c2df08c
NC
917 (lval ? HV_FETCH_LVALUE : 0), NULL, hash);
918}
919
920SV *
921Perl_hv_delete_ent(pTHX_ HV *hv, SV *keysv, I32 flags, U32 hash)
922{
7918f24d
NC
923 PERL_ARGS_ASSERT_HV_DELETE_ENT;
924
ad64d0ec
NC
925 return MUTABLE_SV(hv_common(hv, keysv, NULL, 0, 0, flags | HV_DELETE, NULL,
926 hash));
4c2df08c
NC
927}
928
a038e571
NC
929SV**
930Perl_hv_store_flags(pTHX_ HV *hv, const char *key, I32 klen, SV *val, U32 hash,
931 int flags)
932{
933 return (SV**) hv_common(hv, NULL, key, klen, flags,
934 (HV_FETCH_ISSTORE|HV_FETCH_JUST_SV), val, hash);
935}
936
937SV**
938Perl_hv_store(pTHX_ HV *hv, const char *key, I32 klen_i32, SV *val, U32 hash)
939{
940 STRLEN klen;
941 int flags;
942
943 if (klen_i32 < 0) {
944 klen = -klen_i32;
945 flags = HVhek_UTF8;
946 } else {
947 klen = klen_i32;
948 flags = 0;
949 }
950 return (SV **) hv_common(hv, NULL, key, klen, flags,
951 (HV_FETCH_ISSTORE|HV_FETCH_JUST_SV), val, hash);
952}
953
954bool
955Perl_hv_exists(pTHX_ HV *hv, const char *key, I32 klen_i32)
956{
957 STRLEN klen;
958 int flags;
959
7918f24d
NC
960 PERL_ARGS_ASSERT_HV_EXISTS;
961
a038e571
NC
962 if (klen_i32 < 0) {
963 klen = -klen_i32;
964 flags = HVhek_UTF8;
965 } else {
966 klen = klen_i32;
967 flags = 0;
968 }
969 return hv_common(hv, NULL, key, klen, flags, HV_FETCH_ISEXISTS, 0, 0)
970 ? TRUE : FALSE;
971}
972
973SV**
974Perl_hv_fetch(pTHX_ HV *hv, const char *key, I32 klen_i32, I32 lval)
975{
976 STRLEN klen;
977 int flags;
978
7918f24d
NC
979 PERL_ARGS_ASSERT_HV_FETCH;
980
a038e571
NC
981 if (klen_i32 < 0) {
982 klen = -klen_i32;
983 flags = HVhek_UTF8;
984 } else {
985 klen = klen_i32;
986 flags = 0;
987 }
988 return (SV **) hv_common(hv, NULL, key, klen, flags,
989 lval ? (HV_FETCH_JUST_SV | HV_FETCH_LVALUE)
990 : HV_FETCH_JUST_SV, NULL, 0);
991}
992
993SV *
994Perl_hv_delete(pTHX_ HV *hv, const char *key, I32 klen_i32, I32 flags)
995{
996 STRLEN klen;
997 int k_flags;
998
7918f24d
NC
999 PERL_ARGS_ASSERT_HV_DELETE;
1000
a038e571
NC
1001 if (klen_i32 < 0) {
1002 klen = -klen_i32;
1003 k_flags = HVhek_UTF8;
1004 } else {
1005 klen = klen_i32;
1006 k_flags = 0;
1007 }
ad64d0ec
NC
1008 return MUTABLE_SV(hv_common(hv, NULL, key, klen, k_flags, flags | HV_DELETE,
1009 NULL, 0));
a038e571
NC
1010}
1011
56d7a086 1012/* Functions after here were made mathoms post 5.10.0 but pre 5.8.9 */
56d7a086 1013
ac572bf4
NC
1014AV *
1015Perl_newAV(pTHX)
1016{
502c6561 1017 return MUTABLE_AV(newSV_type(SVt_PVAV));
ac572bf4
NC
1018 /* sv_upgrade does AvREAL_only():
1019 AvALLOC(av) = 0;
1020 AvARRAY(av) = NULL;
1021 AvMAX(av) = AvFILLp(av) = -1; */
1022}
1023
78ac7dd9
NC
1024HV *
1025Perl_newHV(pTHX)
1026{
85fbaab2 1027 HV * const hv = MUTABLE_HV(newSV_type(SVt_PVHV));
78ac7dd9
NC
1028 assert(!SvOK(hv));
1029
1030 return hv;
1031}
1032
84335ee9
NC
1033void
1034Perl_sv_insert(pTHX_ SV *const bigstr, const STRLEN offset, const STRLEN len,
1035 const char *const little, const STRLEN littlelen)
1036{
1037 PERL_ARGS_ASSERT_SV_INSERT;
1038 sv_insert_flags(bigstr, offset, len, little, littlelen, SV_GMAGIC);
1039}
1040
2fd8beea
NC
1041void
1042Perl_save_freesv(pTHX_ SV *sv)
1043{
1044 dVAR;
1045 save_freesv(sv);
1046}
1047
1048void
1049Perl_save_mortalizesv(pTHX_ SV *sv)
1050{
1051 dVAR;
1052
1053 PERL_ARGS_ASSERT_SAVE_MORTALIZESV;
1054
1055 save_mortalizesv(sv);
1056}
1057
1058void
1059Perl_save_freeop(pTHX_ OP *o)
1060{
1061 dVAR;
1062 save_freeop(o);
1063}
1064
1065void
1066Perl_save_freepv(pTHX_ char *pv)
1067{
1068 dVAR;
1069 save_freepv(pv);
1070}
1071
1072void
1073Perl_save_op(pTHX)
1074{
1075 dVAR;
1076 save_op();
1077}
1078
d5713896
NC
1079#ifdef PERL_DONT_CREATE_GVSV
1080GV *
1081Perl_gv_SVadd(pTHX_ GV *gv)
1082{
d5713896
NC
1083 return gv_SVadd(gv);
1084}
1085#endif
1086
1087GV *
1088Perl_gv_AVadd(pTHX_ GV *gv)
1089{
d5713896
NC
1090 return gv_AVadd(gv);
1091}
1092
1093GV *
5aaab254 1094Perl_gv_HVadd(pTHX_ GV *gv)
d5713896 1095{
d5713896
NC
1096 return gv_HVadd(gv);
1097}
1098
bb85b28a 1099GV *
5aaab254 1100Perl_gv_IOadd(pTHX_ GV *gv)
bb85b28a
NC
1101{
1102 return gv_IOadd(gv);
1103}
1104
85dca89a
NC
1105IO *
1106Perl_newIO(pTHX)
1107{
1108 return MUTABLE_IO(newSV_type(SVt_PVIO));
1109}
1110
0d7d409d
DM
1111I32
1112Perl_my_stat(pTHX)
1113{
1114 return my_stat_flags(SV_GMAGIC);
1115}
1116
1117I32
1118Perl_my_lstat(pTHX)
1119{
1120 return my_lstat_flags(SV_GMAGIC);
1121}
1122
078504b2 1123I32
5aaab254 1124Perl_sv_eq(pTHX_ SV *sv1, SV *sv2)
078504b2
FC
1125{
1126 return sv_eq_flags(sv1, sv2, SV_GMAGIC);
1127}
1128
6129b56c 1129#ifdef USE_LOCALE_COLLATE
078504b2
FC
1130char *
1131Perl_sv_collxfrm(pTHX_ SV *const sv, STRLEN *const nxp)
1132{
1133 return sv_collxfrm_flags(sv, nxp, SV_GMAGIC);
1134}
6129b56c 1135#endif
078504b2 1136
06c841cf 1137bool
5aaab254 1138Perl_sv_2bool(pTHX_ SV *const sv)
06c841cf
FC
1139{
1140 return sv_2bool_flags(sv, SV_GMAGIC);
1141}
1142
1830b3d9 1143
9733086d
BM
1144/*
1145=for apidoc custom_op_name
72d33970 1146Return the name for a given custom op. This was once used by the OP_NAME
9733086d
BM
1147macro, but is no longer: it has only been kept for compatibility, and
1148should not be used.
1149
1150=for apidoc custom_op_desc
72d33970 1151Return the description of a given custom op. This was once used by the
9733086d
BM
1152OP_DESC macro, but is no longer: it has only been kept for
1153compatibility, and should not be used.
1154
1155=cut
1156*/
1157
1830b3d9
BM
1158const char*
1159Perl_custom_op_name(pTHX_ const OP* o)
1160{
1161 PERL_ARGS_ASSERT_CUSTOM_OP_NAME;
ae103e09 1162 return XopENTRYCUSTOM(o, xop_name);
1830b3d9
BM
1163}
1164
1165const char*
1166Perl_custom_op_desc(pTHX_ const OP* o)
1167{
1168 PERL_ARGS_ASSERT_CUSTOM_OP_DESC;
ae103e09 1169 return XopENTRYCUSTOM(o, xop_desc);
1830b3d9 1170}
7bff8c33
NC
1171
1172CV *
1173Perl_newSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *block)
1174{
e8f91c91 1175 return newATTRSUB(floor, o, proto, NULL, block);
7bff8c33 1176}
0c9b0438
KW
1177
1178UV
1179Perl_to_utf8_fold(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp)
1180{
1181 PERL_ARGS_ASSERT_TO_UTF8_FOLD;
1182
1183 return _to_utf8_fold_flags(p, ustrp, lenp, FOLD_FLAGS_FULL, NULL);
1184}
1185
1186UV
1187Perl_to_utf8_lower(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp)
1188{
1189 PERL_ARGS_ASSERT_TO_UTF8_LOWER;
1190
1191 return _to_utf8_lower_flags(p, ustrp, lenp, FALSE, NULL);
1192}
1193
1194UV
1195Perl_to_utf8_title(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp)
1196{
1197 PERL_ARGS_ASSERT_TO_UTF8_TITLE;
1198
1199 return _to_utf8_title_flags(p, ustrp, lenp, FALSE, NULL);
1200}
1201
1202UV
1203Perl_to_utf8_upper(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp)
1204{
1205 PERL_ARGS_ASSERT_TO_UTF8_UPPER;
1206
1207 return _to_utf8_upper_flags(p, ustrp, lenp, FALSE, NULL);
1208}
1209
108cb980
FC
1210SV *
1211Perl_sv_mortalcopy(pTHX_ SV *const oldstr)
1212{
33971c01 1213 return Perl_sv_mortalcopy_flags(aTHX_ oldstr, SV_GMAGIC);
108cb980
FC
1214}
1215
3d81eea6
KW
1216UV /* Made into a function, so can be deprecated */
1217NATIVE_TO_NEED(const UV enc, const UV ch)
1218{
1219 PERL_UNUSED_ARG(enc);
1220 return ch;
1221}
1222
1223UV /* Made into a function, so can be deprecated */
1224ASCII_TO_NEED(const UV enc, const UV ch)
1225{
1226 PERL_UNUSED_ARG(enc);
1227 return ch;
1228}
1229
361ec98e 1230END_EXTERN_C
d4478588 1231
20fac488
GA
1232#endif /* NO_MATHOMS */
1233
d5b2b27b 1234/*
7ee2227d
SP
1235 * Local variables:
1236 * c-indentation-style: bsd
1237 * c-basic-offset: 4
14d04a33 1238 * indent-tabs-mode: nil
7ee2227d
SP
1239 * End:
1240 *
14d04a33 1241 * ex: set ts=8 sts=4 sw=4 et:
7ee2227d 1242 */