This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
pp_rv2av and pp_rv2hv have a lot of common code, so it's certainly a
[perl5.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 #if 0 /* use the macro from hv.h instead */
537
538 char*   
539 Perl_sharepvn(pTHX_ const char *sv, I32 len, U32 hash)
540 {
541     return HEK_KEY(share_hek(sv, len, hash));
542 }
543
544 #endif
545
546 AV *
547 Perl_av_fake(pTHX_ register I32 size, register SV **strp)
548 {
549     register SV** ary;
550     register AV * const av = (AV*)newSV(0);
551
552     sv_upgrade((SV *)av, SVt_PVAV);
553     Newx(ary,size+1,SV*);
554     AvALLOC(av) = ary;
555     Copy(strp,ary,size,SV*);
556     AvREIFY_only(av);
557     AvARRAY(av) = ary;
558     AvFILLp(av) = size - 1;
559     AvMAX(av) = size - 1;
560     while (size--) {
561         assert (*strp);
562         SvTEMP_off(*strp);
563         strp++;
564     }
565     return av;
566 }
567
568 bool
569 Perl_do_open(pTHX_ GV *gv, register const char *name, I32 len, int as_raw,
570              int rawmode, int rawperm, PerlIO *supplied_fp)
571 {
572     return do_openn(gv, name, len, as_raw, rawmode, rawperm,
573                     supplied_fp, (SV **) NULL, 0);
574 }
575
576 bool
577 Perl_do_open9(pTHX_ GV *gv, register const char *name, I32 len, int 
578 as_raw,
579               int rawmode, int rawperm, PerlIO *supplied_fp, SV *svs,
580               I32 num_svs)
581 {
582     PERL_UNUSED_ARG(num_svs);
583     return do_openn(gv, name, len, as_raw, rawmode, rawperm,
584                     supplied_fp, &svs, 1);
585 }
586
587 int
588 Perl_do_binmode(pTHX_ PerlIO *fp, int iotype, int mode)
589 {
590  /* The old body of this is now in non-LAYER part of perlio.c
591   * This is a stub for any XS code which might have been calling it.
592   */
593  const char *name = ":raw";
594 #ifdef PERLIO_USING_CRLF
595  if (!(mode & O_BINARY))
596      name = ":crlf";
597 #endif
598  return PerlIO_binmode(aTHX_ fp, iotype, mode, name);
599 }
600
601 #ifndef OS2
602 bool
603 Perl_do_aexec(pTHX_ SV *really, register SV **mark, register SV **sp)
604 {
605     return do_aexec5(really, mark, sp, 0, 0);
606 }
607 #endif
608
609 #ifdef PERL_DEFAULT_DO_EXEC3_IMPLEMENTATION
610 bool
611 Perl_do_exec(pTHX_ const char *cmd)
612 {
613     return do_exec3(cmd,0,0);
614 }
615 #endif
616
617 #ifdef HAS_PIPE
618 void
619 Perl_do_pipe(pTHX_ SV *sv, GV *rgv, GV *wgv)
620 {
621     dVAR;
622     register IO *rstio;
623     register IO *wstio;
624     int fd[2];
625
626     if (!rgv)
627         goto badexit;
628     if (!wgv)
629         goto badexit;
630
631     rstio = GvIOn(rgv);
632     wstio = GvIOn(wgv);
633
634     if (IoIFP(rstio))
635         do_close(rgv,FALSE);
636     if (IoIFP(wstio))
637         do_close(wgv,FALSE);
638
639     if (PerlProc_pipe(fd) < 0)
640         goto badexit;
641     IoIFP(rstio) = PerlIO_fdopen(fd[0], "r"PIPE_OPEN_MODE);
642     IoOFP(wstio) = PerlIO_fdopen(fd[1], "w"PIPE_OPEN_MODE);
643     IoOFP(rstio) = IoIFP(rstio);
644     IoIFP(wstio) = IoOFP(wstio);
645     IoTYPE(rstio) = IoTYPE_RDONLY;
646     IoTYPE(wstio) = IoTYPE_WRONLY;
647     if (!IoIFP(rstio) || !IoOFP(wstio)) {
648         if (IoIFP(rstio)) PerlIO_close(IoIFP(rstio));
649         else PerlLIO_close(fd[0]);
650         if (IoOFP(wstio)) PerlIO_close(IoOFP(wstio));
651         else PerlLIO_close(fd[1]);
652         goto badexit;
653     }
654
655     sv_setsv(sv,&PL_sv_yes);
656     return;
657
658 badexit:
659     sv_setsv(sv,&PL_sv_undef);
660     return;
661 }
662 #endif
663
664 /* Backwards compatibility. */
665 int
666 Perl_init_i18nl14n(pTHX_ int printwarn)
667 {
668     return init_i18nl10n(printwarn);
669 }
670
671 /* XXX kept for BINCOMPAT only */
672 void
673 Perl_save_hints(pTHX)
674 {
675     Perl_croak(aTHX_ "internal error: obsolete function save_hints() called");
676 }
677
678 #if 0
679 OP *
680 Perl_ck_retarget(pTHX_ OP *o)
681 {
682     Perl_croak(aTHX_ "NOT IMPL LINE %d",__LINE__);
683     /* STUB */
684     return o;
685 }
686 #endif
687
688 OP *
689 Perl_oopsCV(pTHX_ OP *o)
690 {
691     Perl_croak(aTHX_ "NOT IMPL LINE %d",__LINE__);
692     /* STUB */
693     PERL_UNUSED_ARG(o);
694     NORETURN_FUNCTION_END;
695 }
696
697 PP(pp_padany)
698 {
699     DIE(aTHX_ "NOT IMPL LINE %d",__LINE__);
700 }
701
702 PP(pp_threadsv)
703 {
704     DIE(aTHX_ "tried to access per-thread data in non-threaded perl");
705 }
706
707 PP(pp_mapstart)
708 {
709     DIE(aTHX_ "panic: mapstart");       /* uses grepstart */
710 }
711
712 /* These ops all have the same body as pp_null.  */
713 PP(pp_scalar)
714 {
715     dVAR;
716     return NORMAL;
717 }
718
719 PP(pp_regcmaybe)
720 {
721     dVAR;
722     return NORMAL;
723 }
724
725 PP(pp_lineseq)
726 {
727     dVAR;
728     return NORMAL;
729 }
730
731 PP(pp_scope)
732 {
733     dVAR;
734     return NORMAL;
735 }
736
737 /* Ops that are calls to do_kv.  */
738 PP(pp_values)
739 {
740     return do_kv();
741 }
742
743 PP(pp_keys)
744 {
745     return do_kv();
746 }
747
748 /* Ops that are simply calls to other ops.  */
749 PP(pp_dump)
750 {
751     return pp_goto();
752     /*NOTREACHED*/
753 }
754
755 PP(pp_dofile)
756 {
757     return pp_require();
758 }
759
760 PP(pp_dbmclose)
761 {
762     return pp_untie();
763 }
764
765 PP(pp_read)
766 {
767     return pp_sysread();
768 }
769
770 PP(pp_recv)
771 {
772     return pp_sysread();
773 }
774
775 PP(pp_seek)
776 {
777     return pp_sysseek();
778 }
779
780 PP(pp_fcntl)
781 {
782     return pp_ioctl();
783 }
784
785 PP(pp_gsockopt)
786 {
787     return pp_ssockopt();
788 }
789
790 PP(pp_getsockname)
791 {
792     return pp_getpeername();
793 }
794
795 PP(pp_lstat)
796 {
797     return pp_stat();
798 }
799
800 PP(pp_fteowned)
801 {
802     return pp_ftrowned();
803 }
804
805 PP(pp_ftbinary)
806 {
807     return pp_fttext();
808 }
809
810 PP(pp_localtime)
811 {
812     return pp_gmtime();
813 }
814
815 PP(pp_shmget)
816 {
817     return pp_semget();
818 }
819
820 PP(pp_shmctl)
821 {
822     return pp_semctl();
823 }
824
825 PP(pp_shmread)
826 {
827     return pp_shmwrite();
828 }
829
830 PP(pp_msgget)
831 {
832     return pp_semget();
833 }
834
835 PP(pp_msgctl)
836 {
837     return pp_semctl();
838 }
839
840 PP(pp_ghbyname)
841 {
842     return pp_ghostent();
843 }
844
845 PP(pp_ghbyaddr)
846 {
847     return pp_ghostent();
848 }
849
850 PP(pp_gnbyname)
851 {
852     return pp_gnetent();
853 }
854
855 PP(pp_gnbyaddr)
856 {
857     return pp_gnetent();
858 }
859
860 PP(pp_gpbyname)
861 {
862     return pp_gprotoent();
863 }
864
865 PP(pp_gpbynumber)
866 {
867     return pp_gprotoent();
868 }
869
870 PP(pp_gsbyname)
871 {
872     return pp_gservent();
873 }
874
875 PP(pp_gsbyport)
876 {
877     return pp_gservent();
878 }
879
880 PP(pp_gpwnam)
881 {
882     return pp_gpwent();
883 }
884
885 PP(pp_gpwuid)
886 {
887     return pp_gpwent();
888 }
889
890 PP(pp_ggrnam)
891 {
892     return pp_ggrent();
893 }
894
895 PP(pp_ggrgid)
896 {
897     return pp_ggrent();
898 }
899
900 PP(pp_ftsize)
901 {
902     return pp_ftis();
903 }
904
905 PP(pp_ftmtime)
906 {
907     return pp_ftis();
908 }
909
910 PP(pp_ftatime)
911 {
912     return pp_ftis();
913 }
914
915 PP(pp_ftctime)
916 {
917     return pp_ftis();
918 }
919
920 PP(pp_ftzero)
921 {
922     return pp_ftrowned();
923 }
924
925 PP(pp_ftsock)
926 {
927     return pp_ftrowned();
928 }
929
930 PP(pp_ftchr)
931 {
932     return pp_ftrowned();
933 }
934
935 PP(pp_ftblk)
936 {
937     return pp_ftrowned();
938 }
939
940 PP(pp_ftfile)
941 {
942     return pp_ftrowned();
943 }
944
945 PP(pp_ftdir)
946 {
947     return pp_ftrowned();
948 }
949
950 PP(pp_ftpipe)
951 {
952     return pp_ftrowned();
953 }
954
955 PP(pp_ftsuid)
956 {
957     return pp_ftrowned();
958 }
959
960 PP(pp_ftsgid)
961 {
962     return pp_ftrowned();
963 }
964
965 PP(pp_ftsvtx)
966 {
967     return pp_ftrowned();
968 }
969
970 PP(pp_unlink)
971 {
972     return pp_chown();
973 }
974
975 PP(pp_chmod)
976 {
977     return pp_chown();
978 }
979
980 PP(pp_utime)
981 {
982     return pp_chown();
983 }
984
985 PP(pp_kill)
986 {
987     return pp_chown();
988 }
989
990 PP(pp_symlink)
991 {
992     return pp_link();
993 }
994
995 PP(pp_ftrwrite)
996 {
997     return pp_ftrread();
998 }
999
1000 PP(pp_ftrexec)
1001 {
1002     return pp_ftrread();
1003 }
1004
1005 PP(pp_fteread)
1006 {
1007     return pp_ftrread();
1008 }
1009
1010 PP(pp_ftewrite)
1011 {
1012     return pp_ftrread();
1013 }
1014
1015 PP(pp_fteexec)
1016 {
1017     return pp_ftrread();
1018 }
1019
1020 PP(pp_msgsnd)
1021 {
1022     return pp_shmwrite();
1023 }
1024
1025 PP(pp_msgrcv)
1026 {
1027     return pp_shmwrite();
1028 }
1029
1030 PP(pp_syswrite)
1031 {
1032     return pp_send();
1033 }
1034
1035 PP(pp_semop)
1036 {
1037     return pp_shmwrite();
1038 }
1039
1040 PP(pp_dor)
1041 {
1042     return pp_defined();
1043 }
1044
1045 PP(pp_andassign)
1046 {
1047     return pp_and();
1048 }
1049
1050 PP(pp_orassign)
1051 {
1052     return pp_or();
1053 }
1054
1055 PP(pp_dorassign)
1056 {
1057     return pp_defined();
1058
1059
1060 PP(pp_lcfirst)
1061 {
1062     return pp_ucfirst();
1063 }
1064
1065 PP(pp_slt)
1066 {
1067     return pp_sle();
1068 }
1069
1070 PP(pp_sgt)
1071 {
1072     return pp_sle();
1073 }
1074
1075 PP(pp_sge)
1076 {
1077     return pp_sle();
1078 }
1079
1080 PP(pp_rindex)
1081 {
1082     return pp_index();
1083 }
1084
1085 PP(pp_hex)
1086 {
1087     return pp_oct();
1088 }
1089
1090 PP(pp_pop)
1091 {
1092     return pp_shift();
1093 }
1094
1095 PP(pp_cos)
1096 {
1097     return pp_sin();
1098 }
1099
1100 PP(pp_exp)
1101 {
1102     return pp_sin();
1103 }
1104
1105 PP(pp_log)
1106 {
1107     return pp_sin();
1108 }
1109
1110 PP(pp_sqrt)
1111 {
1112     return pp_sin();
1113 }
1114
1115 PP(pp_bit_xor)
1116 {
1117     return pp_bit_or();
1118 }
1119
1120 PP(pp_rv2hv)
1121 {
1122     return Perl_pp_rv2av(aTHX);
1123 }
1124
1125 U8 *
1126 Perl_uvuni_to_utf8(pTHX_ U8 *d, UV uv)
1127 {
1128     return Perl_uvuni_to_utf8_flags(aTHX_ d, uv, 0);
1129 }
1130
1131 bool
1132 Perl_is_utf8_string_loc(pTHX_ const U8 *s, STRLEN len, const U8 **ep)
1133 {
1134     return is_utf8_string_loclen(s, len, ep, 0);
1135 }
1136
1137 /*
1138 =for apidoc sv_nolocking
1139
1140 Dummy routine which "locks" an SV when there is no locking module present.
1141 Exists to avoid test for a NULL function pointer and because it could
1142 potentially warn under some level of strict-ness.
1143
1144 "Superseded" by sv_nosharing().
1145
1146 =cut
1147 */
1148
1149 void
1150 Perl_sv_nolocking(pTHX_ SV *sv)
1151 {
1152     PERL_UNUSED_CONTEXT;
1153     PERL_UNUSED_ARG(sv);
1154 }
1155
1156
1157 /*
1158 =for apidoc sv_nounlocking
1159
1160 Dummy routine which "unlocks" an SV when there is no locking module present.
1161 Exists to avoid test for a NULL function pointer and because it could
1162 potentially warn under some level of strict-ness.
1163
1164 "Superseded" by sv_nosharing().
1165
1166 =cut
1167 */
1168
1169 void
1170 Perl_sv_nounlocking(pTHX_ SV *sv)
1171 {
1172     PERL_UNUSED_CONTEXT;
1173     PERL_UNUSED_ARG(sv);
1174 }
1175
1176 void
1177 Perl_save_long(pTHX_ long int *longp)
1178 {
1179     dVAR;
1180     SSCHECK(3);
1181     SSPUSHLONG(*longp);
1182     SSPUSHPTR(longp);
1183     SSPUSHINT(SAVEt_LONG);
1184 }
1185
1186 void
1187 Perl_save_I16(pTHX_ I16 *intp)
1188 {
1189     dVAR;
1190     SSCHECK(3);
1191     SSPUSHINT(*intp);
1192     SSPUSHPTR(intp);
1193     SSPUSHINT(SAVEt_I16);
1194 }
1195
1196 void
1197 Perl_save_iv(pTHX_ IV *ivp)
1198 {
1199     dVAR;
1200     SSCHECK(3);
1201     SSPUSHIV(*ivp);
1202     SSPUSHPTR(ivp);
1203     SSPUSHINT(SAVEt_IV);
1204 }
1205
1206 void
1207 Perl_save_nogv(pTHX_ GV *gv)
1208 {
1209     dVAR;
1210     SSCHECK(2);
1211     SSPUSHPTR(gv);
1212     SSPUSHINT(SAVEt_NSTAB);
1213 }
1214
1215 void
1216 Perl_save_list(pTHX_ register SV **sarg, I32 maxsarg)
1217 {
1218     dVAR;
1219     register I32 i;
1220
1221     for (i = 1; i <= maxsarg; i++) {
1222         register SV * const sv = newSV(0);
1223         sv_setsv(sv,sarg[i]);
1224         SSCHECK(3);
1225         SSPUSHPTR(sarg[i]);             /* remember the pointer */
1226         SSPUSHPTR(sv);                  /* remember the value */
1227         SSPUSHINT(SAVEt_ITEM);
1228     }
1229 }
1230
1231 /*
1232 =for apidoc sv_usepvn_mg
1233
1234 Like C<sv_usepvn>, but also handles 'set' magic.
1235
1236 =cut
1237 */
1238
1239 void
1240 Perl_sv_usepvn_mg(pTHX_ SV *sv, char *ptr, STRLEN len)
1241 {
1242     sv_usepvn_flags(sv,ptr,len, SV_SMAGIC);
1243 }
1244
1245 /*
1246 =for apidoc sv_usepvn
1247
1248 Tells an SV to use C<ptr> to find its string value. Implemented by
1249 calling C<sv_usepvn_flags> with C<flags> of 0, hence does not handle 'set'
1250 magic. See C<sv_usepvn_flags>.
1251
1252 =cut
1253 */
1254
1255 void
1256 Perl_sv_usepvn(pTHX_ SV *sv, char *ptr, STRLEN len)
1257 {
1258     sv_usepvn_flags(sv,ptr,len, 0);
1259 }
1260
1261 void
1262 Perl_cv_ckproto(pTHX_ const CV *cv, const GV *gv, const char *p)
1263 {
1264     cv_ckproto_len(cv, gv, p, p ? strlen(p) : 0);
1265 }
1266
1267 /*
1268 =for apidoc unpack_str
1269
1270 The engine implementing unpack() Perl function. Note: parameters strbeg, new_s
1271 and ocnt are not used. This call should not be used, use unpackstring instead.
1272
1273 =cut */
1274
1275 I32
1276 Perl_unpack_str(pTHX_ const char *pat, const char *patend, const char *s,
1277                 const char *strbeg, const char *strend, char **new_s, I32 ocnt,
1278                 U32 flags)
1279 {
1280     PERL_UNUSED_ARG(strbeg);
1281     PERL_UNUSED_ARG(new_s);
1282     PERL_UNUSED_ARG(ocnt);
1283
1284     return unpackstring(pat, patend, s, strend, flags);
1285 }
1286
1287 /*
1288 =for apidoc pack_cat
1289
1290 The engine implementing pack() Perl function. Note: parameters next_in_list and
1291 flags are not used. This call should not be used; use packlist instead.
1292
1293 =cut
1294 */
1295
1296 void
1297 Perl_pack_cat(pTHX_ SV *cat, const char *pat, const char *patend, register SV **beglist, SV **endlist, SV ***next_in_list, U32 flags)
1298 {
1299     PERL_UNUSED_ARG(next_in_list);
1300     PERL_UNUSED_ARG(flags);
1301
1302     packlist(cat, pat, patend, beglist, endlist);
1303 }
1304 #endif /* NO_MATHOMS */
1305
1306 /*
1307  * Local variables:
1308  * c-indentation-style: bsd
1309  * c-basic-offset: 4
1310  * indent-tabs-mode: t
1311  * End:
1312  *
1313  * ex: set ts=8 sts=4 sw=4 noet:
1314  */