This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Revert "/* NOTREACHED */ belongs *before* the unreachable."
[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 *
dcccc8ff
KW
31=head1 Obsolete backwards compatibility functions
32Some of these are also deprecated. You can exclude these from
33your compiled Perl by adding this option to Configure:
34C<-Accflags='-DNO_MATHOMS'>
35
36=cut
37
7ee2227d
SP
38 */
39
dcccc8ff 40
7ee2227d
SP
41#include "EXTERN.h"
42#define PERL_IN_MATHOMS_C
43#include "perl.h"
44
359d40ba
NC
45#ifdef NO_MATHOMS
46/* ..." warning: ISO C forbids an empty source file"
47 So make sure we have something in here by processing the headers anyway.
48 */
49#else
50
d4478588
CB
51/* Not all of these have prototypes elsewhere, so do this to get
52 * non-mangled names.
53 */
361ec98e 54START_EXTERN_C
d4478588 55
a0c21aa1
JH
56PERL_CALLCONV OP * Perl_ref(pTHX_ OP *o, I32 type);
57PERL_CALLCONV void Perl_sv_unref(pTHX_ SV *sv);
58PERL_CALLCONV void Perl_sv_taint(pTHX_ SV *sv);
5aaab254
KW
59PERL_CALLCONV IV Perl_sv_2iv(pTHX_ SV *sv);
60PERL_CALLCONV UV Perl_sv_2uv(pTHX_ SV *sv);
61PERL_CALLCONV NV Perl_sv_2nv(pTHX_ SV *sv);
62PERL_CALLCONV char * Perl_sv_2pv(pTHX_ SV *sv, STRLEN *lp);
63PERL_CALLCONV char * Perl_sv_2pv_nolen(pTHX_ SV *sv);
64PERL_CALLCONV char * Perl_sv_2pvbyte_nolen(pTHX_ SV *sv);
65PERL_CALLCONV char * Perl_sv_2pvutf8_nolen(pTHX_ SV *sv);
66PERL_CALLCONV void Perl_sv_force_normal(pTHX_ SV *sv);
67PERL_CALLCONV void Perl_sv_setsv(pTHX_ SV *dstr, SV *sstr);
a0c21aa1 68PERL_CALLCONV void Perl_sv_catpvn(pTHX_ SV *dsv, const char* sstr, STRLEN slen);
5aaab254
KW
69PERL_CALLCONV void Perl_sv_catpvn_mg(pTHX_ SV *sv, const char *ptr, STRLEN len);
70PERL_CALLCONV void Perl_sv_catsv(pTHX_ SV *dstr, SV *sstr);
71PERL_CALLCONV void Perl_sv_catsv_mg(pTHX_ SV *dsv, SV *ssv);
a0c21aa1
JH
72PERL_CALLCONV char * Perl_sv_pv(pTHX_ SV *sv);
73PERL_CALLCONV char * Perl_sv_pvn_force(pTHX_ SV *sv, STRLEN *lp);
74PERL_CALLCONV char * Perl_sv_pvbyte(pTHX_ SV *sv);
75PERL_CALLCONV char * Perl_sv_pvutf8(pTHX_ SV *sv);
5aaab254 76PERL_CALLCONV STRLEN Perl_sv_utf8_upgrade(pTHX_ SV *sv);
a0c21aa1
JH
77PERL_CALLCONV NV Perl_huge(void);
78PERL_CALLCONV void Perl_gv_fullname3(pTHX_ SV *sv, const GV *gv, const char *prefix);
79PERL_CALLCONV void Perl_gv_efullname3(pTHX_ SV *sv, const GV *gv, const char *prefix);
80PERL_CALLCONV GV * Perl_gv_fetchmethod(pTHX_ HV *stash, const char *name);
81PERL_CALLCONV HE * Perl_hv_iternext(pTHX_ HV *hv);
82PERL_CALLCONV void Perl_hv_magic(pTHX_ HV *hv, GV *gv, int how);
5aaab254
KW
83PERL_CALLCONV bool Perl_do_open(pTHX_ GV *gv, const char *name, I32 len, int as_raw, int rawmode, int rawperm, PerlIO *supplied_fp);
84PERL_CALLCONV bool Perl_do_aexec(pTHX_ SV *really, SV **mark, SV **sp);
a0c21aa1
JH
85PERL_CALLCONV U8 * Perl_uvuni_to_utf8(pTHX_ U8 *d, UV uv);
86PERL_CALLCONV bool Perl_is_utf8_string_loc(pTHX_ const U8 *s, STRLEN len, const U8 **ep);
87PERL_CALLCONV void Perl_sv_nolocking(pTHX_ SV *sv);
88PERL_CALLCONV void Perl_sv_usepvn_mg(pTHX_ SV *sv, char *ptr, STRLEN len);
89PERL_CALLCONV void Perl_sv_usepvn(pTHX_ SV *sv, char *ptr, STRLEN len);
90PERL_CALLCONV int Perl_fprintf_nocontext(PerlIO *stream, const char *format, ...);
91PERL_CALLCONV int Perl_printf_nocontext(const char *format, ...);
56d7a086 92PERL_CALLCONV int Perl_magic_setglob(pTHX_ SV* sv, MAGIC* mg);
ac572bf4 93PERL_CALLCONV AV * Perl_newAV(pTHX);
78ac7dd9 94PERL_CALLCONV HV * Perl_newHV(pTHX);
85dca89a 95PERL_CALLCONV IO * Perl_newIO(pTHX);
0d7d409d
DM
96PERL_CALLCONV I32 Perl_my_stat(pTHX);
97PERL_CALLCONV I32 Perl_my_lstat(pTHX);
5aaab254 98PERL_CALLCONV I32 Perl_sv_eq(pTHX_ SV *sv1, SV *sv2);
078504b2 99PERL_CALLCONV char * Perl_sv_collxfrm(pTHX_ SV *const sv, STRLEN *const nxp);
5aaab254 100PERL_CALLCONV bool Perl_sv_2bool(pTHX_ SV *const sv);
7bff8c33 101PERL_CALLCONV CV * Perl_newSUB(pTHX_ I32 floor, OP* o, OP* proto, OP* block);
0c9b0438
KW
102PERL_CALLCONV UV Perl_to_utf8_lower(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp);
103PERL_CALLCONV UV Perl_to_utf8_title(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp);
104PERL_CALLCONV UV Perl_to_utf8_upper(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp);
105PERL_CALLCONV UV Perl_to_utf8_fold(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp);
108cb980 106PERL_CALLCONV SV *Perl_sv_mortalcopy(pTHX_ SV *const oldstr);
b5445a23 107
7ee2227d
SP
108/* ref() is now a macro using Perl_doref;
109 * this version provided for binary compatibility only.
110 */
111OP *
112Perl_ref(pTHX_ OP *o, I32 type)
113{
114 return doref(o, type, TRUE);
115}
116
aae9cea0 117/*
174c73e3
NC
118=for apidoc sv_unref
119
120Unsets the RV status of the SV, and decrements the reference count of
121whatever was being referenced by the RV. This can almost be thought of
122as a reversal of C<newSVrv>. This is C<sv_unref_flags> with the C<flag>
123being zero. See C<SvROK_off>.
124
125=cut
126*/
127
128void
129Perl_sv_unref(pTHX_ SV *sv)
130{
7918f24d
NC
131 PERL_ARGS_ASSERT_SV_UNREF;
132
174c73e3
NC
133 sv_unref_flags(sv, 0);
134}
135
136/*
aae9cea0
NC
137=for apidoc sv_taint
138
72d33970 139Taint an SV. Use C<SvTAINTED_on> instead.
dff47061 140
aae9cea0
NC
141=cut
142*/
143
144void
145Perl_sv_taint(pTHX_ SV *sv)
146{
7918f24d
NC
147 PERL_ARGS_ASSERT_SV_TAINT;
148
a0714e2c 149 sv_magic((sv), NULL, PERL_MAGIC_taint, NULL, 0);
aae9cea0
NC
150}
151
7ee2227d
SP
152/* sv_2iv() is now a macro using Perl_sv_2iv_flags();
153 * this function provided for binary compatibility only
154 */
155
156IV
5aaab254 157Perl_sv_2iv(pTHX_ SV *sv)
7ee2227d 158{
1061065f
DD
159 PERL_ARGS_ASSERT_SV_2IV;
160
7ee2227d
SP
161 return sv_2iv_flags(sv, SV_GMAGIC);
162}
163
164/* sv_2uv() is now a macro using Perl_sv_2uv_flags();
165 * this function provided for binary compatibility only
166 */
167
168UV
5aaab254 169Perl_sv_2uv(pTHX_ SV *sv)
7ee2227d 170{
1061065f
DD
171 PERL_ARGS_ASSERT_SV_2UV;
172
7ee2227d
SP
173 return sv_2uv_flags(sv, SV_GMAGIC);
174}
175
39d5de13
DM
176/* sv_2nv() is now a macro using Perl_sv_2nv_flags();
177 * this function provided for binary compatibility only
178 */
179
180NV
5aaab254 181Perl_sv_2nv(pTHX_ SV *sv)
39d5de13
DM
182{
183 return sv_2nv_flags(sv, SV_GMAGIC);
184}
185
186
7ee2227d
SP
187/* sv_2pv() is now a macro using Perl_sv_2pv_flags();
188 * this function provided for binary compatibility only
189 */
190
191char *
5aaab254 192Perl_sv_2pv(pTHX_ SV *sv, STRLEN *lp)
7ee2227d 193{
1061065f
DD
194 PERL_ARGS_ASSERT_SV_2PV;
195
7ee2227d
SP
196 return sv_2pv_flags(sv, lp, SV_GMAGIC);
197}
198
5abc721d 199/*
cb2f1b7b
NC
200=for apidoc sv_2pv_nolen
201
72d33970 202Like C<sv_2pv()>, but doesn't return the length too. You should usually
cb2f1b7b 203use the macro wrapper C<SvPV_nolen(sv)> instead.
dff47061 204
cb2f1b7b
NC
205=cut
206*/
207
208char *
5aaab254 209Perl_sv_2pv_nolen(pTHX_ SV *sv)
cb2f1b7b 210{
c85ae797 211 PERL_ARGS_ASSERT_SV_2PV_NOLEN;
b5445a23 212 return sv_2pv(sv, NULL);
cb2f1b7b
NC
213}
214
215/*
216=for apidoc sv_2pvbyte_nolen
217
218Return a pointer to the byte-encoded representation of the SV.
219May cause the SV to be downgraded from UTF-8 as a side-effect.
220
221Usually accessed via the C<SvPVbyte_nolen> macro.
222
223=cut
224*/
225
226char *
5aaab254 227Perl_sv_2pvbyte_nolen(pTHX_ SV *sv)
cb2f1b7b 228{
7918f24d
NC
229 PERL_ARGS_ASSERT_SV_2PVBYTE_NOLEN;
230
b5445a23 231 return sv_2pvbyte(sv, NULL);
cb2f1b7b
NC
232}
233
234/*
235=for apidoc sv_2pvutf8_nolen
236
237Return a pointer to the UTF-8-encoded representation of the SV.
238May cause the SV to be upgraded to UTF-8 as a side-effect.
239
240Usually accessed via the C<SvPVutf8_nolen> macro.
241
242=cut
243*/
244
245char *
5aaab254 246Perl_sv_2pvutf8_nolen(pTHX_ SV *sv)
cb2f1b7b 247{
7918f24d
NC
248 PERL_ARGS_ASSERT_SV_2PVUTF8_NOLEN;
249
b5445a23 250 return sv_2pvutf8(sv, NULL);
cb2f1b7b
NC
251}
252
253/*
5abc721d
NC
254=for apidoc sv_force_normal
255
256Undo various types of fakery on an SV: if the PV is a shared string, make
257a private copy; if we're a ref, stop refing; if we're a glob, downgrade to
72d33970 258an xpvmg. See also C<sv_force_normal_flags>.
5abc721d
NC
259
260=cut
261*/
262
263void
5aaab254 264Perl_sv_force_normal(pTHX_ SV *sv)
5abc721d 265{
7918f24d
NC
266 PERL_ARGS_ASSERT_SV_FORCE_NORMAL;
267
5abc721d
NC
268 sv_force_normal_flags(sv, 0);
269}
7ee2227d
SP
270
271/* sv_setsv() is now a macro using Perl_sv_setsv_flags();
272 * this function provided for binary compatibility only
273 */
274
275void
5aaab254 276Perl_sv_setsv(pTHX_ SV *dstr, SV *sstr)
7ee2227d 277{
7918f24d
NC
278 PERL_ARGS_ASSERT_SV_SETSV;
279
7ee2227d
SP
280 sv_setsv_flags(dstr, sstr, SV_GMAGIC);
281}
282
283/* sv_catpvn() is now a macro using Perl_sv_catpvn_flags();
284 * this function provided for binary compatibility only
285 */
286
287void
288Perl_sv_catpvn(pTHX_ SV *dsv, const char* sstr, STRLEN slen)
289{
7918f24d
NC
290 PERL_ARGS_ASSERT_SV_CATPVN;
291
7ee2227d
SP
292 sv_catpvn_flags(dsv, sstr, slen, SV_GMAGIC);
293}
294
b347df82
NC
295/*
296=for apidoc sv_catpvn_mg
297
298Like C<sv_catpvn>, but also handles 'set' magic.
299
300=cut
301*/
302
303void
5aaab254 304Perl_sv_catpvn_mg(pTHX_ SV *sv, const char *ptr, STRLEN len)
b347df82 305{
7918f24d
NC
306 PERL_ARGS_ASSERT_SV_CATPVN_MG;
307
b347df82
NC
308 sv_catpvn_flags(sv,ptr,len,SV_GMAGIC|SV_SMAGIC);
309}
310
7ee2227d
SP
311/* sv_catsv() is now a macro using Perl_sv_catsv_flags();
312 * this function provided for binary compatibility only
313 */
314
315void
5aaab254 316Perl_sv_catsv(pTHX_ SV *dstr, SV *sstr)
7ee2227d 317{
7918f24d
NC
318 PERL_ARGS_ASSERT_SV_CATSV;
319
7ee2227d
SP
320 sv_catsv_flags(dstr, sstr, SV_GMAGIC);
321}
322
0feed65a 323/*
b347df82
NC
324=for apidoc sv_catsv_mg
325
326Like C<sv_catsv>, but also handles 'set' magic.
327
328=cut
329*/
330
331void
5aaab254 332Perl_sv_catsv_mg(pTHX_ SV *dsv, SV *ssv)
b347df82 333{
7918f24d
NC
334 PERL_ARGS_ASSERT_SV_CATSV_MG;
335
b347df82
NC
336 sv_catsv_flags(dsv,ssv,SV_GMAGIC|SV_SMAGIC);
337}
338
339/*
0feed65a
NC
340=for apidoc sv_iv
341
342A private implementation of the C<SvIVx> macro for compilers which can't
72d33970 343cope with complex macro expressions. Always use the macro instead.
0feed65a
NC
344
345=cut
346*/
347
348IV
5aaab254 349Perl_sv_iv(pTHX_ SV *sv)
0feed65a 350{
7918f24d
NC
351 PERL_ARGS_ASSERT_SV_IV;
352
0feed65a
NC
353 if (SvIOK(sv)) {
354 if (SvIsUV(sv))
355 return (IV)SvUVX(sv);
356 return SvIVX(sv);
357 }
358 return sv_2iv(sv);
359}
360
361/*
362=for apidoc sv_uv
363
364A private implementation of the C<SvUVx> macro for compilers which can't
72d33970 365cope with complex macro expressions. Always use the macro instead.
0feed65a
NC
366
367=cut
368*/
369
370UV
5aaab254 371Perl_sv_uv(pTHX_ SV *sv)
0feed65a 372{
7918f24d
NC
373 PERL_ARGS_ASSERT_SV_UV;
374
0feed65a
NC
375 if (SvIOK(sv)) {
376 if (SvIsUV(sv))
377 return SvUVX(sv);
378 return (UV)SvIVX(sv);
379 }
380 return sv_2uv(sv);
381}
382
383/*
384=for apidoc sv_nv
385
386A private implementation of the C<SvNVx> macro for compilers which can't
72d33970 387cope with complex macro expressions. Always use the macro instead.
0feed65a
NC
388
389=cut
390*/
391
392NV
5aaab254 393Perl_sv_nv(pTHX_ SV *sv)
0feed65a 394{
7918f24d
NC
395 PERL_ARGS_ASSERT_SV_NV;
396
0feed65a
NC
397 if (SvNOK(sv))
398 return SvNVX(sv);
399 return sv_2nv(sv);
400}
401
402/*
403=for apidoc sv_pv
404
405Use the C<SvPV_nolen> macro instead
406
407=for apidoc sv_pvn
408
409A private implementation of the C<SvPV> macro for compilers which can't
72d33970 410cope with complex macro expressions. Always use the macro instead.
0feed65a
NC
411
412=cut
413*/
414
415char *
416Perl_sv_pvn(pTHX_ SV *sv, STRLEN *lp)
417{
7918f24d
NC
418 PERL_ARGS_ASSERT_SV_PVN;
419
0feed65a
NC
420 if (SvPOK(sv)) {
421 *lp = SvCUR(sv);
422 return SvPVX(sv);
423 }
424 return sv_2pv(sv, lp);
425}
426
427
428char *
5aaab254 429Perl_sv_pvn_nomg(pTHX_ SV *sv, STRLEN *lp)
0feed65a 430{
7918f24d
NC
431 PERL_ARGS_ASSERT_SV_PVN_NOMG;
432
0feed65a
NC
433 if (SvPOK(sv)) {
434 *lp = SvCUR(sv);
435 return SvPVX(sv);
436 }
437 return sv_2pv_flags(sv, lp, 0);
438}
439
7ee2227d
SP
440/* sv_pv() is now a macro using SvPV_nolen();
441 * this function provided for binary compatibility only
442 */
443
444char *
445Perl_sv_pv(pTHX_ SV *sv)
446{
7918f24d
NC
447 PERL_ARGS_ASSERT_SV_PV;
448
7ee2227d
SP
449 if (SvPOK(sv))
450 return SvPVX(sv);
451
b5445a23 452 return sv_2pv(sv, NULL);
7ee2227d
SP
453}
454
455/* sv_pvn_force() is now a macro using Perl_sv_pvn_force_flags();
456 * this function provided for binary compatibility only
457 */
458
459char *
460Perl_sv_pvn_force(pTHX_ SV *sv, STRLEN *lp)
461{
7918f24d
NC
462 PERL_ARGS_ASSERT_SV_PVN_FORCE;
463
7ee2227d
SP
464 return sv_pvn_force_flags(sv, lp, SV_GMAGIC);
465}
466
467/* sv_pvbyte () is now a macro using Perl_sv_2pv_flags();
468 * this function provided for binary compatibility only
469 */
470
471char *
472Perl_sv_pvbyte(pTHX_ SV *sv)
473{
7918f24d
NC
474 PERL_ARGS_ASSERT_SV_PVBYTE;
475
b5445a23 476 sv_utf8_downgrade(sv, FALSE);
7ee2227d
SP
477 return sv_pv(sv);
478}
479
0feed65a
NC
480/*
481=for apidoc sv_pvbyte
482
483Use C<SvPVbyte_nolen> instead.
484
485=for apidoc sv_pvbyten
486
487A private implementation of the C<SvPVbyte> macro for compilers
72d33970 488which can't cope with complex macro expressions. Always use the macro
0feed65a
NC
489instead.
490
491=cut
492*/
493
494char *
495Perl_sv_pvbyten(pTHX_ SV *sv, STRLEN *lp)
496{
7918f24d
NC
497 PERL_ARGS_ASSERT_SV_PVBYTEN;
498
b5445a23 499 sv_utf8_downgrade(sv, FALSE);
0feed65a
NC
500 return sv_pvn(sv,lp);
501}
502
7ee2227d
SP
503/* sv_pvutf8 () is now a macro using Perl_sv_2pv_flags();
504 * this function provided for binary compatibility only
505 */
506
507char *
508Perl_sv_pvutf8(pTHX_ SV *sv)
509{
7918f24d
NC
510 PERL_ARGS_ASSERT_SV_PVUTF8;
511
7ee2227d
SP
512 sv_utf8_upgrade(sv);
513 return sv_pv(sv);
514}
515
0feed65a
NC
516/*
517=for apidoc sv_pvutf8
518
519Use the C<SvPVutf8_nolen> macro instead
520
521=for apidoc sv_pvutf8n
522
523A private implementation of the C<SvPVutf8> macro for compilers
72d33970 524which can't cope with complex macro expressions. Always use the macro
0feed65a
NC
525instead.
526
527=cut
528*/
529
530char *
531Perl_sv_pvutf8n(pTHX_ SV *sv, STRLEN *lp)
532{
7918f24d
NC
533 PERL_ARGS_ASSERT_SV_PVUTF8N;
534
0feed65a
NC
535 sv_utf8_upgrade(sv);
536 return sv_pvn(sv,lp);
537}
538
205c02c2
NC
539/* sv_utf8_upgrade() is now a macro using sv_utf8_upgrade_flags();
540 * this function provided for binary compatibility only
541 */
542
543STRLEN
5aaab254 544Perl_sv_utf8_upgrade(pTHX_ SV *sv)
205c02c2 545{
7918f24d
NC
546 PERL_ARGS_ASSERT_SV_UTF8_UPGRADE;
547
205c02c2
NC
548 return sv_utf8_upgrade_flags(sv, SV_GMAGIC);
549}
550
7ee2227d
SP
551int
552Perl_fprintf_nocontext(PerlIO *stream, const char *format, ...)
553{
554 dTHXs;
3ed3a8af 555 int ret = 0;
7ee2227d 556 va_list(arglist);
7918f24d
NC
557
558 /* Easier to special case this here than in embed.pl. (Look at what it
559 generates for proto.h) */
560#ifdef PERL_IMPLICIT_CONTEXT
561 PERL_ARGS_ASSERT_FPRINTF_NOCONTEXT;
562#endif
563
7ee2227d 564 va_start(arglist, format);
3ed3a8af
JH
565 ret = PerlIO_vprintf(stream, format, arglist);
566 va_end(arglist);
567 return ret;
7ee2227d
SP
568}
569
570int
571Perl_printf_nocontext(const char *format, ...)
572{
573 dTHX;
574 va_list(arglist);
3ed3a8af 575 int ret = 0;
7918f24d
NC
576
577#ifdef PERL_IMPLICIT_CONTEXT
578 PERL_ARGS_ASSERT_PRINTF_NOCONTEXT;
579#endif
580
7ee2227d 581 va_start(arglist, format);
3ed3a8af
JH
582 ret = PerlIO_vprintf(PerlIO_stdout(), format, arglist);
583 va_end(arglist);
584 return ret;
7ee2227d
SP
585}
586
587#if defined(HUGE_VAL) || (defined(USE_LONG_DOUBLE) && defined(HUGE_VALL))
588/*
589 * This hack is to force load of "huge" support from libm.a
590 * So it is in perl for (say) POSIX to use.
591 * Needed for SunOS with Sun's 'acc' for example.
592 */
593NV
594Perl_huge(void)
595{
c773ee7a 596# if defined(USE_LONG_DOUBLE) && defined(HUGE_VALL)
7ee2227d 597 return HUGE_VALL;
c773ee7a 598# else
7ee2227d 599 return HUGE_VAL;
c773ee7a 600# endif
7ee2227d
SP
601}
602#endif
603
f2f0f092
NC
604/* compatibility with versions <= 5.003. */
605void
606Perl_gv_fullname(pTHX_ SV *sv, const GV *gv)
607{
7918f24d
NC
608 PERL_ARGS_ASSERT_GV_FULLNAME;
609
666ea192 610 gv_fullname3(sv, gv, sv == (const SV*)gv ? "*" : "");
f2f0f092
NC
611}
612
613/* compatibility with versions <= 5.003. */
614void
615Perl_gv_efullname(pTHX_ SV *sv, const GV *gv)
616{
7918f24d
NC
617 PERL_ARGS_ASSERT_GV_EFULLNAME;
618
666ea192 619 gv_efullname3(sv, gv, sv == (const SV*)gv ? "*" : "");
f2f0f092
NC
620}
621
2674aeec
NC
622void
623Perl_gv_fullname3(pTHX_ SV *sv, const GV *gv, const char *prefix)
624{
7918f24d
NC
625 PERL_ARGS_ASSERT_GV_FULLNAME3;
626
2674aeec
NC
627 gv_fullname4(sv, gv, prefix, TRUE);
628}
629
630void
631Perl_gv_efullname3(pTHX_ SV *sv, const GV *gv, const char *prefix)
632{
7918f24d
NC
633 PERL_ARGS_ASSERT_GV_EFULLNAME3;
634
2674aeec
NC
635 gv_efullname4(sv, gv, prefix, TRUE);
636}
637
887986eb
NC
638/*
639=for apidoc gv_fetchmethod
640
ca8b95d7 641See L</gv_fetchmethod_autoload>.
887986eb
NC
642
643=cut
644*/
645
646GV *
647Perl_gv_fetchmethod(pTHX_ HV *stash, const char *name)
648{
7918f24d
NC
649 PERL_ARGS_ASSERT_GV_FETCHMETHOD;
650
887986eb
NC
651 return gv_fetchmethod_autoload(stash, name, TRUE);
652}
653
7a7b9979
NC
654HE *
655Perl_hv_iternext(pTHX_ HV *hv)
656{
7918f24d
NC
657 PERL_ARGS_ASSERT_HV_ITERNEXT;
658
7a7b9979
NC
659 return hv_iternext_flags(hv, 0);
660}
661
bc5cdc23
NC
662void
663Perl_hv_magic(pTHX_ HV *hv, GV *gv, int how)
664{
7918f24d
NC
665 PERL_ARGS_ASSERT_HV_MAGIC;
666
ad64d0ec 667 sv_magic(MUTABLE_SV(hv), MUTABLE_SV(gv), how, NULL, 0);
bc5cdc23
NC
668}
669
34d367cd 670bool
5aaab254 671Perl_do_open(pTHX_ GV *gv, const char *name, I32 len, int as_raw,
e4dba786
NC
672 int rawmode, int rawperm, PerlIO *supplied_fp)
673{
7918f24d
NC
674 PERL_ARGS_ASSERT_DO_OPEN;
675
e4dba786
NC
676 return do_openn(gv, name, len, as_raw, rawmode, rawperm,
677 supplied_fp, (SV **) NULL, 0);
678}
679
680bool
5aaab254 681Perl_do_open9(pTHX_ GV *gv, const char *name, I32 len, int
34d367cd
SP
682as_raw,
683 int rawmode, int rawperm, PerlIO *supplied_fp, SV *svs,
684 I32 num_svs)
685{
7918f24d
NC
686 PERL_ARGS_ASSERT_DO_OPEN9;
687
34d367cd
SP
688 PERL_UNUSED_ARG(num_svs);
689 return do_openn(gv, name, len, as_raw, rawmode, rawperm,
690 supplied_fp, &svs, 1);
691}
692
693int
694Perl_do_binmode(pTHX_ PerlIO *fp, int iotype, int mode)
695{
696 /* The old body of this is now in non-LAYER part of perlio.c
697 * This is a stub for any XS code which might have been calling it.
698 */
699 const char *name = ":raw";
7918f24d
NC
700
701 PERL_ARGS_ASSERT_DO_BINMODE;
702
34d367cd
SP
703#ifdef PERLIO_USING_CRLF
704 if (!(mode & O_BINARY))
705 name = ":crlf";
706#endif
707 return PerlIO_binmode(aTHX_ fp, iotype, mode, name);
708}
709
a9f96b3f
NC
710#ifndef OS2
711bool
5aaab254 712Perl_do_aexec(pTHX_ SV *really, SV **mark, SV **sp)
a9f96b3f 713{
7918f24d
NC
714 PERL_ARGS_ASSERT_DO_AEXEC;
715
a9f96b3f
NC
716 return do_aexec5(really, mark, sp, 0, 0);
717}
718#endif
719
89552e80
NC
720/* Backwards compatibility. */
721int
722Perl_init_i18nl14n(pTHX_ int printwarn)
723{
724 return init_i18nl10n(printwarn);
725}
726
814fafa7
NC
727bool
728Perl_is_utf8_string_loc(pTHX_ const U8 *s, STRLEN len, const U8 **ep)
729{
7918f24d
NC
730 PERL_ARGS_ASSERT_IS_UTF8_STRING_LOC;
731
814fafa7
NC
732 return is_utf8_string_loclen(s, len, ep, 0);
733}
734
7ee2227d 735/*
d5b2b27b
NC
736=for apidoc sv_nolocking
737
738Dummy routine which "locks" an SV when there is no locking module present.
739Exists to avoid test for a NULL function pointer and because it could
740potentially warn under some level of strict-ness.
741
742"Superseded" by sv_nosharing().
743
744=cut
745*/
746
747void
748Perl_sv_nolocking(pTHX_ SV *sv)
749{
96a5add6 750 PERL_UNUSED_CONTEXT;
d5b2b27b
NC
751 PERL_UNUSED_ARG(sv);
752}
753
754
755/*
756=for apidoc sv_nounlocking
757
758Dummy routine which "unlocks" an SV when there is no locking module present.
759Exists to avoid test for a NULL function pointer and because it could
760potentially warn under some level of strict-ness.
761
762"Superseded" by sv_nosharing().
763
764=cut
765*/
766
767void
768Perl_sv_nounlocking(pTHX_ SV *sv)
769{
96a5add6 770 PERL_UNUSED_CONTEXT;
d5b2b27b
NC
771 PERL_UNUSED_ARG(sv);
772}
773
2053acbf
NC
774void
775Perl_save_long(pTHX_ long int *longp)
776{
777 dVAR;
7918f24d
NC
778
779 PERL_ARGS_ASSERT_SAVE_LONG;
780
2053acbf
NC
781 SSCHECK(3);
782 SSPUSHLONG(*longp);
783 SSPUSHPTR(longp);
c6bf6a65 784 SSPUSHUV(SAVEt_LONG);
2053acbf
NC
785}
786
787void
2053acbf
NC
788Perl_save_iv(pTHX_ IV *ivp)
789{
790 dVAR;
7918f24d
NC
791
792 PERL_ARGS_ASSERT_SAVE_IV;
793
2053acbf
NC
794 SSCHECK(3);
795 SSPUSHIV(*ivp);
796 SSPUSHPTR(ivp);
c6bf6a65 797 SSPUSHUV(SAVEt_IV);
2053acbf
NC
798}
799
800void
801Perl_save_nogv(pTHX_ GV *gv)
802{
803 dVAR;
7918f24d
NC
804
805 PERL_ARGS_ASSERT_SAVE_NOGV;
806
2053acbf
NC
807 SSCHECK(2);
808 SSPUSHPTR(gv);
c6bf6a65 809 SSPUSHUV(SAVEt_NSTAB);
2053acbf
NC
810}
811
812void
5aaab254 813Perl_save_list(pTHX_ SV **sarg, I32 maxsarg)
2053acbf
NC
814{
815 dVAR;
eb578fdb 816 I32 i;
2053acbf 817
7918f24d
NC
818 PERL_ARGS_ASSERT_SAVE_LIST;
819
2053acbf 820 for (i = 1; i <= maxsarg; i++) {
3ed356df
FC
821 SV *sv;
822 SvGETMAGIC(sarg[i]);
823 sv = newSV(0);
824 sv_setsv_nomg(sv,sarg[i]);
2053acbf
NC
825 SSCHECK(3);
826 SSPUSHPTR(sarg[i]); /* remember the pointer */
827 SSPUSHPTR(sv); /* remember the value */
c6bf6a65 828 SSPUSHUV(SAVEt_ITEM);
2053acbf
NC
829 }
830}
831
47518d95
NC
832/*
833=for apidoc sv_usepvn_mg
834
835Like C<sv_usepvn>, but also handles 'set' magic.
836
837=cut
838*/
839
840void
841Perl_sv_usepvn_mg(pTHX_ SV *sv, char *ptr, STRLEN len)
842{
7918f24d
NC
843 PERL_ARGS_ASSERT_SV_USEPVN_MG;
844
47518d95
NC
845 sv_usepvn_flags(sv,ptr,len, SV_SMAGIC);
846}
847
848/*
849=for apidoc sv_usepvn
850
72d33970 851Tells an SV to use C<ptr> to find its string value. Implemented by
47518d95 852calling C<sv_usepvn_flags> with C<flags> of 0, hence does not handle 'set'
72d33970 853magic. See C<sv_usepvn_flags>.
47518d95
NC
854
855=cut
856*/
857
858void
859Perl_sv_usepvn(pTHX_ SV *sv, char *ptr, STRLEN len)
860{
7918f24d
NC
861 PERL_ARGS_ASSERT_SV_USEPVN;
862
47518d95
NC
863 sv_usepvn_flags(sv,ptr,len, 0);
864}
865
c03e83bf
NC
866/*
867=for apidoc unpack_str
868
72d33970
FC
869The engine implementing unpack() Perl function. Note: parameters strbeg,
870new_s and ocnt are not used. This call should not be used, use
871unpackstring instead.
c03e83bf
NC
872
873=cut */
874
875I32
876Perl_unpack_str(pTHX_ const char *pat, const char *patend, const char *s,
877 const char *strbeg, const char *strend, char **new_s, I32 ocnt,
878 U32 flags)
879{
7918f24d
NC
880 PERL_ARGS_ASSERT_UNPACK_STR;
881
c03e83bf
NC
882 PERL_UNUSED_ARG(strbeg);
883 PERL_UNUSED_ARG(new_s);
884 PERL_UNUSED_ARG(ocnt);
885
886 return unpackstring(pat, patend, s, strend, flags);
887}
b47163a2
NC
888
889/*
890=for apidoc pack_cat
891
72d33970
FC
892The engine implementing pack() Perl function. Note: parameters
893next_in_list and flags are not used. This call should not be used; use
894packlist instead.
b47163a2
NC
895
896=cut
897*/
898
899void
5aaab254 900Perl_pack_cat(pTHX_ SV *cat, const char *pat, const char *patend, SV **beglist, SV **endlist, SV ***next_in_list, U32 flags)
b47163a2 901{
7918f24d
NC
902 PERL_ARGS_ASSERT_PACK_CAT;
903
b47163a2
NC
904 PERL_UNUSED_ARG(next_in_list);
905 PERL_UNUSED_ARG(flags);
906
907 packlist(cat, pat, patend, beglist, endlist);
908}
4c2df08c
NC
909
910HE *
911Perl_hv_store_ent(pTHX_ HV *hv, SV *keysv, SV *val, U32 hash)
912{
59af68cc 913 return (HE *)hv_common(hv, keysv, NULL, 0, 0, HV_FETCH_ISSTORE, val, hash);
4c2df08c
NC
914}
915
916bool
917Perl_hv_exists_ent(pTHX_ HV *hv, SV *keysv, U32 hash)
918{
7918f24d
NC
919 PERL_ARGS_ASSERT_HV_EXISTS_ENT;
920
4c2df08c
NC
921 return hv_common(hv, keysv, NULL, 0, 0, HV_FETCH_ISEXISTS, 0, hash)
922 ? TRUE : FALSE;
923}
924
925HE *
926Perl_hv_fetch_ent(pTHX_ HV *hv, SV *keysv, I32 lval, U32 hash)
927{
7918f24d
NC
928 PERL_ARGS_ASSERT_HV_FETCH_ENT;
929
59af68cc 930 return (HE *)hv_common(hv, keysv, NULL, 0, 0,
4c2df08c
NC
931 (lval ? HV_FETCH_LVALUE : 0), NULL, hash);
932}
933
934SV *
935Perl_hv_delete_ent(pTHX_ HV *hv, SV *keysv, I32 flags, U32 hash)
936{
7918f24d
NC
937 PERL_ARGS_ASSERT_HV_DELETE_ENT;
938
ad64d0ec
NC
939 return MUTABLE_SV(hv_common(hv, keysv, NULL, 0, 0, flags | HV_DELETE, NULL,
940 hash));
4c2df08c
NC
941}
942
a038e571
NC
943SV**
944Perl_hv_store_flags(pTHX_ HV *hv, const char *key, I32 klen, SV *val, U32 hash,
945 int flags)
946{
947 return (SV**) hv_common(hv, NULL, key, klen, flags,
948 (HV_FETCH_ISSTORE|HV_FETCH_JUST_SV), val, hash);
949}
950
951SV**
952Perl_hv_store(pTHX_ HV *hv, const char *key, I32 klen_i32, SV *val, U32 hash)
953{
954 STRLEN klen;
955 int flags;
956
957 if (klen_i32 < 0) {
958 klen = -klen_i32;
959 flags = HVhek_UTF8;
960 } else {
961 klen = klen_i32;
962 flags = 0;
963 }
964 return (SV **) hv_common(hv, NULL, key, klen, flags,
965 (HV_FETCH_ISSTORE|HV_FETCH_JUST_SV), val, hash);
966}
967
968bool
969Perl_hv_exists(pTHX_ HV *hv, const char *key, I32 klen_i32)
970{
971 STRLEN klen;
972 int flags;
973
7918f24d
NC
974 PERL_ARGS_ASSERT_HV_EXISTS;
975
a038e571
NC
976 if (klen_i32 < 0) {
977 klen = -klen_i32;
978 flags = HVhek_UTF8;
979 } else {
980 klen = klen_i32;
981 flags = 0;
982 }
983 return hv_common(hv, NULL, key, klen, flags, HV_FETCH_ISEXISTS, 0, 0)
984 ? TRUE : FALSE;
985}
986
987SV**
988Perl_hv_fetch(pTHX_ HV *hv, const char *key, I32 klen_i32, I32 lval)
989{
990 STRLEN klen;
991 int flags;
992
7918f24d
NC
993 PERL_ARGS_ASSERT_HV_FETCH;
994
a038e571
NC
995 if (klen_i32 < 0) {
996 klen = -klen_i32;
997 flags = HVhek_UTF8;
998 } else {
999 klen = klen_i32;
1000 flags = 0;
1001 }
1002 return (SV **) hv_common(hv, NULL, key, klen, flags,
1003 lval ? (HV_FETCH_JUST_SV | HV_FETCH_LVALUE)
1004 : HV_FETCH_JUST_SV, NULL, 0);
1005}
1006
1007SV *
1008Perl_hv_delete(pTHX_ HV *hv, const char *key, I32 klen_i32, I32 flags)
1009{
1010 STRLEN klen;
1011 int k_flags;
1012
7918f24d
NC
1013 PERL_ARGS_ASSERT_HV_DELETE;
1014
a038e571
NC
1015 if (klen_i32 < 0) {
1016 klen = -klen_i32;
1017 k_flags = HVhek_UTF8;
1018 } else {
1019 klen = klen_i32;
1020 k_flags = 0;
1021 }
ad64d0ec
NC
1022 return MUTABLE_SV(hv_common(hv, NULL, key, klen, k_flags, flags | HV_DELETE,
1023 NULL, 0));
a038e571
NC
1024}
1025
56d7a086 1026/* Functions after here were made mathoms post 5.10.0 but pre 5.8.9 */
56d7a086 1027
ac572bf4
NC
1028AV *
1029Perl_newAV(pTHX)
1030{
502c6561 1031 return MUTABLE_AV(newSV_type(SVt_PVAV));
ac572bf4
NC
1032 /* sv_upgrade does AvREAL_only():
1033 AvALLOC(av) = 0;
1034 AvARRAY(av) = NULL;
1035 AvMAX(av) = AvFILLp(av) = -1; */
1036}
1037
78ac7dd9
NC
1038HV *
1039Perl_newHV(pTHX)
1040{
85fbaab2 1041 HV * const hv = MUTABLE_HV(newSV_type(SVt_PVHV));
78ac7dd9
NC
1042 assert(!SvOK(hv));
1043
1044 return hv;
1045}
1046
84335ee9
NC
1047void
1048Perl_sv_insert(pTHX_ SV *const bigstr, const STRLEN offset, const STRLEN len,
1049 const char *const little, const STRLEN littlelen)
1050{
1051 PERL_ARGS_ASSERT_SV_INSERT;
1052 sv_insert_flags(bigstr, offset, len, little, littlelen, SV_GMAGIC);
1053}
1054
2fd8beea
NC
1055void
1056Perl_save_freesv(pTHX_ SV *sv)
1057{
1058 dVAR;
1059 save_freesv(sv);
1060}
1061
1062void
1063Perl_save_mortalizesv(pTHX_ SV *sv)
1064{
1065 dVAR;
1066
1067 PERL_ARGS_ASSERT_SAVE_MORTALIZESV;
1068
1069 save_mortalizesv(sv);
1070}
1071
1072void
1073Perl_save_freeop(pTHX_ OP *o)
1074{
1075 dVAR;
1076 save_freeop(o);
1077}
1078
1079void
1080Perl_save_freepv(pTHX_ char *pv)
1081{
1082 dVAR;
1083 save_freepv(pv);
1084}
1085
1086void
1087Perl_save_op(pTHX)
1088{
1089 dVAR;
1090 save_op();
1091}
1092
d5713896
NC
1093#ifdef PERL_DONT_CREATE_GVSV
1094GV *
1095Perl_gv_SVadd(pTHX_ GV *gv)
1096{
d5713896
NC
1097 return gv_SVadd(gv);
1098}
1099#endif
1100
1101GV *
1102Perl_gv_AVadd(pTHX_ GV *gv)
1103{
d5713896
NC
1104 return gv_AVadd(gv);
1105}
1106
1107GV *
5aaab254 1108Perl_gv_HVadd(pTHX_ GV *gv)
d5713896 1109{
d5713896
NC
1110 return gv_HVadd(gv);
1111}
1112
bb85b28a 1113GV *
5aaab254 1114Perl_gv_IOadd(pTHX_ GV *gv)
bb85b28a
NC
1115{
1116 return gv_IOadd(gv);
1117}
1118
85dca89a
NC
1119IO *
1120Perl_newIO(pTHX)
1121{
1122 return MUTABLE_IO(newSV_type(SVt_PVIO));
1123}
1124
0d7d409d
DM
1125I32
1126Perl_my_stat(pTHX)
1127{
1128 return my_stat_flags(SV_GMAGIC);
1129}
1130
1131I32
1132Perl_my_lstat(pTHX)
1133{
1134 return my_lstat_flags(SV_GMAGIC);
1135}
1136
078504b2 1137I32
5aaab254 1138Perl_sv_eq(pTHX_ SV *sv1, SV *sv2)
078504b2
FC
1139{
1140 return sv_eq_flags(sv1, sv2, SV_GMAGIC);
1141}
1142
6129b56c 1143#ifdef USE_LOCALE_COLLATE
078504b2
FC
1144char *
1145Perl_sv_collxfrm(pTHX_ SV *const sv, STRLEN *const nxp)
1146{
1147 return sv_collxfrm_flags(sv, nxp, SV_GMAGIC);
1148}
6129b56c 1149#endif
078504b2 1150
06c841cf 1151bool
5aaab254 1152Perl_sv_2bool(pTHX_ SV *const sv)
06c841cf
FC
1153{
1154 return sv_2bool_flags(sv, SV_GMAGIC);
1155}
1156
1830b3d9 1157
9733086d
BM
1158/*
1159=for apidoc custom_op_name
72d33970 1160Return the name for a given custom op. This was once used by the OP_NAME
9733086d
BM
1161macro, but is no longer: it has only been kept for compatibility, and
1162should not be used.
1163
1164=for apidoc custom_op_desc
72d33970 1165Return the description of a given custom op. This was once used by the
9733086d
BM
1166OP_DESC macro, but is no longer: it has only been kept for
1167compatibility, and should not be used.
1168
1169=cut
1170*/
1171
1830b3d9
BM
1172const char*
1173Perl_custom_op_name(pTHX_ const OP* o)
1174{
1175 PERL_ARGS_ASSERT_CUSTOM_OP_NAME;
ae103e09 1176 return XopENTRYCUSTOM(o, xop_name);
1830b3d9
BM
1177}
1178
1179const char*
1180Perl_custom_op_desc(pTHX_ const OP* o)
1181{
1182 PERL_ARGS_ASSERT_CUSTOM_OP_DESC;
ae103e09 1183 return XopENTRYCUSTOM(o, xop_desc);
1830b3d9 1184}
7bff8c33
NC
1185
1186CV *
1187Perl_newSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *block)
1188{
e8f91c91 1189 return newATTRSUB(floor, o, proto, NULL, block);
7bff8c33 1190}
0c9b0438
KW
1191
1192UV
1193Perl_to_utf8_fold(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp)
1194{
1195 PERL_ARGS_ASSERT_TO_UTF8_FOLD;
1196
445bf929 1197 return _to_utf8_fold_flags(p, ustrp, lenp, FOLD_FLAGS_FULL);
0c9b0438
KW
1198}
1199
1200UV
1201Perl_to_utf8_lower(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp)
1202{
1203 PERL_ARGS_ASSERT_TO_UTF8_LOWER;
1204
445bf929 1205 return _to_utf8_lower_flags(p, ustrp, lenp, FALSE);
0c9b0438
KW
1206}
1207
1208UV
1209Perl_to_utf8_title(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp)
1210{
1211 PERL_ARGS_ASSERT_TO_UTF8_TITLE;
1212
445bf929 1213 return _to_utf8_title_flags(p, ustrp, lenp, FALSE);
0c9b0438
KW
1214}
1215
1216UV
1217Perl_to_utf8_upper(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp)
1218{
1219 PERL_ARGS_ASSERT_TO_UTF8_UPPER;
1220
445bf929 1221 return _to_utf8_upper_flags(p, ustrp, lenp, FALSE);
0c9b0438
KW
1222}
1223
108cb980
FC
1224SV *
1225Perl_sv_mortalcopy(pTHX_ SV *const oldstr)
1226{
33971c01 1227 return Perl_sv_mortalcopy_flags(aTHX_ oldstr, SV_GMAGIC);
108cb980
FC
1228}
1229
3d81eea6
KW
1230UV /* Made into a function, so can be deprecated */
1231NATIVE_TO_NEED(const UV enc, const UV ch)
1232{
1233 PERL_UNUSED_ARG(enc);
1234 return ch;
1235}
1236
1237UV /* Made into a function, so can be deprecated */
1238ASCII_TO_NEED(const UV enc, const UV ch)
1239{
1240 PERL_UNUSED_ARG(enc);
1241 return ch;
1242}
1243
f2645549
KW
1244bool /* Made into a function, so can be deprecated */
1245Perl_isIDFIRST_lazy(pTHX_ const char* p)
1246{
1247 PERL_ARGS_ASSERT_ISIDFIRST_LAZY;
1248
1249 return isIDFIRST_lazy_if(p,1);
1250}
1251
1252bool /* Made into a function, so can be deprecated */
1253Perl_isALNUM_lazy(pTHX_ const char* p)
1254{
1255 PERL_ARGS_ASSERT_ISALNUM_LAZY;
1256
1257 return isALNUM_lazy_if(p,1);
1258}
1259
dc2e544e
KW
1260bool
1261Perl_is_uni_alnum(pTHX_ UV c)
1262{
1263 return isWORDCHAR_uni(c);
1264}
1265
1266bool
1267Perl_is_uni_alnumc(pTHX_ UV c)
1268{
1269 return isALNUM_uni(c);
1270}
1271
1272bool
1273Perl_is_uni_alpha(pTHX_ UV c)
1274{
1275 return isALPHA_uni(c);
1276}
1277
1278bool
1279Perl_is_uni_ascii(pTHX_ UV c)
1280{
1281 return isASCII_uni(c);
1282}
1283
1284bool
1285Perl_is_uni_blank(pTHX_ UV c)
1286{
1287 return isBLANK_uni(c);
1288}
1289
1290bool
1291Perl_is_uni_space(pTHX_ UV c)
1292{
1293 return isSPACE_uni(c);
1294}
1295
1296bool
1297Perl_is_uni_digit(pTHX_ UV c)
1298{
1299 return isDIGIT_uni(c);
1300}
1301
1302bool
1303Perl_is_uni_upper(pTHX_ UV c)
1304{
1305 return isUPPER_uni(c);
1306}
1307
1308bool
1309Perl_is_uni_lower(pTHX_ UV c)
1310{
1311 return isLOWER_uni(c);
1312}
1313
1314bool
1315Perl_is_uni_cntrl(pTHX_ UV c)
1316{
1317 return isCNTRL_L1(c);
1318}
1319
1320bool
1321Perl_is_uni_graph(pTHX_ UV c)
1322{
1323 return isGRAPH_uni(c);
1324}
1325
1326bool
1327Perl_is_uni_print(pTHX_ UV c)
1328{
1329 return isPRINT_uni(c);
1330}
1331
1332bool
1333Perl_is_uni_punct(pTHX_ UV c)
1334{
1335 return isPUNCT_uni(c);
1336}
1337
1338bool
1339Perl_is_uni_xdigit(pTHX_ UV c)
1340{
1341 return isXDIGIT_uni(c);
1342}
1343
1344bool
1345Perl_is_uni_alnum_lc(pTHX_ UV c)
1346{
1347 return isWORDCHAR_LC_uvchr(c);
1348}
1349
1350bool
1351Perl_is_uni_alnumc_lc(pTHX_ UV c)
1352{
1353 return isALPHANUMERIC_LC_uvchr(c);
1354}
1355
1356bool
1357Perl_is_uni_idfirst_lc(pTHX_ UV c)
1358{
1359 /* XXX Should probably be something that resolves to the old IDFIRST, but
1360 * this function is deprecated, so not bothering */
1361 return isIDFIRST_LC_uvchr(c);
1362}
1363
1364bool
1365Perl_is_uni_alpha_lc(pTHX_ UV c)
1366{
1367 return isALPHA_LC_uvchr(c);
1368}
1369
1370bool
1371Perl_is_uni_ascii_lc(pTHX_ UV c)
1372{
1373 return isASCII_LC_uvchr(c);
1374}
1375
1376bool
1377Perl_is_uni_blank_lc(pTHX_ UV c)
1378{
1379 return isBLANK_LC_uvchr(c);
1380}
1381
1382bool
1383Perl_is_uni_space_lc(pTHX_ UV c)
1384{
1385 return isSPACE_LC_uvchr(c);
1386}
1387
1388bool
1389Perl_is_uni_digit_lc(pTHX_ UV c)
1390{
1391 return isDIGIT_LC_uvchr(c);
1392}
1393
1394bool
f2645549
KW
1395Perl_is_uni_idfirst(pTHX_ UV c)
1396{
1397 U8 tmpbuf[UTF8_MAXBYTES+1];
1398 uvchr_to_utf8(tmpbuf, c);
1399 return _is_utf8_idstart(tmpbuf);
1400}
1401
1402bool
1403Perl_is_utf8_idfirst(pTHX_ const U8 *p) /* The naming is historical. */
1404{
1405 dVAR;
1406
1407 PERL_ARGS_ASSERT_IS_UTF8_IDFIRST;
1408
1409 return _is_utf8_idstart(p);
1410}
1411
1412bool
1413Perl_is_utf8_xidfirst(pTHX_ const U8 *p) /* The naming is historical. */
1414{
1415 dVAR;
1416
1417 PERL_ARGS_ASSERT_IS_UTF8_XIDFIRST;
1418
1419 return _is_utf8_xidstart(p);
1420}
1421
1422bool
1423Perl_is_utf8_idcont(pTHX_ const U8 *p)
1424{
1425 dVAR;
1426
1427 PERL_ARGS_ASSERT_IS_UTF8_IDCONT;
1428
1429 return _is_utf8_idcont(p);
1430}
1431
1432bool
1433Perl_is_utf8_xidcont(pTHX_ const U8 *p)
1434{
1435 dVAR;
1436
1437 PERL_ARGS_ASSERT_IS_UTF8_XIDCONT;
1438
1439 return _is_utf8_xidcont(p);
1440}
1441
1442bool
dc2e544e
KW
1443Perl_is_uni_upper_lc(pTHX_ UV c)
1444{
1445 return isUPPER_LC_uvchr(c);
1446}
1447
1448bool
1449Perl_is_uni_lower_lc(pTHX_ UV c)
1450{
1451 return isLOWER_LC_uvchr(c);
1452}
1453
1454bool
1455Perl_is_uni_cntrl_lc(pTHX_ UV c)
1456{
1457 return isCNTRL_LC_uvchr(c);
1458}
1459
1460bool
1461Perl_is_uni_graph_lc(pTHX_ UV c)
1462{
1463 return isGRAPH_LC_uvchr(c);
1464}
1465
1466bool
1467Perl_is_uni_print_lc(pTHX_ UV c)
1468{
1469 return isPRINT_LC_uvchr(c);
1470}
1471
1472bool
1473Perl_is_uni_punct_lc(pTHX_ UV c)
1474{
1475 return isPUNCT_LC_uvchr(c);
1476}
1477
1478bool
1479Perl_is_uni_xdigit_lc(pTHX_ UV c)
1480{
1481 return isXDIGIT_LC_uvchr(c);
1482}
1483
1484U32
1485Perl_to_uni_upper_lc(pTHX_ U32 c)
1486{
1487 /* XXX returns only the first character -- do not use XXX */
1488 /* XXX no locale support yet */
1489 STRLEN len;
1490 U8 tmpbuf[UTF8_MAXBYTES_CASE+1];
1491 return (U32)to_uni_upper(c, tmpbuf, &len);
1492}
1493
1494U32
1495Perl_to_uni_title_lc(pTHX_ U32 c)
1496{
1497 /* XXX returns only the first character XXX -- do not use XXX */
1498 /* XXX no locale support yet */
1499 STRLEN len;
1500 U8 tmpbuf[UTF8_MAXBYTES_CASE+1];
1501 return (U32)to_uni_title(c, tmpbuf, &len);
1502}
1503
1504U32
1505Perl_to_uni_lower_lc(pTHX_ U32 c)
1506{
1507 /* XXX returns only the first character -- do not use XXX */
1508 /* XXX no locale support yet */
1509 STRLEN len;
1510 U8 tmpbuf[UTF8_MAXBYTES_CASE+1];
1511 return (U32)to_uni_lower(c, tmpbuf, &len);
1512}
1513
1514bool
1515Perl_is_utf8_alnum(pTHX_ const U8 *p)
1516{
1517 dVAR;
1518
1519 PERL_ARGS_ASSERT_IS_UTF8_ALNUM;
1520
1521 /* NOTE: "IsWord", not "IsAlnum", since Alnum is a true
1522 * descendant of isalnum(3), in other words, it doesn't
1523 * contain the '_'. --jhi */
1524 return isWORDCHAR_utf8(p);
1525}
1526
1527bool
1528Perl_is_utf8_alnumc(pTHX_ const U8 *p)
1529{
1530 dVAR;
1531
1532 PERL_ARGS_ASSERT_IS_UTF8_ALNUMC;
1533
1534 return isALPHANUMERIC_utf8(p);
1535}
1536
1537bool
1538Perl_is_utf8_alpha(pTHX_ const U8 *p)
1539{
1540 dVAR;
1541
1542 PERL_ARGS_ASSERT_IS_UTF8_ALPHA;
1543
1544 return isALPHA_utf8(p);
1545}
1546
1547bool
1548Perl_is_utf8_ascii(pTHX_ const U8 *p)
1549{
1550 dVAR;
1551
1552 PERL_ARGS_ASSERT_IS_UTF8_ASCII;
1553
1554 return isASCII_utf8(p);
1555}
1556
1557bool
1558Perl_is_utf8_blank(pTHX_ const U8 *p)
1559{
1560 dVAR;
1561
1562 PERL_ARGS_ASSERT_IS_UTF8_BLANK;
1563
1564 return isBLANK_utf8(p);
1565}
1566
1567bool
1568Perl_is_utf8_space(pTHX_ const U8 *p)
1569{
1570 dVAR;
1571
1572 PERL_ARGS_ASSERT_IS_UTF8_SPACE;
1573
1574 return isSPACE_utf8(p);
1575}
1576
1577bool
1578Perl_is_utf8_perl_space(pTHX_ const U8 *p)
1579{
1580 dVAR;
1581
1582 PERL_ARGS_ASSERT_IS_UTF8_PERL_SPACE;
1583
1584 /* Only true if is an ASCII space-like character, and ASCII is invariant
1585 * under utf8, so can just use the macro */
1586 return isSPACE_A(*p);
1587}
1588
1589bool
1590Perl_is_utf8_perl_word(pTHX_ const U8 *p)
1591{
1592 dVAR;
1593
1594 PERL_ARGS_ASSERT_IS_UTF8_PERL_WORD;
1595
1596 /* Only true if is an ASCII word character, and ASCII is invariant
1597 * under utf8, so can just use the macro */
1598 return isWORDCHAR_A(*p);
1599}
1600
1601bool
1602Perl_is_utf8_digit(pTHX_ const U8 *p)
1603{
1604 dVAR;
1605
1606 PERL_ARGS_ASSERT_IS_UTF8_DIGIT;
1607
1608 return isDIGIT_utf8(p);
1609}
1610
1611bool
1612Perl_is_utf8_posix_digit(pTHX_ const U8 *p)
1613{
1614 dVAR;
1615
1616 PERL_ARGS_ASSERT_IS_UTF8_POSIX_DIGIT;
1617
1618 /* Only true if is an ASCII digit character, and ASCII is invariant
1619 * under utf8, so can just use the macro */
1620 return isDIGIT_A(*p);
1621}
1622
1623bool
1624Perl_is_utf8_upper(pTHX_ const U8 *p)
1625{
1626 dVAR;
1627
1628 PERL_ARGS_ASSERT_IS_UTF8_UPPER;
1629
1630 return isUPPER_utf8(p);
1631}
1632
1633bool
1634Perl_is_utf8_lower(pTHX_ const U8 *p)
1635{
1636 dVAR;
1637
1638 PERL_ARGS_ASSERT_IS_UTF8_LOWER;
1639
1640 return isLOWER_utf8(p);
1641}
1642
1643bool
1644Perl_is_utf8_cntrl(pTHX_ const U8 *p)
1645{
1646 dVAR;
1647
1648 PERL_ARGS_ASSERT_IS_UTF8_CNTRL;
1649
1650 return isCNTRL_utf8(p);
1651}
1652
1653bool
1654Perl_is_utf8_graph(pTHX_ const U8 *p)
1655{
1656 dVAR;
1657
1658 PERL_ARGS_ASSERT_IS_UTF8_GRAPH;
1659
1660 return isGRAPH_utf8(p);
1661}
1662
1663bool
1664Perl_is_utf8_print(pTHX_ const U8 *p)
1665{
1666 dVAR;
1667
1668 PERL_ARGS_ASSERT_IS_UTF8_PRINT;
1669
1670 return isPRINT_utf8(p);
1671}
1672
1673bool
1674Perl_is_utf8_punct(pTHX_ const U8 *p)
1675{
1676 dVAR;
1677
1678 PERL_ARGS_ASSERT_IS_UTF8_PUNCT;
1679
1680 return isPUNCT_utf8(p);
1681}
1682
1683bool
1684Perl_is_utf8_xdigit(pTHX_ const U8 *p)
1685{
1686 dVAR;
1687
1688 PERL_ARGS_ASSERT_IS_UTF8_XDIGIT;
1689
1690 return isXDIGIT_utf8(p);
1691}
1692
1693bool
1694Perl_is_utf8_mark(pTHX_ const U8 *p)
1695{
1696 dVAR;
1697
1698 PERL_ARGS_ASSERT_IS_UTF8_MARK;
1699
1700 return _is_utf8_mark(p);
1701}
1702
f2645549
KW
1703/*
1704=for apidoc is_utf8_char
1705
1706Tests if some arbitrary number of bytes begins in a valid UTF-8
1707character. Note that an INVARIANT (i.e. ASCII on non-EBCDIC machines)
1708character is a valid UTF-8 character. The actual number of bytes in the UTF-8
1709character will be returned if it is valid, otherwise 0.
1710
1711This function is deprecated due to the possibility that malformed input could
1712cause reading beyond the end of the input buffer. Use L</isUTF8_CHAR>
1713instead.
1714
1715=cut */
1716
1717STRLEN
1718Perl_is_utf8_char(const U8 *s)
1719{
1720 PERL_ARGS_ASSERT_IS_UTF8_CHAR;
1721
1722 /* Assumes we have enough space, which is why this is deprecated */
1723 return isUTF8_CHAR(s, s + UTF8SKIP(s));
1724}
1725
1726/* DEPRECATED!
1727 * Like L</utf8_to_uvuni_buf>(), but should only be called when it is known that
1728 * there are no malformations in the input UTF-8 string C<s>. Surrogates,
1729 * non-character code points, and non-Unicode code points are allowed */
1730
1731UV
1732Perl_valid_utf8_to_uvuni(pTHX_ const U8 *s, STRLEN *retlen)
1733{
1734 PERL_ARGS_ASSERT_VALID_UTF8_TO_UVUNI;
1735
1736 return NATIVE_TO_UNI(valid_utf8_to_uvchr(s, retlen));
1737}
1738
1739/*
1740=for apidoc utf8_to_uvchr
1741
1742Returns the native code point of the first character in the string C<s>
1743which is assumed to be in UTF-8 encoding; C<retlen> will be set to the
1744length, in bytes, of that character.
1745
1746Some, but not all, UTF-8 malformations are detected, and in fact, some
1747malformed input could cause reading beyond the end of the input buffer, which
1748is why this function is deprecated. Use L</utf8_to_uvchr_buf> instead.
1749
1750If C<s> points to one of the detected malformations, and UTF8 warnings are
1751enabled, zero is returned and C<*retlen> is set (if C<retlen> isn't
1752NULL) to -1. If those warnings are off, the computed value if well-defined (or
1753the Unicode REPLACEMENT CHARACTER, if not) is silently returned, and C<*retlen>
1754is set (if C<retlen> isn't NULL) so that (S<C<s> + C<*retlen>>) is the
1755next possible position in C<s> that could begin a non-malformed character.
1756See L</utf8n_to_uvchr> for details on when the REPLACEMENT CHARACTER is returned.
1757
1758=cut
1759*/
1760
1761UV
1762Perl_utf8_to_uvchr(pTHX_ const U8 *s, STRLEN *retlen)
1763{
1764 PERL_ARGS_ASSERT_UTF8_TO_UVCHR;
1765
1766 return utf8_to_uvchr_buf(s, s + UTF8_MAXBYTES, retlen);
1767}
1768
1769/*
1770=for apidoc utf8_to_uvuni
1771
1772Returns the Unicode code point of the first character in the string C<s>
1773which is assumed to be in UTF-8 encoding; C<retlen> will be set to the
1774length, in bytes, of that character.
1775
1776Some, but not all, UTF-8 malformations are detected, and in fact, some
1777malformed input could cause reading beyond the end of the input buffer, which
1778is one reason why this function is deprecated. The other is that only in
1779extremely limited circumstances should the Unicode versus native code point be
1780of any interest to you. See L</utf8_to_uvuni_buf> for alternatives.
1781
1782If C<s> points to one of the detected malformations, and UTF8 warnings are
1783enabled, zero is returned and C<*retlen> is set (if C<retlen> doesn't point to
1784NULL) to -1. If those warnings are off, the computed value if well-defined (or
1785the Unicode REPLACEMENT CHARACTER, if not) is silently returned, and C<*retlen>
1786is set (if C<retlen> isn't NULL) so that (S<C<s> + C<*retlen>>) is the
1787next possible position in C<s> that could begin a non-malformed character.
1788See L</utf8n_to_uvchr> for details on when the REPLACEMENT CHARACTER is returned.
1789
1790=cut
1791*/
1792
1793UV
1794Perl_utf8_to_uvuni(pTHX_ const U8 *s, STRLEN *retlen)
1795{
1796 PERL_ARGS_ASSERT_UTF8_TO_UVUNI;
1797
1798 return NATIVE_TO_UNI(valid_utf8_to_uvchr(s, retlen));
1799}
1800
361ec98e 1801END_EXTERN_C
d4478588 1802
20fac488
GA
1803#endif /* NO_MATHOMS */
1804
d5b2b27b 1805/*
7ee2227d
SP
1806 * Local variables:
1807 * c-indentation-style: bsd
1808 * c-basic-offset: 4
14d04a33 1809 * indent-tabs-mode: nil
7ee2227d
SP
1810 * End:
1811 *
14d04a33 1812 * ex: set ts=8 sts=4 sw=4 et:
7ee2227d 1813 */