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