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