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