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