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