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