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