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