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