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