Updated Module::CoreList for 5.10.1-RC2
[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 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 AV *
617 Perl_av_fake(pTHX_ register I32 size, register SV **strp)
618 {
619     register SV** ary;
620     register AV * const av = MUTABLE_AV(newSV_type(SVt_PVAV));
621
622     PERL_ARGS_ASSERT_AV_FAKE;
623
624     Newx(ary,size+1,SV*);
625     AvALLOC(av) = ary;
626     Copy(strp,ary,size,SV*);
627     AvREIFY_only(av);
628     AvARRAY(av) = ary;
629     AvFILLp(av) = size - 1;
630     AvMAX(av) = size - 1;
631     while (size--) {
632         assert (*strp);
633         SvTEMP_off(*strp);
634         strp++;
635     }
636     return av;
637 }
638
639 bool
640 Perl_do_open(pTHX_ GV *gv, register const char *name, I32 len, int as_raw,
641              int rawmode, int rawperm, PerlIO *supplied_fp)
642 {
643     PERL_ARGS_ASSERT_DO_OPEN;
644
645     return do_openn(gv, name, len, as_raw, rawmode, rawperm,
646                     supplied_fp, (SV **) NULL, 0);
647 }
648
649 bool
650 Perl_do_open9(pTHX_ GV *gv, register const char *name, I32 len, int 
651 as_raw,
652               int rawmode, int rawperm, PerlIO *supplied_fp, SV *svs,
653               I32 num_svs)
654 {
655     PERL_ARGS_ASSERT_DO_OPEN9;
656
657     PERL_UNUSED_ARG(num_svs);
658     return do_openn(gv, name, len, as_raw, rawmode, rawperm,
659                     supplied_fp, &svs, 1);
660 }
661
662 int
663 Perl_do_binmode(pTHX_ PerlIO *fp, int iotype, int mode)
664 {
665  /* The old body of this is now in non-LAYER part of perlio.c
666   * This is a stub for any XS code which might have been calling it.
667   */
668  const char *name = ":raw";
669
670  PERL_ARGS_ASSERT_DO_BINMODE;
671
672 #ifdef PERLIO_USING_CRLF
673  if (!(mode & O_BINARY))
674      name = ":crlf";
675 #endif
676  return PerlIO_binmode(aTHX_ fp, iotype, mode, name);
677 }
678
679 #ifndef OS2
680 bool
681 Perl_do_aexec(pTHX_ SV *really, register SV **mark, register SV **sp)
682 {
683     PERL_ARGS_ASSERT_DO_AEXEC;
684
685     return do_aexec5(really, mark, sp, 0, 0);
686 }
687 #endif
688
689 #ifdef PERL_DEFAULT_DO_EXEC3_IMPLEMENTATION
690 bool
691 Perl_do_exec(pTHX_ const char *cmd)
692 {
693     PERL_ARGS_ASSERT_DO_EXEC;
694
695     return do_exec3(cmd,0,0);
696 }
697 #endif
698
699 /* Backwards compatibility. */
700 int
701 Perl_init_i18nl14n(pTHX_ int printwarn)
702 {
703     return init_i18nl10n(printwarn);
704 }
705
706 OP *
707 Perl_oopsCV(pTHX_ OP *o)
708 {
709     PERL_ARGS_ASSERT_OOPSCV;
710
711     Perl_croak(aTHX_ "NOT IMPL LINE %d",__LINE__);
712     /* STUB */
713     PERL_UNUSED_ARG(o);
714     NORETURN_FUNCTION_END;
715 }
716
717 PP(pp_padany)
718 {
719     DIE(aTHX_ "NOT IMPL LINE %d",__LINE__);
720 }
721
722 PP(pp_mapstart)
723 {
724     DIE(aTHX_ "panic: mapstart");       /* uses grepstart */
725 }
726
727 /* These ops all have the same body as pp_null.  */
728 PP(pp_scalar)
729 {
730     dVAR;
731     return NORMAL;
732 }
733
734 PP(pp_regcmaybe)
735 {
736     dVAR;
737     return NORMAL;
738 }
739
740 PP(pp_lineseq)
741 {
742     dVAR;
743     return NORMAL;
744 }
745
746 PP(pp_scope)
747 {
748     dVAR;
749     return NORMAL;
750 }
751
752 /* Ops that are calls to do_kv.  */
753 PP(pp_values)
754 {
755     return do_kv();
756 }
757
758 PP(pp_keys)
759 {
760     return do_kv();
761 }
762
763 /* Ops that are simply calls to other ops.  */
764 PP(pp_dump)
765 {
766     return pp_goto();
767     /*NOTREACHED*/
768 }
769
770 PP(pp_dofile)
771 {
772     return pp_require();
773 }
774
775 PP(pp_dbmclose)
776 {
777     return pp_untie();
778 }
779
780 PP(pp_read)
781 {
782     return pp_sysread();
783 }
784
785 PP(pp_recv)
786 {
787     return pp_sysread();
788 }
789
790 PP(pp_seek)
791 {
792     return pp_sysseek();
793 }
794
795 PP(pp_fcntl)
796 {
797     return pp_ioctl();
798 }
799
800 PP(pp_gsockopt)
801 {
802     return pp_ssockopt();
803 }
804
805 PP(pp_getsockname)
806 {
807     return pp_getpeername();
808 }
809
810 PP(pp_lstat)
811 {
812     return pp_stat();
813 }
814
815 PP(pp_fteowned)
816 {
817     return pp_ftrowned();
818 }
819
820 PP(pp_ftbinary)
821 {
822     return pp_fttext();
823 }
824
825 PP(pp_localtime)
826 {
827     return pp_gmtime();
828 }
829
830 PP(pp_shmget)
831 {
832     return pp_semget();
833 }
834
835 PP(pp_shmctl)
836 {
837     return pp_semctl();
838 }
839
840 PP(pp_shmread)
841 {
842     return pp_shmwrite();
843 }
844
845 PP(pp_msgget)
846 {
847     return pp_semget();
848 }
849
850 PP(pp_msgctl)
851 {
852     return pp_semctl();
853 }
854
855 PP(pp_ghbyname)
856 {
857     return pp_ghostent();
858 }
859
860 PP(pp_ghbyaddr)
861 {
862     return pp_ghostent();
863 }
864
865 PP(pp_gnbyname)
866 {
867     return pp_gnetent();
868 }
869
870 PP(pp_gnbyaddr)
871 {
872     return pp_gnetent();
873 }
874
875 PP(pp_gpbyname)
876 {
877     return pp_gprotoent();
878 }
879
880 PP(pp_gpbynumber)
881 {
882     return pp_gprotoent();
883 }
884
885 PP(pp_gsbyname)
886 {
887     return pp_gservent();
888 }
889
890 PP(pp_gsbyport)
891 {
892     return pp_gservent();
893 }
894
895 PP(pp_gpwnam)
896 {
897     return pp_gpwent();
898 }
899
900 PP(pp_gpwuid)
901 {
902     return pp_gpwent();
903 }
904
905 PP(pp_ggrnam)
906 {
907     return pp_ggrent();
908 }
909
910 PP(pp_ggrgid)
911 {
912     return pp_ggrent();
913 }
914
915 PP(pp_ftsize)
916 {
917     return pp_ftis();
918 }
919
920 PP(pp_ftmtime)
921 {
922     return pp_ftis();
923 }
924
925 PP(pp_ftatime)
926 {
927     return pp_ftis();
928 }
929
930 PP(pp_ftctime)
931 {
932     return pp_ftis();
933 }
934
935 PP(pp_ftzero)
936 {
937     return pp_ftrowned();
938 }
939
940 PP(pp_ftsock)
941 {
942     return pp_ftrowned();
943 }
944
945 PP(pp_ftchr)
946 {
947     return pp_ftrowned();
948 }
949
950 PP(pp_ftblk)
951 {
952     return pp_ftrowned();
953 }
954
955 PP(pp_ftfile)
956 {
957     return pp_ftrowned();
958 }
959
960 PP(pp_ftdir)
961 {
962     return pp_ftrowned();
963 }
964
965 PP(pp_ftpipe)
966 {
967     return pp_ftrowned();
968 }
969
970 PP(pp_ftsuid)
971 {
972     return pp_ftrowned();
973 }
974
975 PP(pp_ftsgid)
976 {
977     return pp_ftrowned();
978 }
979
980 PP(pp_ftsvtx)
981 {
982     return pp_ftrowned();
983 }
984
985 PP(pp_unlink)
986 {
987     return pp_chown();
988 }
989
990 PP(pp_chmod)
991 {
992     return pp_chown();
993 }
994
995 PP(pp_utime)
996 {
997     return pp_chown();
998 }
999
1000 PP(pp_kill)
1001 {
1002     return pp_chown();
1003 }
1004
1005 PP(pp_symlink)
1006 {
1007     return pp_link();
1008 }
1009
1010 PP(pp_ftrwrite)
1011 {
1012     return pp_ftrread();
1013 }
1014
1015 PP(pp_ftrexec)
1016 {
1017     return pp_ftrread();
1018 }
1019
1020 PP(pp_fteread)
1021 {
1022     return pp_ftrread();
1023 }
1024
1025 PP(pp_ftewrite)
1026 {
1027     return pp_ftrread();
1028 }
1029
1030 PP(pp_fteexec)
1031 {
1032     return pp_ftrread();
1033 }
1034
1035 PP(pp_msgsnd)
1036 {
1037     return pp_shmwrite();
1038 }
1039
1040 PP(pp_msgrcv)
1041 {
1042     return pp_shmwrite();
1043 }
1044
1045 PP(pp_syswrite)
1046 {
1047     return pp_send();
1048 }
1049
1050 PP(pp_semop)
1051 {
1052     return pp_shmwrite();
1053 }
1054
1055 PP(pp_dor)
1056 {
1057     return pp_defined();
1058 }
1059
1060 PP(pp_andassign)
1061 {
1062     return pp_and();
1063 }
1064
1065 PP(pp_orassign)
1066 {
1067     return pp_or();
1068 }
1069
1070 PP(pp_dorassign)
1071 {
1072     return pp_defined();
1073
1074
1075 PP(pp_lcfirst)
1076 {
1077     return pp_ucfirst();
1078 }
1079
1080 PP(pp_slt)
1081 {
1082     return pp_sle();
1083 }
1084
1085 PP(pp_sgt)
1086 {
1087     return pp_sle();
1088 }
1089
1090 PP(pp_sge)
1091 {
1092     return pp_sle();
1093 }
1094
1095 PP(pp_rindex)
1096 {
1097     return pp_index();
1098 }
1099
1100 PP(pp_hex)
1101 {
1102     return pp_oct();
1103 }
1104
1105 PP(pp_pop)
1106 {
1107     return pp_shift();
1108 }
1109
1110 PP(pp_cos)
1111 {
1112     return pp_sin();
1113 }
1114
1115 PP(pp_exp)
1116 {
1117     return pp_sin();
1118 }
1119
1120 PP(pp_log)
1121 {
1122     return pp_sin();
1123 }
1124
1125 PP(pp_sqrt)
1126 {
1127     return pp_sin();
1128 }
1129
1130 PP(pp_bit_xor)
1131 {
1132     return pp_bit_or();
1133 }
1134
1135 PP(pp_rv2hv)
1136 {
1137     return Perl_pp_rv2av(aTHX);
1138 }
1139
1140 U8 *
1141 Perl_uvuni_to_utf8(pTHX_ U8 *d, UV uv)
1142 {
1143     PERL_ARGS_ASSERT_UVUNI_TO_UTF8;
1144
1145     return Perl_uvuni_to_utf8_flags(aTHX_ d, uv, 0);
1146 }
1147
1148 bool
1149 Perl_is_utf8_string_loc(pTHX_ const U8 *s, STRLEN len, const U8 **ep)
1150 {
1151     PERL_ARGS_ASSERT_IS_UTF8_STRING_LOC;
1152
1153     return is_utf8_string_loclen(s, len, ep, 0);
1154 }
1155
1156 /*
1157 =for apidoc sv_nolocking
1158
1159 Dummy routine which "locks" 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_nolocking(pTHX_ SV *sv)
1170 {
1171     PERL_UNUSED_CONTEXT;
1172     PERL_UNUSED_ARG(sv);
1173 }
1174
1175
1176 /*
1177 =for apidoc sv_nounlocking
1178
1179 Dummy routine which "unlocks" an SV when there is no locking module present.
1180 Exists to avoid test for a NULL function pointer and because it could
1181 potentially warn under some level of strict-ness.
1182
1183 "Superseded" by sv_nosharing().
1184
1185 =cut
1186 */
1187
1188 void
1189 Perl_sv_nounlocking(pTHX_ SV *sv)
1190 {
1191     PERL_UNUSED_CONTEXT;
1192     PERL_UNUSED_ARG(sv);
1193 }
1194
1195 void
1196 Perl_save_long(pTHX_ long int *longp)
1197 {
1198     dVAR;
1199
1200     PERL_ARGS_ASSERT_SAVE_LONG;
1201
1202     SSCHECK(3);
1203     SSPUSHLONG(*longp);
1204     SSPUSHPTR(longp);
1205     SSPUSHINT(SAVEt_LONG);
1206 }
1207
1208 void
1209 Perl_save_iv(pTHX_ IV *ivp)
1210 {
1211     dVAR;
1212
1213     PERL_ARGS_ASSERT_SAVE_IV;
1214
1215     SSCHECK(3);
1216     SSPUSHIV(*ivp);
1217     SSPUSHPTR(ivp);
1218     SSPUSHINT(SAVEt_IV);
1219 }
1220
1221 void
1222 Perl_save_nogv(pTHX_ GV *gv)
1223 {
1224     dVAR;
1225
1226     PERL_ARGS_ASSERT_SAVE_NOGV;
1227
1228     SSCHECK(2);
1229     SSPUSHPTR(gv);
1230     SSPUSHINT(SAVEt_NSTAB);
1231 }
1232
1233 void
1234 Perl_save_list(pTHX_ register SV **sarg, I32 maxsarg)
1235 {
1236     dVAR;
1237     register I32 i;
1238
1239     PERL_ARGS_ASSERT_SAVE_LIST;
1240
1241     for (i = 1; i <= maxsarg; i++) {
1242         register SV * const sv = newSV(0);
1243         sv_setsv(sv,sarg[i]);
1244         SSCHECK(3);
1245         SSPUSHPTR(sarg[i]);             /* remember the pointer */
1246         SSPUSHPTR(sv);                  /* remember the value */
1247         SSPUSHINT(SAVEt_ITEM);
1248     }
1249 }
1250
1251 /*
1252 =for apidoc sv_usepvn_mg
1253
1254 Like C<sv_usepvn>, but also handles 'set' magic.
1255
1256 =cut
1257 */
1258
1259 void
1260 Perl_sv_usepvn_mg(pTHX_ SV *sv, char *ptr, STRLEN len)
1261 {
1262     PERL_ARGS_ASSERT_SV_USEPVN_MG;
1263
1264     sv_usepvn_flags(sv,ptr,len, SV_SMAGIC);
1265 }
1266
1267 /*
1268 =for apidoc sv_usepvn
1269
1270 Tells an SV to use C<ptr> to find its string value. Implemented by
1271 calling C<sv_usepvn_flags> with C<flags> of 0, hence does not handle 'set'
1272 magic. See C<sv_usepvn_flags>.
1273
1274 =cut
1275 */
1276
1277 void
1278 Perl_sv_usepvn(pTHX_ SV *sv, char *ptr, STRLEN len)
1279 {
1280     PERL_ARGS_ASSERT_SV_USEPVN;
1281
1282     sv_usepvn_flags(sv,ptr,len, 0);
1283 }
1284
1285 void
1286 Perl_cv_ckproto(pTHX_ const CV *cv, const GV *gv, const char *p)
1287 {
1288     PERL_ARGS_ASSERT_CV_CKPROTO;
1289
1290     cv_ckproto_len(cv, gv, p, p ? strlen(p) : 0);
1291 }
1292
1293 /*
1294 =for apidoc unpack_str
1295
1296 The engine implementing unpack() Perl function. Note: parameters strbeg, new_s
1297 and ocnt are not used. This call should not be used, use unpackstring instead.
1298
1299 =cut */
1300
1301 I32
1302 Perl_unpack_str(pTHX_ const char *pat, const char *patend, const char *s,
1303                 const char *strbeg, const char *strend, char **new_s, I32 ocnt,
1304                 U32 flags)
1305 {
1306     PERL_ARGS_ASSERT_UNPACK_STR;
1307
1308     PERL_UNUSED_ARG(strbeg);
1309     PERL_UNUSED_ARG(new_s);
1310     PERL_UNUSED_ARG(ocnt);
1311
1312     return unpackstring(pat, patend, s, strend, flags);
1313 }
1314
1315 /*
1316 =for apidoc pack_cat
1317
1318 The engine implementing pack() Perl function. Note: parameters next_in_list and
1319 flags are not used. This call should not be used; use packlist instead.
1320
1321 =cut
1322 */
1323
1324 void
1325 Perl_pack_cat(pTHX_ SV *cat, const char *pat, const char *patend, register SV **beglist, SV **endlist, SV ***next_in_list, U32 flags)
1326 {
1327     PERL_ARGS_ASSERT_PACK_CAT;
1328
1329     PERL_UNUSED_ARG(next_in_list);
1330     PERL_UNUSED_ARG(flags);
1331
1332     packlist(cat, pat, patend, beglist, endlist);
1333 }
1334
1335 HE *
1336 Perl_hv_store_ent(pTHX_ HV *hv, SV *keysv, SV *val, U32 hash)
1337 {
1338   return (HE *)hv_common(hv, keysv, NULL, 0, 0, HV_FETCH_ISSTORE, val, hash);
1339 }
1340
1341 bool
1342 Perl_hv_exists_ent(pTHX_ HV *hv, SV *keysv, U32 hash)
1343 {
1344     PERL_ARGS_ASSERT_HV_EXISTS_ENT;
1345
1346     return hv_common(hv, keysv, NULL, 0, 0, HV_FETCH_ISEXISTS, 0, hash)
1347         ? TRUE : FALSE;
1348 }
1349
1350 HE *
1351 Perl_hv_fetch_ent(pTHX_ HV *hv, SV *keysv, I32 lval, U32 hash)
1352 {
1353     PERL_ARGS_ASSERT_HV_FETCH_ENT;
1354
1355     return (HE *)hv_common(hv, keysv, NULL, 0, 0, 
1356                      (lval ? HV_FETCH_LVALUE : 0), NULL, hash);
1357 }
1358
1359 SV *
1360 Perl_hv_delete_ent(pTHX_ HV *hv, SV *keysv, I32 flags, U32 hash)
1361 {
1362     PERL_ARGS_ASSERT_HV_DELETE_ENT;
1363
1364     return MUTABLE_SV(hv_common(hv, keysv, NULL, 0, 0, flags | HV_DELETE, NULL,
1365                                 hash));
1366 }
1367
1368 SV**
1369 Perl_hv_store_flags(pTHX_ HV *hv, const char *key, I32 klen, SV *val, U32 hash,
1370                     int flags)
1371 {
1372     return (SV**) hv_common(hv, NULL, key, klen, flags,
1373                             (HV_FETCH_ISSTORE|HV_FETCH_JUST_SV), val, hash);
1374 }
1375
1376 SV**
1377 Perl_hv_store(pTHX_ HV *hv, const char *key, I32 klen_i32, SV *val, U32 hash)
1378 {
1379     STRLEN klen;
1380     int flags;
1381
1382     if (klen_i32 < 0) {
1383         klen = -klen_i32;
1384         flags = HVhek_UTF8;
1385     } else {
1386         klen = klen_i32;
1387         flags = 0;
1388     }
1389     return (SV **) hv_common(hv, NULL, key, klen, flags,
1390                              (HV_FETCH_ISSTORE|HV_FETCH_JUST_SV), val, hash);
1391 }
1392
1393 bool
1394 Perl_hv_exists(pTHX_ HV *hv, const char *key, I32 klen_i32)
1395 {
1396     STRLEN klen;
1397     int flags;
1398
1399     PERL_ARGS_ASSERT_HV_EXISTS;
1400
1401     if (klen_i32 < 0) {
1402         klen = -klen_i32;
1403         flags = HVhek_UTF8;
1404     } else {
1405         klen = klen_i32;
1406         flags = 0;
1407     }
1408     return hv_common(hv, NULL, key, klen, flags, HV_FETCH_ISEXISTS, 0, 0)
1409         ? TRUE : FALSE;
1410 }
1411
1412 SV**
1413 Perl_hv_fetch(pTHX_ HV *hv, const char *key, I32 klen_i32, I32 lval)
1414 {
1415     STRLEN klen;
1416     int flags;
1417
1418     PERL_ARGS_ASSERT_HV_FETCH;
1419
1420     if (klen_i32 < 0) {
1421         klen = -klen_i32;
1422         flags = HVhek_UTF8;
1423     } else {
1424         klen = klen_i32;
1425         flags = 0;
1426     }
1427     return (SV **) hv_common(hv, NULL, key, klen, flags,
1428                              lval ? (HV_FETCH_JUST_SV | HV_FETCH_LVALUE)
1429                              : HV_FETCH_JUST_SV, NULL, 0);
1430 }
1431
1432 SV *
1433 Perl_hv_delete(pTHX_ HV *hv, const char *key, I32 klen_i32, I32 flags)
1434 {
1435     STRLEN klen;
1436     int k_flags;
1437
1438     PERL_ARGS_ASSERT_HV_DELETE;
1439
1440     if (klen_i32 < 0) {
1441         klen = -klen_i32;
1442         k_flags = HVhek_UTF8;
1443     } else {
1444         klen = klen_i32;
1445         k_flags = 0;
1446     }
1447     return MUTABLE_SV(hv_common(hv, NULL, key, klen, k_flags, flags | HV_DELETE,
1448                                 NULL, 0));
1449 }
1450
1451 /* Functions after here were made mathoms post 5.10.0 but pre 5.8.9 */
1452 int
1453 Perl_magic_setglob(pTHX_ SV *sv, MAGIC *mg)
1454 {
1455     PERL_UNUSED_ARG(mg);
1456     PERL_UNUSED_ARG(sv);
1457
1458     Perl_croak(aTHX_ "Perl_magic_setglob is dead code?");
1459
1460     return 0;
1461 }
1462
1463 AV *
1464 Perl_newAV(pTHX)
1465 {
1466     return MUTABLE_AV(newSV_type(SVt_PVAV));
1467     /* sv_upgrade does AvREAL_only():
1468     AvALLOC(av) = 0;
1469     AvARRAY(av) = NULL;
1470     AvMAX(av) = AvFILLp(av) = -1; */
1471 }
1472
1473 HV *
1474 Perl_newHV(pTHX)
1475 {
1476     HV * const hv = MUTABLE_HV(newSV_type(SVt_PVHV));
1477     assert(!SvOK(hv));
1478
1479     return hv;
1480 }
1481
1482 int
1483 Perl_magic_setbm(pTHX_ SV *sv, MAGIC *mg)
1484 {
1485     return Perl_magic_setregexp(aTHX_ sv, mg);
1486 }
1487
1488 int
1489 Perl_magic_setfm(pTHX_ SV *sv, MAGIC *mg)
1490 {
1491     return Perl_magic_setregexp(aTHX_ sv, mg);
1492 }
1493
1494 void
1495 Perl_sv_insert(pTHX_ SV *bigstr, STRLEN offset, STRLEN len, const char *little, STRLEN littlelen)
1496 {
1497     PERL_ARGS_ASSERT_SV_INSERT;
1498     sv_insert_flags(bigstr, offset, len, little, littlelen, SV_GMAGIC);
1499 }
1500
1501 void
1502 Perl_save_freesv(pTHX_ SV *sv)
1503 {
1504     dVAR;
1505     save_freesv(sv);
1506 }
1507
1508 void
1509 Perl_save_mortalizesv(pTHX_ SV *sv)
1510 {
1511     dVAR;
1512
1513     PERL_ARGS_ASSERT_SAVE_MORTALIZESV;
1514
1515     save_mortalizesv(sv);
1516 }
1517
1518 void
1519 Perl_save_freeop(pTHX_ OP *o)
1520 {
1521     dVAR;
1522     save_freeop(o);
1523 }
1524
1525 void
1526 Perl_save_freepv(pTHX_ char *pv)
1527 {
1528     dVAR;
1529     save_freepv(pv);
1530 }
1531
1532 void
1533 Perl_save_op(pTHX)
1534 {
1535     dVAR;
1536     save_op();
1537 }
1538
1539 #endif /* NO_MATHOMS */
1540
1541 /*
1542  * Local variables:
1543  * c-indentation-style: bsd
1544  * c-basic-offset: 4
1545  * indent-tabs-mode: t
1546  * End:
1547  *
1548  * ex: set ts=8 sts=4 sw=4 noet:
1549  */