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