Stop inadvertently skipping Spec.t on VMS.
[perl.git] / mathoms.c
1 /*    mathoms.c
2  *
3  *    Copyright (C) 2005, 2006, 2007, 2008 by Larry Wall and others
4  *
5  *    You may distribute under the terms of either the GNU General Public
6  *    License or the Artistic License, as specified in the README file.
7  *
8  */
9
10 /*
11  *  Anything that Hobbits had no immediate use for, but were unwilling to
12  *  throw away, they called a mathom.  Their dwellings were apt to become
13  *  rather crowded with mathoms, and many of the presents that passed from
14  *  hand to hand were of that sort.
15  *
16  *     [p.5 of _The Lord of the Rings_: "Prologue"]
17  */
18
19
20
21 /* 
22  * This file contains mathoms, various binary artifacts from previous
23  * versions of Perl.  For binary or source compatibility reasons, though,
24  * we cannot completely remove them from the core code.  
25  *
26  * SMP - Oct. 24, 2005
27  *
28  */
29
30 #include "EXTERN.h"
31 #define PERL_IN_MATHOMS_C
32 #include "perl.h"
33
34 #ifdef NO_MATHOMS
35 /* ..." warning: ISO C forbids an empty source file"
36    So make sure we have something in here by processing the headers anyway.
37  */
38 #else
39
40 PERL_CALLCONV OP * Perl_ref(pTHX_ OP *o, I32 type);
41 PERL_CALLCONV void Perl_sv_unref(pTHX_ SV *sv);
42 PERL_CALLCONV void Perl_sv_taint(pTHX_ SV *sv);
43 PERL_CALLCONV IV Perl_sv_2iv(pTHX_ register SV *sv);
44 PERL_CALLCONV UV Perl_sv_2uv(pTHX_ register SV *sv);
45 PERL_CALLCONV NV Perl_sv_2nv(pTHX_ register SV *sv);
46 PERL_CALLCONV char * Perl_sv_2pv(pTHX_ register SV *sv, STRLEN *lp);
47 PERL_CALLCONV char * Perl_sv_2pv_nolen(pTHX_ register SV *sv);
48 PERL_CALLCONV char * Perl_sv_2pvbyte_nolen(pTHX_ register SV *sv);
49 PERL_CALLCONV char * Perl_sv_2pvutf8_nolen(pTHX_ register SV *sv);
50 PERL_CALLCONV void Perl_sv_force_normal(pTHX_ register SV *sv);
51 PERL_CALLCONV void Perl_sv_setsv(pTHX_ SV *dstr, register SV *sstr);
52 PERL_CALLCONV void Perl_sv_catpvn(pTHX_ SV *dsv, const char* sstr, STRLEN slen);
53 PERL_CALLCONV void Perl_sv_catpvn_mg(pTHX_ register SV *sv, register const char *ptr, register STRLEN len);
54 PERL_CALLCONV void Perl_sv_catsv(pTHX_ SV *dstr, register SV *sstr);
55 PERL_CALLCONV void Perl_sv_catsv_mg(pTHX_ SV *dsv, register SV *ssv);
56 PERL_CALLCONV char * Perl_sv_pv(pTHX_ SV *sv);
57 PERL_CALLCONV char * Perl_sv_pvn_force(pTHX_ SV *sv, STRLEN *lp);
58 PERL_CALLCONV char * Perl_sv_pvbyte(pTHX_ SV *sv);
59 PERL_CALLCONV char * Perl_sv_pvutf8(pTHX_ SV *sv);
60 PERL_CALLCONV STRLEN Perl_sv_utf8_upgrade(pTHX_ register SV *sv);
61 PERL_CALLCONV NV Perl_huge(void);
62 PERL_CALLCONV void Perl_gv_fullname3(pTHX_ SV *sv, const GV *gv, const char *prefix);
63 PERL_CALLCONV void Perl_gv_efullname3(pTHX_ SV *sv, const GV *gv, const char *prefix);
64 PERL_CALLCONV GV * Perl_gv_fetchmethod(pTHX_ HV *stash, const char *name);
65 PERL_CALLCONV HE * Perl_hv_iternext(pTHX_ HV *hv);
66 PERL_CALLCONV void Perl_hv_magic(pTHX_ HV *hv, GV *gv, int how);
67 PERL_CALLCONV bool Perl_do_open(pTHX_ GV *gv, register const char *name, I32 len, int as_raw, int rawmode, int rawperm, PerlIO *supplied_fp);
68 PERL_CALLCONV bool Perl_do_aexec(pTHX_ SV *really, register SV **mark, register SV **sp);
69 PERL_CALLCONV U8 * Perl_uvuni_to_utf8(pTHX_ U8 *d, UV uv);
70 PERL_CALLCONV bool Perl_is_utf8_string_loc(pTHX_ const U8 *s, STRLEN len, const U8 **ep);
71 PERL_CALLCONV void Perl_sv_nolocking(pTHX_ SV *sv);
72 PERL_CALLCONV void Perl_sv_usepvn_mg(pTHX_ SV *sv, char *ptr, STRLEN len);
73 PERL_CALLCONV void Perl_sv_usepvn(pTHX_ SV *sv, char *ptr, STRLEN len);
74 PERL_CALLCONV int Perl_fprintf_nocontext(PerlIO *stream, const char *format, ...);
75 PERL_CALLCONV int Perl_printf_nocontext(const char *format, ...);
76 PERL_CALLCONV int Perl_magic_setglob(pTHX_ SV* sv, MAGIC* mg);
77 PERL_CALLCONV AV * Perl_newAV(pTHX);
78 PERL_CALLCONV HV * Perl_newHV(pTHX);
79 PERL_CALLCONV IO * Perl_newIO(pTHX);
80 PERL_CALLCONV I32 Perl_my_stat(pTHX);
81 PERL_CALLCONV I32 Perl_my_lstat(pTHX);
82 PERL_CALLCONV I32 Perl_sv_eq(pTHX_ register SV *sv1, register SV *sv2);
83 PERL_CALLCONV char * Perl_sv_collxfrm(pTHX_ SV *const sv, STRLEN *const nxp);
84 PERL_CALLCONV bool Perl_sv_2bool(pTHX_ register SV *const sv);
85 PERL_CALLCONV CV * Perl_newSUB(pTHX_ I32 floor, OP* o, OP* proto, OP* block);
86 PERL_CALLCONV UV Perl_to_utf8_lower(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp);
87 PERL_CALLCONV UV Perl_to_utf8_title(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp);
88 PERL_CALLCONV UV Perl_to_utf8_upper(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp);
89 PERL_CALLCONV UV Perl_to_utf8_fold(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp);
90
91 /* ref() is now a macro using Perl_doref;
92  * this version provided for binary compatibility only.
93  */
94 OP *
95 Perl_ref(pTHX_ OP *o, I32 type)
96 {
97     return doref(o, type, TRUE);
98 }
99
100 /*
101 =for apidoc sv_unref
102
103 Unsets the RV status of the SV, and decrements the reference count of
104 whatever was being referenced by the RV.  This can almost be thought of
105 as a reversal of C<newSVrv>.  This is C<sv_unref_flags> with the C<flag>
106 being zero.  See C<SvROK_off>.
107
108 =cut
109 */
110
111 void
112 Perl_sv_unref(pTHX_ SV *sv)
113 {
114     PERL_ARGS_ASSERT_SV_UNREF;
115
116     sv_unref_flags(sv, 0);
117 }
118
119 /*
120 =for apidoc sv_taint
121
122 Taint an SV. Use C<SvTAINTED_on> instead.
123
124 =cut
125 */
126
127 void
128 Perl_sv_taint(pTHX_ SV *sv)
129 {
130     PERL_ARGS_ASSERT_SV_TAINT;
131
132     sv_magic((sv), NULL, PERL_MAGIC_taint, NULL, 0);
133 }
134
135 /* sv_2iv() is now a macro using Perl_sv_2iv_flags();
136  * this function provided for binary compatibility only
137  */
138
139 IV
140 Perl_sv_2iv(pTHX_ register SV *sv)
141 {
142     return sv_2iv_flags(sv, SV_GMAGIC);
143 }
144
145 /* sv_2uv() is now a macro using Perl_sv_2uv_flags();
146  * this function provided for binary compatibility only
147  */
148
149 UV
150 Perl_sv_2uv(pTHX_ register SV *sv)
151 {
152     return sv_2uv_flags(sv, SV_GMAGIC);
153 }
154
155 /* sv_2nv() is now a macro using Perl_sv_2nv_flags();
156  * this function provided for binary compatibility only
157  */
158
159 NV
160 Perl_sv_2nv(pTHX_ register SV *sv)
161 {
162     return sv_2nv_flags(sv, SV_GMAGIC);
163 }
164
165
166 /* sv_2pv() is now a macro using Perl_sv_2pv_flags();
167  * this function provided for binary compatibility only
168  */
169
170 char *
171 Perl_sv_2pv(pTHX_ register SV *sv, STRLEN *lp)
172 {
173     return sv_2pv_flags(sv, lp, SV_GMAGIC);
174 }
175
176 /*
177 =for apidoc sv_2pv_nolen
178
179 Like C<sv_2pv()>, but doesn't return the length too. You should usually
180 use the macro wrapper C<SvPV_nolen(sv)> instead.
181
182 =cut
183 */
184
185 char *
186 Perl_sv_2pv_nolen(pTHX_ register SV *sv)
187 {
188     PERL_ARGS_ASSERT_SV_2PV_NOLEN;
189     return sv_2pv(sv, NULL);
190 }
191
192 /*
193 =for apidoc sv_2pvbyte_nolen
194
195 Return a pointer to the byte-encoded representation of the SV.
196 May cause the SV to be downgraded from UTF-8 as a side-effect.
197
198 Usually accessed via the C<SvPVbyte_nolen> macro.
199
200 =cut
201 */
202
203 char *
204 Perl_sv_2pvbyte_nolen(pTHX_ register SV *sv)
205 {
206     PERL_ARGS_ASSERT_SV_2PVBYTE_NOLEN;
207
208     return sv_2pvbyte(sv, NULL);
209 }
210
211 /*
212 =for apidoc sv_2pvutf8_nolen
213
214 Return a pointer to the UTF-8-encoded representation of the SV.
215 May cause the SV to be upgraded to UTF-8 as a side-effect.
216
217 Usually accessed via the C<SvPVutf8_nolen> macro.
218
219 =cut
220 */
221
222 char *
223 Perl_sv_2pvutf8_nolen(pTHX_ register SV *sv)
224 {
225     PERL_ARGS_ASSERT_SV_2PVUTF8_NOLEN;
226
227     return sv_2pvutf8(sv, NULL);
228 }
229
230 /*
231 =for apidoc sv_force_normal
232
233 Undo various types of fakery on an SV: if the PV is a shared string, make
234 a private copy; if we're a ref, stop refing; if we're a glob, downgrade to
235 an xpvmg. See also C<sv_force_normal_flags>.
236
237 =cut
238 */
239
240 void
241 Perl_sv_force_normal(pTHX_ register SV *sv)
242 {
243     PERL_ARGS_ASSERT_SV_FORCE_NORMAL;
244
245     sv_force_normal_flags(sv, 0);
246 }
247
248 /* sv_setsv() is now a macro using Perl_sv_setsv_flags();
249  * this function provided for binary compatibility only
250  */
251
252 void
253 Perl_sv_setsv(pTHX_ SV *dstr, register SV *sstr)
254 {
255     PERL_ARGS_ASSERT_SV_SETSV;
256
257     sv_setsv_flags(dstr, sstr, SV_GMAGIC);
258 }
259
260 /* sv_catpvn() is now a macro using Perl_sv_catpvn_flags();
261  * this function provided for binary compatibility only
262  */
263
264 void
265 Perl_sv_catpvn(pTHX_ SV *dsv, const char* sstr, STRLEN slen)
266 {
267     PERL_ARGS_ASSERT_SV_CATPVN;
268
269     sv_catpvn_flags(dsv, sstr, slen, SV_GMAGIC);
270 }
271
272 /*
273 =for apidoc sv_catpvn_mg
274
275 Like C<sv_catpvn>, but also handles 'set' magic.
276
277 =cut
278 */
279
280 void
281 Perl_sv_catpvn_mg(pTHX_ register SV *sv, register const char *ptr, register STRLEN len)
282 {
283     PERL_ARGS_ASSERT_SV_CATPVN_MG;
284
285     sv_catpvn_flags(sv,ptr,len,SV_GMAGIC|SV_SMAGIC);
286 }
287
288 /* sv_catsv() is now a macro using Perl_sv_catsv_flags();
289  * this function provided for binary compatibility only
290  */
291
292 void
293 Perl_sv_catsv(pTHX_ SV *dstr, register SV *sstr)
294 {
295     PERL_ARGS_ASSERT_SV_CATSV;
296
297     sv_catsv_flags(dstr, sstr, SV_GMAGIC);
298 }
299
300 /*
301 =for apidoc sv_catsv_mg
302
303 Like C<sv_catsv>, but also handles 'set' magic.
304
305 =cut
306 */
307
308 void
309 Perl_sv_catsv_mg(pTHX_ SV *dsv, register SV *ssv)
310 {
311     PERL_ARGS_ASSERT_SV_CATSV_MG;
312
313     sv_catsv_flags(dsv,ssv,SV_GMAGIC|SV_SMAGIC);
314 }
315
316 /*
317 =for apidoc sv_iv
318
319 A private implementation of the C<SvIVx> macro for compilers which can't
320 cope with complex macro expressions. Always use the macro instead.
321
322 =cut
323 */
324
325 IV
326 Perl_sv_iv(pTHX_ register SV *sv)
327 {
328     PERL_ARGS_ASSERT_SV_IV;
329
330     if (SvIOK(sv)) {
331         if (SvIsUV(sv))
332             return (IV)SvUVX(sv);
333         return SvIVX(sv);
334     }
335     return sv_2iv(sv);
336 }
337
338 /*
339 =for apidoc sv_uv
340
341 A private implementation of the C<SvUVx> macro for compilers which can't
342 cope with complex macro expressions. Always use the macro instead.
343
344 =cut
345 */
346
347 UV
348 Perl_sv_uv(pTHX_ register SV *sv)
349 {
350     PERL_ARGS_ASSERT_SV_UV;
351
352     if (SvIOK(sv)) {
353         if (SvIsUV(sv))
354             return SvUVX(sv);
355         return (UV)SvIVX(sv);
356     }
357     return sv_2uv(sv);
358 }
359
360 /*
361 =for apidoc sv_nv
362
363 A private implementation of the C<SvNVx> macro for compilers which can't
364 cope with complex macro expressions. Always use the macro instead.
365
366 =cut
367 */
368
369 NV
370 Perl_sv_nv(pTHX_ register SV *sv)
371 {
372     PERL_ARGS_ASSERT_SV_NV;
373
374     if (SvNOK(sv))
375         return SvNVX(sv);
376     return sv_2nv(sv);
377 }
378
379 /*
380 =for apidoc sv_pv
381
382 Use the C<SvPV_nolen> macro instead
383
384 =for apidoc sv_pvn
385
386 A private implementation of the C<SvPV> macro for compilers which can't
387 cope with complex macro expressions. Always use the macro instead.
388
389 =cut
390 */
391
392 char *
393 Perl_sv_pvn(pTHX_ SV *sv, STRLEN *lp)
394 {
395     PERL_ARGS_ASSERT_SV_PVN;
396
397     if (SvPOK(sv)) {
398         *lp = SvCUR(sv);
399         return SvPVX(sv);
400     }
401     return sv_2pv(sv, lp);
402 }
403
404
405 char *
406 Perl_sv_pvn_nomg(pTHX_ register SV *sv, STRLEN *lp)
407 {
408     PERL_ARGS_ASSERT_SV_PVN_NOMG;
409
410     if (SvPOK(sv)) {
411         *lp = SvCUR(sv);
412         return SvPVX(sv);
413     }
414     return sv_2pv_flags(sv, lp, 0);
415 }
416
417 /* sv_pv() is now a macro using SvPV_nolen();
418  * this function provided for binary compatibility only
419  */
420
421 char *
422 Perl_sv_pv(pTHX_ SV *sv)
423 {
424     PERL_ARGS_ASSERT_SV_PV;
425
426     if (SvPOK(sv))
427         return SvPVX(sv);
428
429     return sv_2pv(sv, NULL);
430 }
431
432 /* sv_pvn_force() is now a macro using Perl_sv_pvn_force_flags();
433  * this function provided for binary compatibility only
434  */
435
436 char *
437 Perl_sv_pvn_force(pTHX_ SV *sv, STRLEN *lp)
438 {
439     PERL_ARGS_ASSERT_SV_PVN_FORCE;
440
441     return sv_pvn_force_flags(sv, lp, SV_GMAGIC);
442 }
443
444 /* sv_pvbyte () is now a macro using Perl_sv_2pv_flags();
445  * this function provided for binary compatibility only
446  */
447
448 char *
449 Perl_sv_pvbyte(pTHX_ SV *sv)
450 {
451     PERL_ARGS_ASSERT_SV_PVBYTE;
452
453     sv_utf8_downgrade(sv, FALSE);
454     return sv_pv(sv);
455 }
456
457 /*
458 =for apidoc sv_pvbyte
459
460 Use C<SvPVbyte_nolen> instead.
461
462 =for apidoc sv_pvbyten
463
464 A private implementation of the C<SvPVbyte> macro for compilers
465 which can't cope with complex macro expressions. Always use the macro
466 instead.
467
468 =cut
469 */
470
471 char *
472 Perl_sv_pvbyten(pTHX_ SV *sv, STRLEN *lp)
473 {
474     PERL_ARGS_ASSERT_SV_PVBYTEN;
475
476     sv_utf8_downgrade(sv, FALSE);
477     return sv_pvn(sv,lp);
478 }
479
480 /* sv_pvutf8 () is now a macro using Perl_sv_2pv_flags();
481  * this function provided for binary compatibility only
482  */
483
484 char *
485 Perl_sv_pvutf8(pTHX_ SV *sv)
486 {
487     PERL_ARGS_ASSERT_SV_PVUTF8;
488
489     sv_utf8_upgrade(sv);
490     return sv_pv(sv);
491 }
492
493 /*
494 =for apidoc sv_pvutf8
495
496 Use the C<SvPVutf8_nolen> macro instead
497
498 =for apidoc sv_pvutf8n
499
500 A private implementation of the C<SvPVutf8> macro for compilers
501 which can't cope with complex macro expressions. Always use the macro
502 instead.
503
504 =cut
505 */
506
507 char *
508 Perl_sv_pvutf8n(pTHX_ SV *sv, STRLEN *lp)
509 {
510     PERL_ARGS_ASSERT_SV_PVUTF8N;
511
512     sv_utf8_upgrade(sv);
513     return sv_pvn(sv,lp);
514 }
515
516 /* sv_utf8_upgrade() is now a macro using sv_utf8_upgrade_flags();
517  * this function provided for binary compatibility only
518  */
519
520 STRLEN
521 Perl_sv_utf8_upgrade(pTHX_ register SV *sv)
522 {
523     PERL_ARGS_ASSERT_SV_UTF8_UPGRADE;
524
525     return sv_utf8_upgrade_flags(sv, SV_GMAGIC);
526 }
527
528 int
529 Perl_fprintf_nocontext(PerlIO *stream, const char *format, ...)
530 {
531     dTHXs;
532     va_list(arglist);
533
534     /* Easier to special case this here than in embed.pl. (Look at what it
535        generates for proto.h) */
536 #ifdef PERL_IMPLICIT_CONTEXT
537     PERL_ARGS_ASSERT_FPRINTF_NOCONTEXT;
538 #endif
539
540     va_start(arglist, format);
541     return PerlIO_vprintf(stream, format, arglist);
542 }
543
544 int
545 Perl_printf_nocontext(const char *format, ...)
546 {
547     dTHX;
548     va_list(arglist);
549
550 #ifdef PERL_IMPLICIT_CONTEXT
551     PERL_ARGS_ASSERT_PRINTF_NOCONTEXT;
552 #endif
553
554     va_start(arglist, format);
555     return PerlIO_vprintf(PerlIO_stdout(), format, arglist);
556 }
557
558 #if defined(HUGE_VAL) || (defined(USE_LONG_DOUBLE) && defined(HUGE_VALL))
559 /*
560  * This hack is to force load of "huge" support from libm.a
561  * So it is in perl for (say) POSIX to use.
562  * Needed for SunOS with Sun's 'acc' for example.
563  */
564 NV
565 Perl_huge(void)
566 {
567 #  if defined(USE_LONG_DOUBLE) && defined(HUGE_VALL)
568     return HUGE_VALL;
569 #  else
570     return HUGE_VAL;
571 #  endif
572 }
573 #endif
574
575 /* compatibility with versions <= 5.003. */
576 void
577 Perl_gv_fullname(pTHX_ SV *sv, const GV *gv)
578 {
579     PERL_ARGS_ASSERT_GV_FULLNAME;
580
581     gv_fullname3(sv, gv, sv == (const SV*)gv ? "*" : "");
582 }
583
584 /* compatibility with versions <= 5.003. */
585 void
586 Perl_gv_efullname(pTHX_ SV *sv, const GV *gv)
587 {
588     PERL_ARGS_ASSERT_GV_EFULLNAME;
589
590     gv_efullname3(sv, gv, sv == (const SV*)gv ? "*" : "");
591 }
592
593 void
594 Perl_gv_fullname3(pTHX_ SV *sv, const GV *gv, const char *prefix)
595 {
596     PERL_ARGS_ASSERT_GV_FULLNAME3;
597
598     gv_fullname4(sv, gv, prefix, TRUE);
599 }
600
601 void
602 Perl_gv_efullname3(pTHX_ SV *sv, const GV *gv, const char *prefix)
603 {
604     PERL_ARGS_ASSERT_GV_EFULLNAME3;
605
606     gv_efullname4(sv, gv, prefix, TRUE);
607 }
608
609 /*
610 =for apidoc gv_fetchmethod
611
612 See L</gv_fetchmethod_autoload>.
613
614 =cut
615 */
616
617 GV *
618 Perl_gv_fetchmethod(pTHX_ HV *stash, const char *name)
619 {
620     PERL_ARGS_ASSERT_GV_FETCHMETHOD;
621
622     return gv_fetchmethod_autoload(stash, name, TRUE);
623 }
624
625 HE *
626 Perl_hv_iternext(pTHX_ HV *hv)
627 {
628     PERL_ARGS_ASSERT_HV_ITERNEXT;
629
630     return hv_iternext_flags(hv, 0);
631 }
632
633 void
634 Perl_hv_magic(pTHX_ HV *hv, GV *gv, int how)
635 {
636     PERL_ARGS_ASSERT_HV_MAGIC;
637
638     sv_magic(MUTABLE_SV(hv), MUTABLE_SV(gv), how, NULL, 0);
639 }
640
641 bool
642 Perl_do_open(pTHX_ GV *gv, register const char *name, I32 len, int as_raw,
643              int rawmode, int rawperm, PerlIO *supplied_fp)
644 {
645     PERL_ARGS_ASSERT_DO_OPEN;
646
647     return do_openn(gv, name, len, as_raw, rawmode, rawperm,
648                     supplied_fp, (SV **) NULL, 0);
649 }
650
651 bool
652 Perl_do_open9(pTHX_ GV *gv, register const char *name, I32 len, int 
653 as_raw,
654               int rawmode, int rawperm, PerlIO *supplied_fp, SV *svs,
655               I32 num_svs)
656 {
657     PERL_ARGS_ASSERT_DO_OPEN9;
658
659     PERL_UNUSED_ARG(num_svs);
660     return do_openn(gv, name, len, as_raw, rawmode, rawperm,
661                     supplied_fp, &svs, 1);
662 }
663
664 int
665 Perl_do_binmode(pTHX_ PerlIO *fp, int iotype, int mode)
666 {
667  /* The old body of this is now in non-LAYER part of perlio.c
668   * This is a stub for any XS code which might have been calling it.
669   */
670  const char *name = ":raw";
671
672  PERL_ARGS_ASSERT_DO_BINMODE;
673
674 #ifdef PERLIO_USING_CRLF
675  if (!(mode & O_BINARY))
676      name = ":crlf";
677 #endif
678  return PerlIO_binmode(aTHX_ fp, iotype, mode, name);
679 }
680
681 #ifndef OS2
682 bool
683 Perl_do_aexec(pTHX_ SV *really, register SV **mark, register SV **sp)
684 {
685     PERL_ARGS_ASSERT_DO_AEXEC;
686
687     return do_aexec5(really, mark, sp, 0, 0);
688 }
689 #endif
690
691 /* Backwards compatibility. */
692 int
693 Perl_init_i18nl14n(pTHX_ int printwarn)
694 {
695     return init_i18nl10n(printwarn);
696 }
697
698 U8 *
699 Perl_uvuni_to_utf8(pTHX_ U8 *d, UV uv)
700 {
701     PERL_ARGS_ASSERT_UVUNI_TO_UTF8;
702
703     return Perl_uvuni_to_utf8_flags(aTHX_ d, uv, 0);
704 }
705
706 bool
707 Perl_is_utf8_string_loc(pTHX_ const U8 *s, STRLEN len, const U8 **ep)
708 {
709     PERL_ARGS_ASSERT_IS_UTF8_STRING_LOC;
710
711     return is_utf8_string_loclen(s, len, ep, 0);
712 }
713
714 /*
715 =for apidoc sv_nolocking
716
717 Dummy routine which "locks" an SV when there is no locking module present.
718 Exists to avoid test for a NULL function pointer and because it could
719 potentially warn under some level of strict-ness.
720
721 "Superseded" by sv_nosharing().
722
723 =cut
724 */
725
726 void
727 Perl_sv_nolocking(pTHX_ SV *sv)
728 {
729     PERL_UNUSED_CONTEXT;
730     PERL_UNUSED_ARG(sv);
731 }
732
733
734 /*
735 =for apidoc sv_nounlocking
736
737 Dummy routine which "unlocks" an SV when there is no locking module present.
738 Exists to avoid test for a NULL function pointer and because it could
739 potentially warn under some level of strict-ness.
740
741 "Superseded" by sv_nosharing().
742
743 =cut
744 */
745
746 void
747 Perl_sv_nounlocking(pTHX_ SV *sv)
748 {
749     PERL_UNUSED_CONTEXT;
750     PERL_UNUSED_ARG(sv);
751 }
752
753 void
754 Perl_save_long(pTHX_ long int *longp)
755 {
756     dVAR;
757
758     PERL_ARGS_ASSERT_SAVE_LONG;
759
760     SSCHECK(3);
761     SSPUSHLONG(*longp);
762     SSPUSHPTR(longp);
763     SSPUSHUV(SAVEt_LONG);
764 }
765
766 void
767 Perl_save_iv(pTHX_ IV *ivp)
768 {
769     dVAR;
770
771     PERL_ARGS_ASSERT_SAVE_IV;
772
773     SSCHECK(3);
774     SSPUSHIV(*ivp);
775     SSPUSHPTR(ivp);
776     SSPUSHUV(SAVEt_IV);
777 }
778
779 void
780 Perl_save_nogv(pTHX_ GV *gv)
781 {
782     dVAR;
783
784     PERL_ARGS_ASSERT_SAVE_NOGV;
785
786     SSCHECK(2);
787     SSPUSHPTR(gv);
788     SSPUSHUV(SAVEt_NSTAB);
789 }
790
791 void
792 Perl_save_list(pTHX_ register SV **sarg, I32 maxsarg)
793 {
794     dVAR;
795     register I32 i;
796
797     PERL_ARGS_ASSERT_SAVE_LIST;
798
799     for (i = 1; i <= maxsarg; i++) {
800         register SV * const sv = newSV(0);
801         sv_setsv(sv,sarg[i]);
802         SSCHECK(3);
803         SSPUSHPTR(sarg[i]);             /* remember the pointer */
804         SSPUSHPTR(sv);                  /* remember the value */
805         SSPUSHUV(SAVEt_ITEM);
806     }
807 }
808
809 /*
810 =for apidoc sv_usepvn_mg
811
812 Like C<sv_usepvn>, but also handles 'set' magic.
813
814 =cut
815 */
816
817 void
818 Perl_sv_usepvn_mg(pTHX_ SV *sv, char *ptr, STRLEN len)
819 {
820     PERL_ARGS_ASSERT_SV_USEPVN_MG;
821
822     sv_usepvn_flags(sv,ptr,len, SV_SMAGIC);
823 }
824
825 /*
826 =for apidoc sv_usepvn
827
828 Tells an SV to use C<ptr> to find its string value. Implemented by
829 calling C<sv_usepvn_flags> with C<flags> of 0, hence does not handle 'set'
830 magic. See C<sv_usepvn_flags>.
831
832 =cut
833 */
834
835 void
836 Perl_sv_usepvn(pTHX_ SV *sv, char *ptr, STRLEN len)
837 {
838     PERL_ARGS_ASSERT_SV_USEPVN;
839
840     sv_usepvn_flags(sv,ptr,len, 0);
841 }
842
843 /*
844 =for apidoc unpack_str
845
846 The engine implementing unpack() Perl function. Note: parameters strbeg, new_s
847 and ocnt are not used. This call should not be used, use unpackstring instead.
848
849 =cut */
850
851 I32
852 Perl_unpack_str(pTHX_ const char *pat, const char *patend, const char *s,
853                 const char *strbeg, const char *strend, char **new_s, I32 ocnt,
854                 U32 flags)
855 {
856     PERL_ARGS_ASSERT_UNPACK_STR;
857
858     PERL_UNUSED_ARG(strbeg);
859     PERL_UNUSED_ARG(new_s);
860     PERL_UNUSED_ARG(ocnt);
861
862     return unpackstring(pat, patend, s, strend, flags);
863 }
864
865 /*
866 =for apidoc pack_cat
867
868 The engine implementing pack() Perl function. Note: parameters next_in_list and
869 flags are not used. This call should not be used; use packlist instead.
870
871 =cut
872 */
873
874 void
875 Perl_pack_cat(pTHX_ SV *cat, const char *pat, const char *patend, register SV **beglist, SV **endlist, SV ***next_in_list, U32 flags)
876 {
877     PERL_ARGS_ASSERT_PACK_CAT;
878
879     PERL_UNUSED_ARG(next_in_list);
880     PERL_UNUSED_ARG(flags);
881
882     packlist(cat, pat, patend, beglist, endlist);
883 }
884
885 HE *
886 Perl_hv_store_ent(pTHX_ HV *hv, SV *keysv, SV *val, U32 hash)
887 {
888   return (HE *)hv_common(hv, keysv, NULL, 0, 0, HV_FETCH_ISSTORE, val, hash);
889 }
890
891 bool
892 Perl_hv_exists_ent(pTHX_ HV *hv, SV *keysv, U32 hash)
893 {
894     PERL_ARGS_ASSERT_HV_EXISTS_ENT;
895
896     return hv_common(hv, keysv, NULL, 0, 0, HV_FETCH_ISEXISTS, 0, hash)
897         ? TRUE : FALSE;
898 }
899
900 HE *
901 Perl_hv_fetch_ent(pTHX_ HV *hv, SV *keysv, I32 lval, U32 hash)
902 {
903     PERL_ARGS_ASSERT_HV_FETCH_ENT;
904
905     return (HE *)hv_common(hv, keysv, NULL, 0, 0, 
906                      (lval ? HV_FETCH_LVALUE : 0), NULL, hash);
907 }
908
909 SV *
910 Perl_hv_delete_ent(pTHX_ HV *hv, SV *keysv, I32 flags, U32 hash)
911 {
912     PERL_ARGS_ASSERT_HV_DELETE_ENT;
913
914     return MUTABLE_SV(hv_common(hv, keysv, NULL, 0, 0, flags | HV_DELETE, NULL,
915                                 hash));
916 }
917
918 SV**
919 Perl_hv_store_flags(pTHX_ HV *hv, const char *key, I32 klen, SV *val, U32 hash,
920                     int flags)
921 {
922     return (SV**) hv_common(hv, NULL, key, klen, flags,
923                             (HV_FETCH_ISSTORE|HV_FETCH_JUST_SV), val, hash);
924 }
925
926 SV**
927 Perl_hv_store(pTHX_ HV *hv, const char *key, I32 klen_i32, SV *val, U32 hash)
928 {
929     STRLEN klen;
930     int flags;
931
932     if (klen_i32 < 0) {
933         klen = -klen_i32;
934         flags = HVhek_UTF8;
935     } else {
936         klen = klen_i32;
937         flags = 0;
938     }
939     return (SV **) hv_common(hv, NULL, key, klen, flags,
940                              (HV_FETCH_ISSTORE|HV_FETCH_JUST_SV), val, hash);
941 }
942
943 bool
944 Perl_hv_exists(pTHX_ HV *hv, const char *key, I32 klen_i32)
945 {
946     STRLEN klen;
947     int flags;
948
949     PERL_ARGS_ASSERT_HV_EXISTS;
950
951     if (klen_i32 < 0) {
952         klen = -klen_i32;
953         flags = HVhek_UTF8;
954     } else {
955         klen = klen_i32;
956         flags = 0;
957     }
958     return hv_common(hv, NULL, key, klen, flags, HV_FETCH_ISEXISTS, 0, 0)
959         ? TRUE : FALSE;
960 }
961
962 SV**
963 Perl_hv_fetch(pTHX_ HV *hv, const char *key, I32 klen_i32, I32 lval)
964 {
965     STRLEN klen;
966     int flags;
967
968     PERL_ARGS_ASSERT_HV_FETCH;
969
970     if (klen_i32 < 0) {
971         klen = -klen_i32;
972         flags = HVhek_UTF8;
973     } else {
974         klen = klen_i32;
975         flags = 0;
976     }
977     return (SV **) hv_common(hv, NULL, key, klen, flags,
978                              lval ? (HV_FETCH_JUST_SV | HV_FETCH_LVALUE)
979                              : HV_FETCH_JUST_SV, NULL, 0);
980 }
981
982 SV *
983 Perl_hv_delete(pTHX_ HV *hv, const char *key, I32 klen_i32, I32 flags)
984 {
985     STRLEN klen;
986     int k_flags;
987
988     PERL_ARGS_ASSERT_HV_DELETE;
989
990     if (klen_i32 < 0) {
991         klen = -klen_i32;
992         k_flags = HVhek_UTF8;
993     } else {
994         klen = klen_i32;
995         k_flags = 0;
996     }
997     return MUTABLE_SV(hv_common(hv, NULL, key, klen, k_flags, flags | HV_DELETE,
998                                 NULL, 0));
999 }
1000
1001 /* Functions after here were made mathoms post 5.10.0 but pre 5.8.9 */
1002
1003 AV *
1004 Perl_newAV(pTHX)
1005 {
1006     return MUTABLE_AV(newSV_type(SVt_PVAV));
1007     /* sv_upgrade does AvREAL_only():
1008     AvALLOC(av) = 0;
1009     AvARRAY(av) = NULL;
1010     AvMAX(av) = AvFILLp(av) = -1; */
1011 }
1012
1013 HV *
1014 Perl_newHV(pTHX)
1015 {
1016     HV * const hv = MUTABLE_HV(newSV_type(SVt_PVHV));
1017     assert(!SvOK(hv));
1018
1019     return hv;
1020 }
1021
1022 void
1023 Perl_sv_insert(pTHX_ SV *const bigstr, const STRLEN offset, const STRLEN len, 
1024               const char *const little, const STRLEN littlelen)
1025 {
1026     PERL_ARGS_ASSERT_SV_INSERT;
1027     sv_insert_flags(bigstr, offset, len, little, littlelen, SV_GMAGIC);
1028 }
1029
1030 void
1031 Perl_save_freesv(pTHX_ SV *sv)
1032 {
1033     dVAR;
1034     save_freesv(sv);
1035 }
1036
1037 void
1038 Perl_save_mortalizesv(pTHX_ SV *sv)
1039 {
1040     dVAR;
1041
1042     PERL_ARGS_ASSERT_SAVE_MORTALIZESV;
1043
1044     save_mortalizesv(sv);
1045 }
1046
1047 void
1048 Perl_save_freeop(pTHX_ OP *o)
1049 {
1050     dVAR;
1051     save_freeop(o);
1052 }
1053
1054 void
1055 Perl_save_freepv(pTHX_ char *pv)
1056 {
1057     dVAR;
1058     save_freepv(pv);
1059 }
1060
1061 void
1062 Perl_save_op(pTHX)
1063 {
1064     dVAR;
1065     save_op();
1066 }
1067
1068 #ifdef PERL_DONT_CREATE_GVSV
1069 GV *
1070 Perl_gv_SVadd(pTHX_ GV *gv)
1071 {
1072     return gv_SVadd(gv);
1073 }
1074 #endif
1075
1076 GV *
1077 Perl_gv_AVadd(pTHX_ GV *gv)
1078 {
1079     return gv_AVadd(gv);
1080 }
1081
1082 GV *
1083 Perl_gv_HVadd(pTHX_ register GV *gv)
1084 {
1085     return gv_HVadd(gv);
1086 }
1087
1088 GV *
1089 Perl_gv_IOadd(pTHX_ register GV *gv)
1090 {
1091     return gv_IOadd(gv);
1092 }
1093
1094 IO *
1095 Perl_newIO(pTHX)
1096 {
1097     return MUTABLE_IO(newSV_type(SVt_PVIO));
1098 }
1099
1100 I32
1101 Perl_my_stat(pTHX)
1102 {
1103     return my_stat_flags(SV_GMAGIC);
1104 }
1105
1106 I32
1107 Perl_my_lstat(pTHX)
1108 {
1109     return my_lstat_flags(SV_GMAGIC);
1110 }
1111
1112 I32
1113 Perl_sv_eq(pTHX_ register SV *sv1, register SV *sv2)
1114 {
1115     return sv_eq_flags(sv1, sv2, SV_GMAGIC);
1116 }
1117
1118 #ifdef USE_LOCALE_COLLATE
1119 char *
1120 Perl_sv_collxfrm(pTHX_ SV *const sv, STRLEN *const nxp)
1121 {
1122     return sv_collxfrm_flags(sv, nxp, SV_GMAGIC);
1123 }
1124 #endif
1125
1126 bool
1127 Perl_sv_2bool(pTHX_ register SV *const sv)
1128 {
1129     return sv_2bool_flags(sv, SV_GMAGIC);
1130 }
1131
1132
1133 /*
1134 =for apidoc custom_op_name
1135 Return the name for a given custom op. This was once used by the OP_NAME
1136 macro, but is no longer: it has only been kept for compatibility, and
1137 should not be used.
1138
1139 =for apidoc custom_op_desc
1140 Return the description of a given custom op. This was once used by the
1141 OP_DESC macro, but is no longer: it has only been kept for
1142 compatibility, and should not be used.
1143
1144 =cut
1145 */
1146
1147 const char*
1148 Perl_custom_op_name(pTHX_ const OP* o)
1149 {
1150     PERL_ARGS_ASSERT_CUSTOM_OP_NAME;
1151     return XopENTRY(Perl_custom_op_xop(aTHX_ o), xop_name);
1152 }
1153
1154 const char*
1155 Perl_custom_op_desc(pTHX_ const OP* o)
1156 {
1157     PERL_ARGS_ASSERT_CUSTOM_OP_DESC;
1158     return XopENTRY(Perl_custom_op_xop(aTHX_ o), xop_desc);
1159 }
1160
1161 CV *
1162 Perl_newSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *block)
1163 {
1164     return Perl_newATTRSUB(aTHX_ floor, o, proto, NULL, block);
1165 }
1166
1167 UV
1168 Perl_to_utf8_fold(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp)
1169 {
1170     PERL_ARGS_ASSERT_TO_UTF8_FOLD;
1171
1172     return _to_utf8_fold_flags(p, ustrp, lenp, FOLD_FLAGS_FULL, NULL);
1173 }
1174
1175 UV
1176 Perl_to_utf8_lower(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp)
1177 {
1178     PERL_ARGS_ASSERT_TO_UTF8_LOWER;
1179
1180     return _to_utf8_lower_flags(p, ustrp, lenp, FALSE, NULL);
1181 }
1182
1183 UV
1184 Perl_to_utf8_title(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp)
1185 {
1186     PERL_ARGS_ASSERT_TO_UTF8_TITLE;
1187
1188     return _to_utf8_title_flags(p, ustrp, lenp, FALSE, NULL);
1189 }
1190
1191 UV
1192 Perl_to_utf8_upper(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp)
1193 {
1194     PERL_ARGS_ASSERT_TO_UTF8_UPPER;
1195
1196     return _to_utf8_upper_flags(p, ustrp, lenp, FALSE, NULL);
1197 }
1198
1199 #endif /* NO_MATHOMS */
1200
1201 /*
1202  * Local variables:
1203  * c-indentation-style: bsd
1204  * c-basic-offset: 4
1205  * indent-tabs-mode: t
1206  * End:
1207  *
1208  * ex: set ts=8 sts=4 sw=4 noet:
1209  */