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