Skip suid File::Copy tests on a nosuid partition
[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 bool Perl_do_exec(pTHX_ const char *cmd);
70 PERL_CALLCONV U8 * Perl_uvuni_to_utf8(pTHX_ U8 *d, UV uv);
71 PERL_CALLCONV bool Perl_is_utf8_string_loc(pTHX_ const U8 *s, STRLEN len, const U8 **ep);
72 PERL_CALLCONV void Perl_sv_nolocking(pTHX_ SV *sv);
73 PERL_CALLCONV void Perl_sv_usepvn_mg(pTHX_ SV *sv, char *ptr, STRLEN len);
74 PERL_CALLCONV void Perl_sv_usepvn(pTHX_ SV *sv, char *ptr, STRLEN len);
75 PERL_CALLCONV int Perl_fprintf_nocontext(PerlIO *stream, const char *format, ...);
76 PERL_CALLCONV int Perl_printf_nocontext(const char *format, ...);
77 PERL_CALLCONV int Perl_magic_setglob(pTHX_ SV* sv, MAGIC* mg);
78 PERL_CALLCONV AV * Perl_newAV(pTHX);
79 PERL_CALLCONV HV * Perl_newHV(pTHX);
80 PERL_CALLCONV IO * Perl_newIO(pTHX);
81
82 /* ref() is now a macro using Perl_doref;
83  * this version provided for binary compatibility only.
84  */
85 OP *
86 Perl_ref(pTHX_ OP *o, I32 type)
87 {
88     return doref(o, type, TRUE);
89 }
90
91 /*
92 =for apidoc sv_unref
93
94 Unsets the RV status of the SV, and decrements the reference count of
95 whatever was being referenced by the RV.  This can almost be thought of
96 as a reversal of C<newSVrv>.  This is C<sv_unref_flags> with the C<flag>
97 being zero.  See C<SvROK_off>.
98
99 =cut
100 */
101
102 void
103 Perl_sv_unref(pTHX_ SV *sv)
104 {
105     PERL_ARGS_ASSERT_SV_UNREF;
106
107     sv_unref_flags(sv, 0);
108 }
109
110 /*
111 =for apidoc sv_taint
112
113 Taint an SV. Use C<SvTAINTED_on> instead.
114 =cut
115 */
116
117 void
118 Perl_sv_taint(pTHX_ SV *sv)
119 {
120     PERL_ARGS_ASSERT_SV_TAINT;
121
122     sv_magic((sv), NULL, PERL_MAGIC_taint, NULL, 0);
123 }
124
125 /* sv_2iv() is now a macro using Perl_sv_2iv_flags();
126  * this function provided for binary compatibility only
127  */
128
129 IV
130 Perl_sv_2iv(pTHX_ register SV *sv)
131 {
132     return sv_2iv_flags(sv, SV_GMAGIC);
133 }
134
135 /* sv_2uv() is now a macro using Perl_sv_2uv_flags();
136  * this function provided for binary compatibility only
137  */
138
139 UV
140 Perl_sv_2uv(pTHX_ register SV *sv)
141 {
142     return sv_2uv_flags(sv, SV_GMAGIC);
143 }
144
145 /* sv_2nv() is now a macro using Perl_sv_2nv_flags();
146  * this function provided for binary compatibility only
147  */
148
149 NV
150 Perl_sv_2nv(pTHX_ register SV *sv)
151 {
152     return sv_2nv_flags(sv, SV_GMAGIC);
153 }
154
155
156 /* sv_2pv() is now a macro using Perl_sv_2pv_flags();
157  * this function provided for binary compatibility only
158  */
159
160 char *
161 Perl_sv_2pv(pTHX_ register SV *sv, STRLEN *lp)
162 {
163     return sv_2pv_flags(sv, lp, SV_GMAGIC);
164 }
165
166 /*
167 =for apidoc sv_2pv_nolen
168
169 Like C<sv_2pv()>, but doesn't return the length too. You should usually
170 use the macro wrapper C<SvPV_nolen(sv)> instead.
171 =cut
172 */
173
174 char *
175 Perl_sv_2pv_nolen(pTHX_ register SV *sv)
176 {
177     PERL_ARGS_ASSERT_SV_2PV_NOLEN;
178     return sv_2pv(sv, NULL);
179 }
180
181 /*
182 =for apidoc sv_2pvbyte_nolen
183
184 Return a pointer to the byte-encoded representation of the SV.
185 May cause the SV to be downgraded from UTF-8 as a side-effect.
186
187 Usually accessed via the C<SvPVbyte_nolen> macro.
188
189 =cut
190 */
191
192 char *
193 Perl_sv_2pvbyte_nolen(pTHX_ register SV *sv)
194 {
195     PERL_ARGS_ASSERT_SV_2PVBYTE_NOLEN;
196
197     return sv_2pvbyte(sv, NULL);
198 }
199
200 /*
201 =for apidoc sv_2pvutf8_nolen
202
203 Return a pointer to the UTF-8-encoded representation of the SV.
204 May cause the SV to be upgraded to UTF-8 as a side-effect.
205
206 Usually accessed via the C<SvPVutf8_nolen> macro.
207
208 =cut
209 */
210
211 char *
212 Perl_sv_2pvutf8_nolen(pTHX_ register SV *sv)
213 {
214     PERL_ARGS_ASSERT_SV_2PVUTF8_NOLEN;
215
216     return sv_2pvutf8(sv, NULL);
217 }
218
219 /*
220 =for apidoc sv_force_normal
221
222 Undo various types of fakery on an SV: if the PV is a shared string, make
223 a private copy; if we're a ref, stop refing; if we're a glob, downgrade to
224 an xpvmg. See also C<sv_force_normal_flags>.
225
226 =cut
227 */
228
229 void
230 Perl_sv_force_normal(pTHX_ register SV *sv)
231 {
232     PERL_ARGS_ASSERT_SV_FORCE_NORMAL;
233
234     sv_force_normal_flags(sv, 0);
235 }
236
237 /* sv_setsv() is now a macro using Perl_sv_setsv_flags();
238  * this function provided for binary compatibility only
239  */
240
241 void
242 Perl_sv_setsv(pTHX_ SV *dstr, register SV *sstr)
243 {
244     PERL_ARGS_ASSERT_SV_SETSV;
245
246     sv_setsv_flags(dstr, sstr, SV_GMAGIC);
247 }
248
249 /* sv_catpvn() is now a macro using Perl_sv_catpvn_flags();
250  * this function provided for binary compatibility only
251  */
252
253 void
254 Perl_sv_catpvn(pTHX_ SV *dsv, const char* sstr, STRLEN slen)
255 {
256     PERL_ARGS_ASSERT_SV_CATPVN;
257
258     sv_catpvn_flags(dsv, sstr, slen, SV_GMAGIC);
259 }
260
261 /*
262 =for apidoc sv_catpvn_mg
263
264 Like C<sv_catpvn>, but also handles 'set' magic.
265
266 =cut
267 */
268
269 void
270 Perl_sv_catpvn_mg(pTHX_ register SV *sv, register const char *ptr, register STRLEN len)
271 {
272     PERL_ARGS_ASSERT_SV_CATPVN_MG;
273
274     sv_catpvn_flags(sv,ptr,len,SV_GMAGIC|SV_SMAGIC);
275 }
276
277 /* sv_catsv() is now a macro using Perl_sv_catsv_flags();
278  * this function provided for binary compatibility only
279  */
280
281 void
282 Perl_sv_catsv(pTHX_ SV *dstr, register SV *sstr)
283 {
284     PERL_ARGS_ASSERT_SV_CATSV;
285
286     sv_catsv_flags(dstr, sstr, SV_GMAGIC);
287 }
288
289 /*
290 =for apidoc sv_catsv_mg
291
292 Like C<sv_catsv>, but also handles 'set' magic.
293
294 =cut
295 */
296
297 void
298 Perl_sv_catsv_mg(pTHX_ SV *dsv, register SV *ssv)
299 {
300     PERL_ARGS_ASSERT_SV_CATSV_MG;
301
302     sv_catsv_flags(dsv,ssv,SV_GMAGIC|SV_SMAGIC);
303 }
304
305 /*
306 =for apidoc sv_iv
307
308 A private implementation of the C<SvIVx> macro for compilers which can't
309 cope with complex macro expressions. Always use the macro instead.
310
311 =cut
312 */
313
314 IV
315 Perl_sv_iv(pTHX_ register SV *sv)
316 {
317     PERL_ARGS_ASSERT_SV_IV;
318
319     if (SvIOK(sv)) {
320         if (SvIsUV(sv))
321             return (IV)SvUVX(sv);
322         return SvIVX(sv);
323     }
324     return sv_2iv(sv);
325 }
326
327 /*
328 =for apidoc sv_uv
329
330 A private implementation of the C<SvUVx> macro for compilers which can't
331 cope with complex macro expressions. Always use the macro instead.
332
333 =cut
334 */
335
336 UV
337 Perl_sv_uv(pTHX_ register SV *sv)
338 {
339     PERL_ARGS_ASSERT_SV_UV;
340
341     if (SvIOK(sv)) {
342         if (SvIsUV(sv))
343             return SvUVX(sv);
344         return (UV)SvIVX(sv);
345     }
346     return sv_2uv(sv);
347 }
348
349 /*
350 =for apidoc sv_nv
351
352 A private implementation of the C<SvNVx> macro for compilers which can't
353 cope with complex macro expressions. Always use the macro instead.
354
355 =cut
356 */
357
358 NV
359 Perl_sv_nv(pTHX_ register SV *sv)
360 {
361     PERL_ARGS_ASSERT_SV_NV;
362
363     if (SvNOK(sv))
364         return SvNVX(sv);
365     return sv_2nv(sv);
366 }
367
368 /*
369 =for apidoc sv_pv
370
371 Use the C<SvPV_nolen> macro instead
372
373 =for apidoc sv_pvn
374
375 A private implementation of the C<SvPV> macro for compilers which can't
376 cope with complex macro expressions. Always use the macro instead.
377
378 =cut
379 */
380
381 char *
382 Perl_sv_pvn(pTHX_ SV *sv, STRLEN *lp)
383 {
384     PERL_ARGS_ASSERT_SV_PVN;
385
386     if (SvPOK(sv)) {
387         *lp = SvCUR(sv);
388         return SvPVX(sv);
389     }
390     return sv_2pv(sv, lp);
391 }
392
393
394 char *
395 Perl_sv_pvn_nomg(pTHX_ register SV *sv, STRLEN *lp)
396 {
397     PERL_ARGS_ASSERT_SV_PVN_NOMG;
398
399     if (SvPOK(sv)) {
400         *lp = SvCUR(sv);
401         return SvPVX(sv);
402     }
403     return sv_2pv_flags(sv, lp, 0);
404 }
405
406 /* sv_pv() is now a macro using SvPV_nolen();
407  * this function provided for binary compatibility only
408  */
409
410 char *
411 Perl_sv_pv(pTHX_ SV *sv)
412 {
413     PERL_ARGS_ASSERT_SV_PV;
414
415     if (SvPOK(sv))
416         return SvPVX(sv);
417
418     return sv_2pv(sv, NULL);
419 }
420
421 /* sv_pvn_force() is now a macro using Perl_sv_pvn_force_flags();
422  * this function provided for binary compatibility only
423  */
424
425 char *
426 Perl_sv_pvn_force(pTHX_ SV *sv, STRLEN *lp)
427 {
428     PERL_ARGS_ASSERT_SV_PVN_FORCE;
429
430     return sv_pvn_force_flags(sv, lp, SV_GMAGIC);
431 }
432
433 /* sv_pvbyte () is now a macro using Perl_sv_2pv_flags();
434  * this function provided for binary compatibility only
435  */
436
437 char *
438 Perl_sv_pvbyte(pTHX_ SV *sv)
439 {
440     PERL_ARGS_ASSERT_SV_PVBYTE;
441
442     sv_utf8_downgrade(sv, FALSE);
443     return sv_pv(sv);
444 }
445
446 /*
447 =for apidoc sv_pvbyte
448
449 Use C<SvPVbyte_nolen> instead.
450
451 =for apidoc sv_pvbyten
452
453 A private implementation of the C<SvPVbyte> macro for compilers
454 which can't cope with complex macro expressions. Always use the macro
455 instead.
456
457 =cut
458 */
459
460 char *
461 Perl_sv_pvbyten(pTHX_ SV *sv, STRLEN *lp)
462 {
463     PERL_ARGS_ASSERT_SV_PVBYTEN;
464
465     sv_utf8_downgrade(sv, FALSE);
466     return sv_pvn(sv,lp);
467 }
468
469 /* sv_pvutf8 () is now a macro using Perl_sv_2pv_flags();
470  * this function provided for binary compatibility only
471  */
472
473 char *
474 Perl_sv_pvutf8(pTHX_ SV *sv)
475 {
476     PERL_ARGS_ASSERT_SV_PVUTF8;
477
478     sv_utf8_upgrade(sv);
479     return sv_pv(sv);
480 }
481
482 /*
483 =for apidoc sv_pvutf8
484
485 Use the C<SvPVutf8_nolen> macro instead
486
487 =for apidoc sv_pvutf8n
488
489 A private implementation of the C<SvPVutf8> macro for compilers
490 which can't cope with complex macro expressions. Always use the macro
491 instead.
492
493 =cut
494 */
495
496 char *
497 Perl_sv_pvutf8n(pTHX_ SV *sv, STRLEN *lp)
498 {
499     PERL_ARGS_ASSERT_SV_PVUTF8N;
500
501     sv_utf8_upgrade(sv);
502     return sv_pvn(sv,lp);
503 }
504
505 /* sv_utf8_upgrade() is now a macro using sv_utf8_upgrade_flags();
506  * this function provided for binary compatibility only
507  */
508
509 STRLEN
510 Perl_sv_utf8_upgrade(pTHX_ register SV *sv)
511 {
512     PERL_ARGS_ASSERT_SV_UTF8_UPGRADE;
513
514     return sv_utf8_upgrade_flags(sv, SV_GMAGIC);
515 }
516
517 int
518 Perl_fprintf_nocontext(PerlIO *stream, const char *format, ...)
519 {
520     dTHXs;
521     va_list(arglist);
522
523     /* Easier to special case this here than in embed.pl. (Look at what it
524        generates for proto.h) */
525 #ifdef PERL_IMPLICIT_CONTEXT
526     PERL_ARGS_ASSERT_FPRINTF_NOCONTEXT;
527 #endif
528
529     va_start(arglist, format);
530     return PerlIO_vprintf(stream, format, arglist);
531 }
532
533 int
534 Perl_printf_nocontext(const char *format, ...)
535 {
536     dTHX;
537     va_list(arglist);
538
539 #ifdef PERL_IMPLICIT_CONTEXT
540     PERL_ARGS_ASSERT_PRINTF_NOCONTEXT;
541 #endif
542
543     va_start(arglist, format);
544     return PerlIO_vprintf(PerlIO_stdout(), format, arglist);
545 }
546
547 #if defined(HUGE_VAL) || (defined(USE_LONG_DOUBLE) && defined(HUGE_VALL))
548 /*
549  * This hack is to force load of "huge" support from libm.a
550  * So it is in perl for (say) POSIX to use.
551  * Needed for SunOS with Sun's 'acc' for example.
552  */
553 NV
554 Perl_huge(void)
555 {
556 #  if defined(USE_LONG_DOUBLE) && defined(HUGE_VALL)
557     return HUGE_VALL;
558 #  else
559     return HUGE_VAL;
560 #  endif
561 }
562 #endif
563
564 /* compatibility with versions <= 5.003. */
565 void
566 Perl_gv_fullname(pTHX_ SV *sv, const GV *gv)
567 {
568     PERL_ARGS_ASSERT_GV_FULLNAME;
569
570     gv_fullname3(sv, gv, sv == (const SV*)gv ? "*" : "");
571 }
572
573 /* compatibility with versions <= 5.003. */
574 void
575 Perl_gv_efullname(pTHX_ SV *sv, const GV *gv)
576 {
577     PERL_ARGS_ASSERT_GV_EFULLNAME;
578
579     gv_efullname3(sv, gv, sv == (const SV*)gv ? "*" : "");
580 }
581
582 void
583 Perl_gv_fullname3(pTHX_ SV *sv, const GV *gv, const char *prefix)
584 {
585     PERL_ARGS_ASSERT_GV_FULLNAME3;
586
587     gv_fullname4(sv, gv, prefix, TRUE);
588 }
589
590 void
591 Perl_gv_efullname3(pTHX_ SV *sv, const GV *gv, const char *prefix)
592 {
593     PERL_ARGS_ASSERT_GV_EFULLNAME3;
594
595     gv_efullname4(sv, gv, prefix, TRUE);
596 }
597
598 /*
599 =for apidoc gv_fetchmethod
600
601 See L<gv_fetchmethod_autoload>.
602
603 =cut
604 */
605
606 GV *
607 Perl_gv_fetchmethod(pTHX_ HV *stash, const char *name)
608 {
609     PERL_ARGS_ASSERT_GV_FETCHMETHOD;
610
611     return gv_fetchmethod_autoload(stash, name, TRUE);
612 }
613
614 HE *
615 Perl_hv_iternext(pTHX_ HV *hv)
616 {
617     PERL_ARGS_ASSERT_HV_ITERNEXT;
618
619     return hv_iternext_flags(hv, 0);
620 }
621
622 void
623 Perl_hv_magic(pTHX_ HV *hv, GV *gv, int how)
624 {
625     PERL_ARGS_ASSERT_HV_MAGIC;
626
627     sv_magic(MUTABLE_SV(hv), MUTABLE_SV(gv), how, NULL, 0);
628 }
629
630 bool
631 Perl_do_open(pTHX_ GV *gv, register const char *name, I32 len, int as_raw,
632              int rawmode, int rawperm, PerlIO *supplied_fp)
633 {
634     PERL_ARGS_ASSERT_DO_OPEN;
635
636     return do_openn(gv, name, len, as_raw, rawmode, rawperm,
637                     supplied_fp, (SV **) NULL, 0);
638 }
639
640 bool
641 Perl_do_open9(pTHX_ GV *gv, register const char *name, I32 len, int 
642 as_raw,
643               int rawmode, int rawperm, PerlIO *supplied_fp, SV *svs,
644               I32 num_svs)
645 {
646     PERL_ARGS_ASSERT_DO_OPEN9;
647
648     PERL_UNUSED_ARG(num_svs);
649     return do_openn(gv, name, len, as_raw, rawmode, rawperm,
650                     supplied_fp, &svs, 1);
651 }
652
653 int
654 Perl_do_binmode(pTHX_ PerlIO *fp, int iotype, int mode)
655 {
656  /* The old body of this is now in non-LAYER part of perlio.c
657   * This is a stub for any XS code which might have been calling it.
658   */
659  const char *name = ":raw";
660
661  PERL_ARGS_ASSERT_DO_BINMODE;
662
663 #ifdef PERLIO_USING_CRLF
664  if (!(mode & O_BINARY))
665      name = ":crlf";
666 #endif
667  return PerlIO_binmode(aTHX_ fp, iotype, mode, name);
668 }
669
670 #ifndef OS2
671 bool
672 Perl_do_aexec(pTHX_ SV *really, register SV **mark, register SV **sp)
673 {
674     PERL_ARGS_ASSERT_DO_AEXEC;
675
676     return do_aexec5(really, mark, sp, 0, 0);
677 }
678 #endif
679
680 #ifdef PERL_DEFAULT_DO_EXEC3_IMPLEMENTATION
681 bool
682 Perl_do_exec(pTHX_ const char *cmd)
683 {
684     PERL_ARGS_ASSERT_DO_EXEC;
685
686     return do_exec3(cmd,0,0);
687 }
688 #endif
689
690 /* Backwards compatibility. */
691 int
692 Perl_init_i18nl14n(pTHX_ int printwarn)
693 {
694     return init_i18nl10n(printwarn);
695 }
696
697 PP(pp_padany)
698 {
699     DIE(aTHX_ "NOT IMPL LINE %d",__LINE__);
700 }
701
702 PP(pp_mapstart)
703 {
704     DIE(aTHX_ "panic: mapstart");       /* uses grepstart */
705 }
706
707 /* These ops all have the same body as pp_null.  */
708 PP(pp_scalar)
709 {
710     dVAR;
711     return NORMAL;
712 }
713
714 PP(pp_regcmaybe)
715 {
716     dVAR;
717     return NORMAL;
718 }
719
720 PP(pp_lineseq)
721 {
722     dVAR;
723     return NORMAL;
724 }
725
726 PP(pp_scope)
727 {
728     dVAR;
729     return NORMAL;
730 }
731
732 /* Ops that are calls to do_kv.  */
733 PP(pp_values)
734 {
735     return do_kv();
736 }
737
738 PP(pp_keys)
739 {
740     return do_kv();
741 }
742
743 /* Ops that are simply calls to other ops.  */
744 PP(pp_dump)
745 {
746     return pp_goto();
747     /*NOTREACHED*/
748 }
749
750 PP(pp_dofile)
751 {
752     return pp_require();
753 }
754
755 PP(pp_dbmclose)
756 {
757     return pp_untie();
758 }
759
760 PP(pp_read)
761 {
762     return pp_sysread();
763 }
764
765 PP(pp_recv)
766 {
767     return pp_sysread();
768 }
769
770 PP(pp_seek)
771 {
772     return pp_sysseek();
773 }
774
775 PP(pp_fcntl)
776 {
777     return pp_ioctl();
778 }
779
780 PP(pp_gsockopt)
781 {
782     return pp_ssockopt();
783 }
784
785 PP(pp_getsockname)
786 {
787     return pp_getpeername();
788 }
789
790 PP(pp_lstat)
791 {
792     return pp_stat();
793 }
794
795 PP(pp_fteowned)
796 {
797     return pp_ftrowned();
798 }
799
800 PP(pp_ftbinary)
801 {
802     return pp_fttext();
803 }
804
805 PP(pp_localtime)
806 {
807     return pp_gmtime();
808 }
809
810 PP(pp_shmget)
811 {
812     return pp_semget();
813 }
814
815 PP(pp_shmctl)
816 {
817     return pp_semctl();
818 }
819
820 PP(pp_shmread)
821 {
822     return pp_shmwrite();
823 }
824
825 PP(pp_msgget)
826 {
827     return pp_semget();
828 }
829
830 PP(pp_msgctl)
831 {
832     return pp_semctl();
833 }
834
835 PP(pp_ghbyname)
836 {
837     return pp_ghostent();
838 }
839
840 PP(pp_ghbyaddr)
841 {
842     return pp_ghostent();
843 }
844
845 PP(pp_gnbyname)
846 {
847     return pp_gnetent();
848 }
849
850 PP(pp_gnbyaddr)
851 {
852     return pp_gnetent();
853 }
854
855 PP(pp_gpbyname)
856 {
857     return pp_gprotoent();
858 }
859
860 PP(pp_gpbynumber)
861 {
862     return pp_gprotoent();
863 }
864
865 PP(pp_gsbyname)
866 {
867     return pp_gservent();
868 }
869
870 PP(pp_gsbyport)
871 {
872     return pp_gservent();
873 }
874
875 PP(pp_gpwnam)
876 {
877     return pp_gpwent();
878 }
879
880 PP(pp_gpwuid)
881 {
882     return pp_gpwent();
883 }
884
885 PP(pp_ggrnam)
886 {
887     return pp_ggrent();
888 }
889
890 PP(pp_ggrgid)
891 {
892     return pp_ggrent();
893 }
894
895 PP(pp_ftsize)
896 {
897     return pp_ftis();
898 }
899
900 PP(pp_ftmtime)
901 {
902     return pp_ftis();
903 }
904
905 PP(pp_ftatime)
906 {
907     return pp_ftis();
908 }
909
910 PP(pp_ftctime)
911 {
912     return pp_ftis();
913 }
914
915 PP(pp_ftzero)
916 {
917     return pp_ftrowned();
918 }
919
920 PP(pp_ftsock)
921 {
922     return pp_ftrowned();
923 }
924
925 PP(pp_ftchr)
926 {
927     return pp_ftrowned();
928 }
929
930 PP(pp_ftblk)
931 {
932     return pp_ftrowned();
933 }
934
935 PP(pp_ftfile)
936 {
937     return pp_ftrowned();
938 }
939
940 PP(pp_ftdir)
941 {
942     return pp_ftrowned();
943 }
944
945 PP(pp_ftpipe)
946 {
947     return pp_ftrowned();
948 }
949
950 PP(pp_ftsuid)
951 {
952     return pp_ftrowned();
953 }
954
955 PP(pp_ftsgid)
956 {
957     return pp_ftrowned();
958 }
959
960 PP(pp_ftsvtx)
961 {
962     return pp_ftrowned();
963 }
964
965 PP(pp_unlink)
966 {
967     return pp_chown();
968 }
969
970 PP(pp_chmod)
971 {
972     return pp_chown();
973 }
974
975 PP(pp_utime)
976 {
977     return pp_chown();
978 }
979
980 PP(pp_kill)
981 {
982     return pp_chown();
983 }
984
985 PP(pp_symlink)
986 {
987     return pp_link();
988 }
989
990 PP(pp_ftrwrite)
991 {
992     return pp_ftrread();
993 }
994
995 PP(pp_ftrexec)
996 {
997     return pp_ftrread();
998 }
999
1000 PP(pp_fteread)
1001 {
1002     return pp_ftrread();
1003 }
1004
1005 PP(pp_ftewrite)
1006 {
1007     return pp_ftrread();
1008 }
1009
1010 PP(pp_fteexec)
1011 {
1012     return pp_ftrread();
1013 }
1014
1015 PP(pp_msgsnd)
1016 {
1017     return pp_shmwrite();
1018 }
1019
1020 PP(pp_msgrcv)
1021 {
1022     return pp_shmwrite();
1023 }
1024
1025 PP(pp_syswrite)
1026 {
1027     return pp_send();
1028 }
1029
1030 PP(pp_semop)
1031 {
1032     return pp_shmwrite();
1033 }
1034
1035 PP(pp_dor)
1036 {
1037     return pp_defined();
1038 }
1039
1040 PP(pp_andassign)
1041 {
1042     return pp_and();
1043 }
1044
1045 PP(pp_orassign)
1046 {
1047     return pp_or();
1048 }
1049
1050 PP(pp_dorassign)
1051 {
1052     return pp_defined();
1053
1054
1055 PP(pp_lcfirst)
1056 {
1057     return pp_ucfirst();
1058 }
1059
1060 PP(pp_slt)
1061 {
1062     return pp_sle();
1063 }
1064
1065 PP(pp_sgt)
1066 {
1067     return pp_sle();
1068 }
1069
1070 PP(pp_sge)
1071 {
1072     return pp_sle();
1073 }
1074
1075 PP(pp_rindex)
1076 {
1077     return pp_index();
1078 }
1079
1080 PP(pp_hex)
1081 {
1082     return pp_oct();
1083 }
1084
1085 PP(pp_pop)
1086 {
1087     return pp_shift();
1088 }
1089
1090 PP(pp_cos)
1091 {
1092     return pp_sin();
1093 }
1094
1095 PP(pp_exp)
1096 {
1097     return pp_sin();
1098 }
1099
1100 PP(pp_log)
1101 {
1102     return pp_sin();
1103 }
1104
1105 PP(pp_sqrt)
1106 {
1107     return pp_sin();
1108 }
1109
1110 PP(pp_bit_xor)
1111 {
1112     return pp_bit_or();
1113 }
1114
1115 PP(pp_rv2hv)
1116 {
1117     return Perl_pp_rv2av(aTHX);
1118 }
1119
1120 U8 *
1121 Perl_uvuni_to_utf8(pTHX_ U8 *d, UV uv)
1122 {
1123     PERL_ARGS_ASSERT_UVUNI_TO_UTF8;
1124
1125     return Perl_uvuni_to_utf8_flags(aTHX_ d, uv, 0);
1126 }
1127
1128 bool
1129 Perl_is_utf8_string_loc(pTHX_ const U8 *s, STRLEN len, const U8 **ep)
1130 {
1131     PERL_ARGS_ASSERT_IS_UTF8_STRING_LOC;
1132
1133     return is_utf8_string_loclen(s, len, ep, 0);
1134 }
1135
1136 /*
1137 =for apidoc sv_nolocking
1138
1139 Dummy routine which "locks" an SV when there is no locking module present.
1140 Exists to avoid test for a NULL function pointer and because it could
1141 potentially warn under some level of strict-ness.
1142
1143 "Superseded" by sv_nosharing().
1144
1145 =cut
1146 */
1147
1148 void
1149 Perl_sv_nolocking(pTHX_ SV *sv)
1150 {
1151     PERL_UNUSED_CONTEXT;
1152     PERL_UNUSED_ARG(sv);
1153 }
1154
1155
1156 /*
1157 =for apidoc sv_nounlocking
1158
1159 Dummy routine which "unlocks" an SV when there is no locking module present.
1160 Exists to avoid test for a NULL function pointer and because it could
1161 potentially warn under some level of strict-ness.
1162
1163 "Superseded" by sv_nosharing().
1164
1165 =cut
1166 */
1167
1168 void
1169 Perl_sv_nounlocking(pTHX_ SV *sv)
1170 {
1171     PERL_UNUSED_CONTEXT;
1172     PERL_UNUSED_ARG(sv);
1173 }
1174
1175 void
1176 Perl_save_long(pTHX_ long int *longp)
1177 {
1178     dVAR;
1179
1180     PERL_ARGS_ASSERT_SAVE_LONG;
1181
1182     SSCHECK(3);
1183     SSPUSHLONG(*longp);
1184     SSPUSHPTR(longp);
1185     SSPUSHUV(SAVEt_LONG);
1186 }
1187
1188 void
1189 Perl_save_iv(pTHX_ IV *ivp)
1190 {
1191     dVAR;
1192
1193     PERL_ARGS_ASSERT_SAVE_IV;
1194
1195     SSCHECK(3);
1196     SSPUSHIV(*ivp);
1197     SSPUSHPTR(ivp);
1198     SSPUSHUV(SAVEt_IV);
1199 }
1200
1201 void
1202 Perl_save_nogv(pTHX_ GV *gv)
1203 {
1204     dVAR;
1205
1206     PERL_ARGS_ASSERT_SAVE_NOGV;
1207
1208     SSCHECK(2);
1209     SSPUSHPTR(gv);
1210     SSPUSHUV(SAVEt_NSTAB);
1211 }
1212
1213 void
1214 Perl_save_list(pTHX_ register SV **sarg, I32 maxsarg)
1215 {
1216     dVAR;
1217     register I32 i;
1218
1219     PERL_ARGS_ASSERT_SAVE_LIST;
1220
1221     for (i = 1; i <= maxsarg; i++) {
1222         register SV * const sv = newSV(0);
1223         sv_setsv(sv,sarg[i]);
1224         SSCHECK(3);
1225         SSPUSHPTR(sarg[i]);             /* remember the pointer */
1226         SSPUSHPTR(sv);                  /* remember the value */
1227         SSPUSHUV(SAVEt_ITEM);
1228     }
1229 }
1230
1231 /*
1232 =for apidoc sv_usepvn_mg
1233
1234 Like C<sv_usepvn>, but also handles 'set' magic.
1235
1236 =cut
1237 */
1238
1239 void
1240 Perl_sv_usepvn_mg(pTHX_ SV *sv, char *ptr, STRLEN len)
1241 {
1242     PERL_ARGS_ASSERT_SV_USEPVN_MG;
1243
1244     sv_usepvn_flags(sv,ptr,len, SV_SMAGIC);
1245 }
1246
1247 /*
1248 =for apidoc sv_usepvn
1249
1250 Tells an SV to use C<ptr> to find its string value. Implemented by
1251 calling C<sv_usepvn_flags> with C<flags> of 0, hence does not handle 'set'
1252 magic. See C<sv_usepvn_flags>.
1253
1254 =cut
1255 */
1256
1257 void
1258 Perl_sv_usepvn(pTHX_ SV *sv, char *ptr, STRLEN len)
1259 {
1260     PERL_ARGS_ASSERT_SV_USEPVN;
1261
1262     sv_usepvn_flags(sv,ptr,len, 0);
1263 }
1264
1265 /*
1266 =for apidoc unpack_str
1267
1268 The engine implementing unpack() Perl function. Note: parameters strbeg, new_s
1269 and ocnt are not used. This call should not be used, use unpackstring instead.
1270
1271 =cut */
1272
1273 I32
1274 Perl_unpack_str(pTHX_ const char *pat, const char *patend, const char *s,
1275                 const char *strbeg, const char *strend, char **new_s, I32 ocnt,
1276                 U32 flags)
1277 {
1278     PERL_ARGS_ASSERT_UNPACK_STR;
1279
1280     PERL_UNUSED_ARG(strbeg);
1281     PERL_UNUSED_ARG(new_s);
1282     PERL_UNUSED_ARG(ocnt);
1283
1284     return unpackstring(pat, patend, s, strend, flags);
1285 }
1286
1287 /*
1288 =for apidoc pack_cat
1289
1290 The engine implementing pack() Perl function. Note: parameters next_in_list and
1291 flags are not used. This call should not be used; use packlist instead.
1292
1293 =cut
1294 */
1295
1296 void
1297 Perl_pack_cat(pTHX_ SV *cat, const char *pat, const char *patend, register SV **beglist, SV **endlist, SV ***next_in_list, U32 flags)
1298 {
1299     PERL_ARGS_ASSERT_PACK_CAT;
1300
1301     PERL_UNUSED_ARG(next_in_list);
1302     PERL_UNUSED_ARG(flags);
1303
1304     packlist(cat, pat, patend, beglist, endlist);
1305 }
1306
1307 HE *
1308 Perl_hv_store_ent(pTHX_ HV *hv, SV *keysv, SV *val, U32 hash)
1309 {
1310   return (HE *)hv_common(hv, keysv, NULL, 0, 0, HV_FETCH_ISSTORE, val, hash);
1311 }
1312
1313 bool
1314 Perl_hv_exists_ent(pTHX_ HV *hv, SV *keysv, U32 hash)
1315 {
1316     PERL_ARGS_ASSERT_HV_EXISTS_ENT;
1317
1318     return hv_common(hv, keysv, NULL, 0, 0, HV_FETCH_ISEXISTS, 0, hash)
1319         ? TRUE : FALSE;
1320 }
1321
1322 HE *
1323 Perl_hv_fetch_ent(pTHX_ HV *hv, SV *keysv, I32 lval, U32 hash)
1324 {
1325     PERL_ARGS_ASSERT_HV_FETCH_ENT;
1326
1327     return (HE *)hv_common(hv, keysv, NULL, 0, 0, 
1328                      (lval ? HV_FETCH_LVALUE : 0), NULL, hash);
1329 }
1330
1331 SV *
1332 Perl_hv_delete_ent(pTHX_ HV *hv, SV *keysv, I32 flags, U32 hash)
1333 {
1334     PERL_ARGS_ASSERT_HV_DELETE_ENT;
1335
1336     return MUTABLE_SV(hv_common(hv, keysv, NULL, 0, 0, flags | HV_DELETE, NULL,
1337                                 hash));
1338 }
1339
1340 SV**
1341 Perl_hv_store_flags(pTHX_ HV *hv, const char *key, I32 klen, SV *val, U32 hash,
1342                     int flags)
1343 {
1344     return (SV**) hv_common(hv, NULL, key, klen, flags,
1345                             (HV_FETCH_ISSTORE|HV_FETCH_JUST_SV), val, hash);
1346 }
1347
1348 SV**
1349 Perl_hv_store(pTHX_ HV *hv, const char *key, I32 klen_i32, SV *val, U32 hash)
1350 {
1351     STRLEN klen;
1352     int flags;
1353
1354     if (klen_i32 < 0) {
1355         klen = -klen_i32;
1356         flags = HVhek_UTF8;
1357     } else {
1358         klen = klen_i32;
1359         flags = 0;
1360     }
1361     return (SV **) hv_common(hv, NULL, key, klen, flags,
1362                              (HV_FETCH_ISSTORE|HV_FETCH_JUST_SV), val, hash);
1363 }
1364
1365 bool
1366 Perl_hv_exists(pTHX_ HV *hv, const char *key, I32 klen_i32)
1367 {
1368     STRLEN klen;
1369     int flags;
1370
1371     PERL_ARGS_ASSERT_HV_EXISTS;
1372
1373     if (klen_i32 < 0) {
1374         klen = -klen_i32;
1375         flags = HVhek_UTF8;
1376     } else {
1377         klen = klen_i32;
1378         flags = 0;
1379     }
1380     return hv_common(hv, NULL, key, klen, flags, HV_FETCH_ISEXISTS, 0, 0)
1381         ? TRUE : FALSE;
1382 }
1383
1384 SV**
1385 Perl_hv_fetch(pTHX_ HV *hv, const char *key, I32 klen_i32, I32 lval)
1386 {
1387     STRLEN klen;
1388     int flags;
1389
1390     PERL_ARGS_ASSERT_HV_FETCH;
1391
1392     if (klen_i32 < 0) {
1393         klen = -klen_i32;
1394         flags = HVhek_UTF8;
1395     } else {
1396         klen = klen_i32;
1397         flags = 0;
1398     }
1399     return (SV **) hv_common(hv, NULL, key, klen, flags,
1400                              lval ? (HV_FETCH_JUST_SV | HV_FETCH_LVALUE)
1401                              : HV_FETCH_JUST_SV, NULL, 0);
1402 }
1403
1404 SV *
1405 Perl_hv_delete(pTHX_ HV *hv, const char *key, I32 klen_i32, I32 flags)
1406 {
1407     STRLEN klen;
1408     int k_flags;
1409
1410     PERL_ARGS_ASSERT_HV_DELETE;
1411
1412     if (klen_i32 < 0) {
1413         klen = -klen_i32;
1414         k_flags = HVhek_UTF8;
1415     } else {
1416         klen = klen_i32;
1417         k_flags = 0;
1418     }
1419     return MUTABLE_SV(hv_common(hv, NULL, key, klen, k_flags, flags | HV_DELETE,
1420                                 NULL, 0));
1421 }
1422
1423 /* Functions after here were made mathoms post 5.10.0 but pre 5.8.9 */
1424
1425 AV *
1426 Perl_newAV(pTHX)
1427 {
1428     return MUTABLE_AV(newSV_type(SVt_PVAV));
1429     /* sv_upgrade does AvREAL_only():
1430     AvALLOC(av) = 0;
1431     AvARRAY(av) = NULL;
1432     AvMAX(av) = AvFILLp(av) = -1; */
1433 }
1434
1435 HV *
1436 Perl_newHV(pTHX)
1437 {
1438     HV * const hv = MUTABLE_HV(newSV_type(SVt_PVHV));
1439     assert(!SvOK(hv));
1440
1441     return hv;
1442 }
1443
1444 void
1445 Perl_sv_insert(pTHX_ SV *const bigstr, const STRLEN offset, const STRLEN len, 
1446               const char *const little, const STRLEN littlelen)
1447 {
1448     PERL_ARGS_ASSERT_SV_INSERT;
1449     sv_insert_flags(bigstr, offset, len, little, littlelen, SV_GMAGIC);
1450 }
1451
1452 void
1453 Perl_save_freesv(pTHX_ SV *sv)
1454 {
1455     dVAR;
1456     save_freesv(sv);
1457 }
1458
1459 void
1460 Perl_save_mortalizesv(pTHX_ SV *sv)
1461 {
1462     dVAR;
1463
1464     PERL_ARGS_ASSERT_SAVE_MORTALIZESV;
1465
1466     save_mortalizesv(sv);
1467 }
1468
1469 void
1470 Perl_save_freeop(pTHX_ OP *o)
1471 {
1472     dVAR;
1473     save_freeop(o);
1474 }
1475
1476 void
1477 Perl_save_freepv(pTHX_ char *pv)
1478 {
1479     dVAR;
1480     save_freepv(pv);
1481 }
1482
1483 void
1484 Perl_save_op(pTHX)
1485 {
1486     dVAR;
1487     save_op();
1488 }
1489
1490 #ifdef PERL_DONT_CREATE_GVSV
1491 GV *
1492 Perl_gv_SVadd(pTHX_ GV *gv)
1493 {
1494     return gv_SVadd(gv);
1495 }
1496 #endif
1497
1498 GV *
1499 Perl_gv_AVadd(pTHX_ GV *gv)
1500 {
1501     return gv_AVadd(gv);
1502 }
1503
1504 GV *
1505 Perl_gv_HVadd(pTHX_ register GV *gv)
1506 {
1507     return gv_HVadd(gv);
1508 }
1509
1510 GV *
1511 Perl_gv_IOadd(pTHX_ register GV *gv)
1512 {
1513     return gv_IOadd(gv);
1514 }
1515
1516 IO *
1517 Perl_newIO(pTHX)
1518 {
1519     return MUTABLE_IO(newSV_type(SVt_PVIO));
1520 }
1521
1522 #endif /* NO_MATHOMS */
1523
1524 /*
1525  * Local variables:
1526  * c-indentation-style: bsd
1527  * c-basic-offset: 4
1528  * indent-tabs-mode: t
1529  * End:
1530  *
1531  * ex: set ts=8 sts=4 sw=4 noet:
1532  */