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