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