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