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