Commit | Line | Data |
7ee2227d |
1 | /* mathoms.c |
2 | * |
3 | * Copyright (C) 2005, by Larry Wall and others |
4 | * |
5 | * You may distribute under the terms of either the GNU General Public |
6 | * License or the Artistic License, as specified in the README file. |
7 | * |
8 | */ |
9 | |
10 | /* |
11 | * "Anything that Hobbits had no immediate use for, but were unwilling to |
12 | * throw away, they called a mathom. Their dwellings were apt to become |
13 | * rather crowded with mathoms, and many of the presents that passed from |
14 | * hand to hand were of that sort." |
15 | */ |
16 | |
17 | /* |
18 | * This file contains mathoms, various binary artifacts from previous |
f2f0f092 |
19 | * versions of Perl. For binary or source compatibility reasons, though, |
20 | * we cannot completely remove them from the core code. |
7ee2227d |
21 | * |
22 | * SMP - Oct. 24, 2005 |
23 | * |
24 | */ |
25 | |
26 | #include "EXTERN.h" |
27 | #define PERL_IN_MATHOMS_C |
28 | #include "perl.h" |
29 | |
30 | /* ref() is now a macro using Perl_doref; |
31 | * this version provided for binary compatibility only. |
32 | */ |
33 | OP * |
34 | Perl_ref(pTHX_ OP *o, I32 type) |
35 | { |
36 | return doref(o, type, TRUE); |
37 | } |
38 | |
aae9cea0 |
39 | /* |
174c73e3 |
40 | =for apidoc sv_unref |
41 | |
42 | Unsets the RV status of the SV, and decrements the reference count of |
43 | whatever was being referenced by the RV. This can almost be thought of |
44 | as a reversal of C<newSVrv>. This is C<sv_unref_flags> with the C<flag> |
45 | being zero. See C<SvROK_off>. |
46 | |
47 | =cut |
48 | */ |
49 | |
50 | void |
51 | Perl_sv_unref(pTHX_ SV *sv) |
52 | { |
53 | sv_unref_flags(sv, 0); |
54 | } |
55 | |
56 | /* |
aae9cea0 |
57 | =for apidoc sv_taint |
58 | |
59 | Taint an SV. Use C<SvTAINTED_on> instead. |
60 | =cut |
61 | */ |
62 | |
63 | void |
64 | Perl_sv_taint(pTHX_ SV *sv) |
65 | { |
66 | sv_magic((sv), Nullsv, PERL_MAGIC_taint, Nullch, 0); |
67 | } |
68 | |
7ee2227d |
69 | /* sv_2iv() is now a macro using Perl_sv_2iv_flags(); |
70 | * this function provided for binary compatibility only |
71 | */ |
72 | |
73 | IV |
74 | Perl_sv_2iv(pTHX_ register SV *sv) |
75 | { |
76 | return sv_2iv_flags(sv, SV_GMAGIC); |
77 | } |
78 | |
79 | /* sv_2uv() is now a macro using Perl_sv_2uv_flags(); |
80 | * this function provided for binary compatibility only |
81 | */ |
82 | |
83 | UV |
84 | Perl_sv_2uv(pTHX_ register SV *sv) |
85 | { |
86 | return sv_2uv_flags(sv, SV_GMAGIC); |
87 | } |
88 | |
89 | /* sv_2pv() is now a macro using Perl_sv_2pv_flags(); |
90 | * this function provided for binary compatibility only |
91 | */ |
92 | |
93 | char * |
94 | Perl_sv_2pv(pTHX_ register SV *sv, STRLEN *lp) |
95 | { |
96 | return sv_2pv_flags(sv, lp, SV_GMAGIC); |
97 | } |
98 | |
5abc721d |
99 | /* |
cb2f1b7b |
100 | =for apidoc sv_2pv_nolen |
101 | |
102 | Like C<sv_2pv()>, but doesn't return the length too. You should usually |
103 | use the macro wrapper C<SvPV_nolen(sv)> instead. |
104 | =cut |
105 | */ |
106 | |
107 | char * |
108 | Perl_sv_2pv_nolen(pTHX_ register SV *sv) |
109 | { |
110 | return sv_2pv(sv, 0); |
111 | } |
112 | |
113 | /* |
114 | =for apidoc sv_2pvbyte_nolen |
115 | |
116 | Return a pointer to the byte-encoded representation of the SV. |
117 | May cause the SV to be downgraded from UTF-8 as a side-effect. |
118 | |
119 | Usually accessed via the C<SvPVbyte_nolen> macro. |
120 | |
121 | =cut |
122 | */ |
123 | |
124 | char * |
125 | Perl_sv_2pvbyte_nolen(pTHX_ register SV *sv) |
126 | { |
127 | return sv_2pvbyte(sv, 0); |
128 | } |
129 | |
130 | /* |
131 | =for apidoc sv_2pvutf8_nolen |
132 | |
133 | Return a pointer to the UTF-8-encoded representation of the SV. |
134 | May cause the SV to be upgraded to UTF-8 as a side-effect. |
135 | |
136 | Usually accessed via the C<SvPVutf8_nolen> macro. |
137 | |
138 | =cut |
139 | */ |
140 | |
141 | char * |
142 | Perl_sv_2pvutf8_nolen(pTHX_ register SV *sv) |
143 | { |
144 | return sv_2pvutf8(sv, 0); |
145 | } |
146 | |
147 | /* |
5abc721d |
148 | =for apidoc sv_force_normal |
149 | |
150 | Undo various types of fakery on an SV: if the PV is a shared string, make |
151 | a private copy; if we're a ref, stop refing; if we're a glob, downgrade to |
152 | an xpvmg. See also C<sv_force_normal_flags>. |
153 | |
154 | =cut |
155 | */ |
156 | |
157 | void |
158 | Perl_sv_force_normal(pTHX_ register SV *sv) |
159 | { |
160 | sv_force_normal_flags(sv, 0); |
161 | } |
7ee2227d |
162 | |
163 | /* sv_setsv() is now a macro using Perl_sv_setsv_flags(); |
164 | * this function provided for binary compatibility only |
165 | */ |
166 | |
167 | void |
168 | Perl_sv_setsv(pTHX_ SV *dstr, register SV *sstr) |
169 | { |
170 | sv_setsv_flags(dstr, sstr, SV_GMAGIC); |
171 | } |
172 | |
173 | /* sv_catpvn() is now a macro using Perl_sv_catpvn_flags(); |
174 | * this function provided for binary compatibility only |
175 | */ |
176 | |
177 | void |
178 | Perl_sv_catpvn(pTHX_ SV *dsv, const char* sstr, STRLEN slen) |
179 | { |
180 | sv_catpvn_flags(dsv, sstr, slen, SV_GMAGIC); |
181 | } |
182 | |
b347df82 |
183 | /* |
184 | =for apidoc sv_catpvn_mg |
185 | |
186 | Like C<sv_catpvn>, but also handles 'set' magic. |
187 | |
188 | =cut |
189 | */ |
190 | |
191 | void |
192 | Perl_sv_catpvn_mg(pTHX_ register SV *sv, register const char *ptr, register STRLEN len) |
193 | { |
194 | sv_catpvn_flags(sv,ptr,len,SV_GMAGIC|SV_SMAGIC); |
195 | } |
196 | |
7ee2227d |
197 | /* sv_catsv() is now a macro using Perl_sv_catsv_flags(); |
198 | * this function provided for binary compatibility only |
199 | */ |
200 | |
201 | void |
202 | Perl_sv_catsv(pTHX_ SV *dstr, register SV *sstr) |
203 | { |
204 | sv_catsv_flags(dstr, sstr, SV_GMAGIC); |
205 | } |
206 | |
0feed65a |
207 | /* |
b347df82 |
208 | =for apidoc sv_catsv_mg |
209 | |
210 | Like C<sv_catsv>, but also handles 'set' magic. |
211 | |
212 | =cut |
213 | */ |
214 | |
215 | void |
216 | Perl_sv_catsv_mg(pTHX_ SV *dsv, register SV *ssv) |
217 | { |
218 | sv_catsv_flags(dsv,ssv,SV_GMAGIC|SV_SMAGIC); |
219 | } |
220 | |
221 | /* |
0feed65a |
222 | =for apidoc sv_iv |
223 | |
224 | A private implementation of the C<SvIVx> macro for compilers which can't |
225 | cope with complex macro expressions. Always use the macro instead. |
226 | |
227 | =cut |
228 | */ |
229 | |
230 | IV |
231 | Perl_sv_iv(pTHX_ register SV *sv) |
232 | { |
233 | if (SvIOK(sv)) { |
234 | if (SvIsUV(sv)) |
235 | return (IV)SvUVX(sv); |
236 | return SvIVX(sv); |
237 | } |
238 | return sv_2iv(sv); |
239 | } |
240 | |
241 | /* |
242 | =for apidoc sv_uv |
243 | |
244 | A private implementation of the C<SvUVx> macro for compilers which can't |
245 | cope with complex macro expressions. Always use the macro instead. |
246 | |
247 | =cut |
248 | */ |
249 | |
250 | UV |
251 | Perl_sv_uv(pTHX_ register SV *sv) |
252 | { |
253 | if (SvIOK(sv)) { |
254 | if (SvIsUV(sv)) |
255 | return SvUVX(sv); |
256 | return (UV)SvIVX(sv); |
257 | } |
258 | return sv_2uv(sv); |
259 | } |
260 | |
261 | /* |
262 | =for apidoc sv_nv |
263 | |
264 | A private implementation of the C<SvNVx> macro for compilers which can't |
265 | cope with complex macro expressions. Always use the macro instead. |
266 | |
267 | =cut |
268 | */ |
269 | |
270 | NV |
271 | Perl_sv_nv(pTHX_ register SV *sv) |
272 | { |
273 | if (SvNOK(sv)) |
274 | return SvNVX(sv); |
275 | return sv_2nv(sv); |
276 | } |
277 | |
278 | /* |
279 | =for apidoc sv_pv |
280 | |
281 | Use the C<SvPV_nolen> macro instead |
282 | |
283 | =for apidoc sv_pvn |
284 | |
285 | A private implementation of the C<SvPV> macro for compilers which can't |
286 | cope with complex macro expressions. Always use the macro instead. |
287 | |
288 | =cut |
289 | */ |
290 | |
291 | char * |
292 | Perl_sv_pvn(pTHX_ SV *sv, STRLEN *lp) |
293 | { |
294 | if (SvPOK(sv)) { |
295 | *lp = SvCUR(sv); |
296 | return SvPVX(sv); |
297 | } |
298 | return sv_2pv(sv, lp); |
299 | } |
300 | |
301 | |
302 | char * |
303 | Perl_sv_pvn_nomg(pTHX_ register SV *sv, STRLEN *lp) |
304 | { |
305 | if (SvPOK(sv)) { |
306 | *lp = SvCUR(sv); |
307 | return SvPVX(sv); |
308 | } |
309 | return sv_2pv_flags(sv, lp, 0); |
310 | } |
311 | |
7ee2227d |
312 | /* sv_pv() is now a macro using SvPV_nolen(); |
313 | * this function provided for binary compatibility only |
314 | */ |
315 | |
316 | char * |
317 | Perl_sv_pv(pTHX_ SV *sv) |
318 | { |
319 | if (SvPOK(sv)) |
320 | return SvPVX(sv); |
321 | |
322 | return sv_2pv(sv, 0); |
323 | } |
324 | |
325 | /* sv_pvn_force() is now a macro using Perl_sv_pvn_force_flags(); |
326 | * this function provided for binary compatibility only |
327 | */ |
328 | |
329 | char * |
330 | Perl_sv_pvn_force(pTHX_ SV *sv, STRLEN *lp) |
331 | { |
332 | return sv_pvn_force_flags(sv, lp, SV_GMAGIC); |
333 | } |
334 | |
335 | /* sv_pvbyte () is now a macro using Perl_sv_2pv_flags(); |
336 | * this function provided for binary compatibility only |
337 | */ |
338 | |
339 | char * |
340 | Perl_sv_pvbyte(pTHX_ SV *sv) |
341 | { |
342 | sv_utf8_downgrade(sv,0); |
343 | return sv_pv(sv); |
344 | } |
345 | |
0feed65a |
346 | /* |
347 | =for apidoc sv_pvbyte |
348 | |
349 | Use C<SvPVbyte_nolen> instead. |
350 | |
351 | =for apidoc sv_pvbyten |
352 | |
353 | A private implementation of the C<SvPVbyte> macro for compilers |
354 | which can't cope with complex macro expressions. Always use the macro |
355 | instead. |
356 | |
357 | =cut |
358 | */ |
359 | |
360 | char * |
361 | Perl_sv_pvbyten(pTHX_ SV *sv, STRLEN *lp) |
362 | { |
363 | sv_utf8_downgrade(sv,0); |
364 | return sv_pvn(sv,lp); |
365 | } |
366 | |
7ee2227d |
367 | /* sv_pvutf8 () is now a macro using Perl_sv_2pv_flags(); |
368 | * this function provided for binary compatibility only |
369 | */ |
370 | |
371 | char * |
372 | Perl_sv_pvutf8(pTHX_ SV *sv) |
373 | { |
374 | sv_utf8_upgrade(sv); |
375 | return sv_pv(sv); |
376 | } |
377 | |
0feed65a |
378 | /* |
379 | =for apidoc sv_pvutf8 |
380 | |
381 | Use the C<SvPVutf8_nolen> macro instead |
382 | |
383 | =for apidoc sv_pvutf8n |
384 | |
385 | A private implementation of the C<SvPVutf8> macro for compilers |
386 | which can't cope with complex macro expressions. Always use the macro |
387 | instead. |
388 | |
389 | =cut |
390 | */ |
391 | |
392 | char * |
393 | Perl_sv_pvutf8n(pTHX_ SV *sv, STRLEN *lp) |
394 | { |
395 | sv_utf8_upgrade(sv); |
396 | return sv_pvn(sv,lp); |
397 | } |
398 | |
205c02c2 |
399 | /* sv_utf8_upgrade() is now a macro using sv_utf8_upgrade_flags(); |
400 | * this function provided for binary compatibility only |
401 | */ |
402 | |
403 | STRLEN |
404 | Perl_sv_utf8_upgrade(pTHX_ register SV *sv) |
405 | { |
406 | return sv_utf8_upgrade_flags(sv, SV_GMAGIC); |
407 | } |
408 | |
7ee2227d |
409 | /* |
410 | =for apidoc A|U8 *|uvchr_to_utf8|U8 *d|UV uv |
411 | |
412 | Adds the UTF-8 representation of the Native codepoint C<uv> to the end |
413 | of the string C<d>; C<d> should be have at least C<UTF8_MAXBYTES+1> free |
414 | bytes available. The return value is the pointer to the byte after the |
415 | end of the new character. In other words, |
416 | |
417 | d = uvchr_to_utf8(d, uv); |
418 | |
419 | is the recommended wide native character-aware way of saying |
420 | |
421 | *(d++) = uv; |
422 | |
423 | =cut |
424 | */ |
425 | |
426 | /* On ASCII machines this is normally a macro but we want a |
427 | real function in case XS code wants it |
428 | */ |
429 | #undef Perl_uvchr_to_utf8 |
430 | U8 * |
431 | Perl_uvchr_to_utf8(pTHX_ U8 *d, UV uv) |
432 | { |
433 | return Perl_uvuni_to_utf8_flags(aTHX_ d, NATIVE_TO_UNI(uv), 0); |
434 | } |
435 | |
436 | |
437 | /* |
438 | =for apidoc A|UV|utf8n_to_uvchr|U8 *s|STRLEN curlen|STRLEN *retlen|U32 |
439 | flags |
440 | |
441 | Returns the native character value of the first character in the string |
442 | C<s> |
443 | which is assumed to be in UTF-8 encoding; C<retlen> will be set to the |
444 | length, in bytes, of that character. |
445 | |
446 | Allows length and flags to be passed to low level routine. |
447 | |
448 | =cut |
449 | */ |
450 | /* On ASCII machines this is normally a macro but we want |
451 | a real function in case XS code wants it |
452 | */ |
453 | #undef Perl_utf8n_to_uvchr |
454 | UV |
455 | Perl_utf8n_to_uvchr(pTHX_ const U8 *s, STRLEN curlen, STRLEN *retlen, |
456 | U32 flags) |
457 | { |
458 | const UV uv = Perl_utf8n_to_uvuni(aTHX_ s, curlen, retlen, flags); |
459 | return UNI_TO_NATIVE(uv); |
460 | } |
461 | int |
462 | Perl_fprintf_nocontext(PerlIO *stream, const char *format, ...) |
463 | { |
464 | dTHXs; |
465 | va_list(arglist); |
466 | va_start(arglist, format); |
467 | return PerlIO_vprintf(stream, format, arglist); |
468 | } |
469 | |
470 | int |
471 | Perl_printf_nocontext(const char *format, ...) |
472 | { |
473 | dTHX; |
474 | va_list(arglist); |
475 | va_start(arglist, format); |
476 | return PerlIO_vprintf(PerlIO_stdout(), format, arglist); |
477 | } |
478 | |
479 | #if defined(HUGE_VAL) || (defined(USE_LONG_DOUBLE) && defined(HUGE_VALL)) |
480 | /* |
481 | * This hack is to force load of "huge" support from libm.a |
482 | * So it is in perl for (say) POSIX to use. |
483 | * Needed for SunOS with Sun's 'acc' for example. |
484 | */ |
485 | NV |
486 | Perl_huge(void) |
487 | { |
488 | # if defined(USE_LONG_DOUBLE) && defined(HUGE_VALL) |
489 | return HUGE_VALL; |
490 | # endif |
491 | return HUGE_VAL; |
492 | } |
493 | #endif |
494 | |
495 | #ifndef USE_SFIO |
496 | int |
497 | perlsio_binmode(FILE *fp, int iotype, int mode) |
498 | { |
499 | /* |
500 | * This used to be contents of do_binmode in doio.c |
501 | */ |
502 | #ifdef DOSISH |
503 | # if defined(atarist) || defined(__MINT__) |
504 | if (!fflush(fp)) { |
505 | if (mode & O_BINARY) |
506 | ((FILE *) fp)->_flag |= _IOBIN; |
507 | else |
508 | ((FILE *) fp)->_flag &= ~_IOBIN; |
509 | return 1; |
510 | } |
511 | return 0; |
512 | # else |
513 | dTHX; |
514 | #ifdef NETWARE |
515 | if (PerlLIO_setmode(fp, mode) != -1) { |
516 | #else |
517 | if (PerlLIO_setmode(fileno(fp), mode) != -1) { |
518 | #endif |
519 | # if defined(WIN32) && defined(__BORLANDC__) |
520 | /* |
521 | * The translation mode of the stream is maintained independent |
522 | of |
523 | * the translation mode of the fd in the Borland RTL (heavy |
524 | * digging through their runtime sources reveal). User has to |
525 | set |
526 | * the mode explicitly for the stream (though they don't |
527 | document |
528 | * this anywhere). GSAR 97-5-24 |
529 | */ |
530 | fseek(fp, 0L, 0); |
531 | if (mode & O_BINARY) |
532 | fp->flags |= _F_BIN; |
533 | else |
534 | fp->flags &= ~_F_BIN; |
535 | # endif |
536 | return 1; |
537 | } |
538 | else |
539 | return 0; |
540 | # endif |
541 | #else |
542 | # if defined(USEMYBINMODE) |
543 | dTHX; |
544 | if (my_binmode(fp, iotype, mode) != FALSE) |
545 | return 1; |
546 | else |
547 | return 0; |
548 | # else |
549 | PERL_UNUSED_ARG(fp); |
550 | PERL_UNUSED_ARG(iotype); |
551 | PERL_UNUSED_ARG(mode); |
552 | return 1; |
553 | # endif |
554 | #endif |
555 | } |
556 | #endif /* sfio */ |
557 | |
f2f0f092 |
558 | /* compatibility with versions <= 5.003. */ |
559 | void |
560 | Perl_gv_fullname(pTHX_ SV *sv, const GV *gv) |
561 | { |
562 | gv_fullname3(sv, gv, sv == (const SV*)gv ? "*" : ""); |
563 | } |
564 | |
565 | /* compatibility with versions <= 5.003. */ |
566 | void |
567 | Perl_gv_efullname(pTHX_ SV *sv, const GV *gv) |
568 | { |
569 | gv_efullname3(sv, gv, sv == (const SV*)gv ? "*" : ""); |
570 | } |
571 | |
2674aeec |
572 | void |
573 | Perl_gv_fullname3(pTHX_ SV *sv, const GV *gv, const char *prefix) |
574 | { |
575 | gv_fullname4(sv, gv, prefix, TRUE); |
576 | } |
577 | |
578 | void |
579 | Perl_gv_efullname3(pTHX_ SV *sv, const GV *gv, const char *prefix) |
580 | { |
581 | gv_efullname4(sv, gv, prefix, TRUE); |
582 | } |
583 | |
887986eb |
584 | /* |
585 | =for apidoc gv_fetchmethod |
586 | |
587 | See L<gv_fetchmethod_autoload>. |
588 | |
589 | =cut |
590 | */ |
591 | |
592 | GV * |
593 | Perl_gv_fetchmethod(pTHX_ HV *stash, const char *name) |
594 | { |
595 | return gv_fetchmethod_autoload(stash, name, TRUE); |
596 | } |
597 | |
7a7b9979 |
598 | HE * |
599 | Perl_hv_iternext(pTHX_ HV *hv) |
600 | { |
601 | return hv_iternext_flags(hv, 0); |
602 | } |
603 | |
bc5cdc23 |
604 | void |
605 | Perl_hv_magic(pTHX_ HV *hv, GV *gv, int how) |
606 | { |
607 | sv_magic((SV*)hv, (SV*)gv, how, Nullch, 0); |
608 | } |
609 | |
610 | #if 0 /* use the macro from hv.h instead */ |
611 | |
612 | char* |
613 | Perl_sharepvn(pTHX_ const char *sv, I32 len, U32 hash) |
614 | { |
615 | return HEK_KEY(share_hek(sv, len, hash)); |
616 | } |
617 | |
618 | #endif |
619 | |
b966a812 |
620 | AV * |
621 | Perl_av_fake(pTHX_ register I32 size, register SV **strp) |
622 | { |
623 | register SV** ary; |
624 | register AV * const av = (AV*)NEWSV(9,0); |
625 | |
626 | sv_upgrade((SV *)av, SVt_PVAV); |
627 | Newx(ary,size+1,SV*); |
628 | AvALLOC(av) = ary; |
629 | Copy(strp,ary,size,SV*); |
630 | AvREIFY_only(av); |
631 | SvPV_set(av, (char*)ary); |
632 | AvFILLp(av) = size - 1; |
633 | AvMAX(av) = size - 1; |
634 | while (size--) { |
635 | assert (*strp); |
636 | SvTEMP_off(*strp); |
637 | strp++; |
638 | } |
639 | return av; |
640 | } |
641 | |
34d367cd |
642 | bool |
e4dba786 |
643 | Perl_do_open(pTHX_ GV *gv, register const char *name, I32 len, int as_raw, |
644 | int rawmode, int rawperm, PerlIO *supplied_fp) |
645 | { |
646 | return do_openn(gv, name, len, as_raw, rawmode, rawperm, |
647 | supplied_fp, (SV **) NULL, 0); |
648 | } |
649 | |
650 | bool |
34d367cd |
651 | Perl_do_open9(pTHX_ GV *gv, register const char *name, I32 len, int |
652 | as_raw, |
653 | int rawmode, int rawperm, PerlIO *supplied_fp, SV *svs, |
654 | I32 num_svs) |
655 | { |
656 | PERL_UNUSED_ARG(num_svs); |
657 | return do_openn(gv, name, len, as_raw, rawmode, rawperm, |
658 | supplied_fp, &svs, 1); |
659 | } |
660 | |
661 | int |
662 | Perl_do_binmode(pTHX_ PerlIO *fp, int iotype, int mode) |
663 | { |
664 | /* The old body of this is now in non-LAYER part of perlio.c |
665 | * This is a stub for any XS code which might have been calling it. |
666 | */ |
667 | const char *name = ":raw"; |
668 | #ifdef PERLIO_USING_CRLF |
669 | if (!(mode & O_BINARY)) |
670 | name = ":crlf"; |
671 | #endif |
672 | return PerlIO_binmode(aTHX_ fp, iotype, mode, name); |
673 | } |
674 | |
a9f96b3f |
675 | #ifndef OS2 |
676 | bool |
677 | Perl_do_aexec(pTHX_ SV *really, register SV **mark, register SV **sp) |
678 | { |
679 | return do_aexec5(really, mark, sp, 0, 0); |
680 | } |
681 | #endif |
682 | |
9555a685 |
683 | #ifdef PERL_DEFAULT_DO_EXEC3_IMPLEMENTATION |
684 | bool |
685 | Perl_do_exec(pTHX_ const char *cmd) |
686 | { |
687 | return do_exec3(cmd,0,0); |
688 | } |
689 | #endif |
690 | |
f95f476d |
691 | #ifdef HAS_PIPE |
692 | void |
693 | Perl_do_pipe(pTHX_ SV *sv, GV *rgv, GV *wgv) |
694 | { |
695 | register IO *rstio; |
696 | register IO *wstio; |
697 | int fd[2]; |
698 | |
699 | if (!rgv) |
700 | goto badexit; |
701 | if (!wgv) |
702 | goto badexit; |
703 | |
704 | rstio = GvIOn(rgv); |
705 | wstio = GvIOn(wgv); |
706 | |
707 | if (IoIFP(rstio)) |
708 | do_close(rgv,FALSE); |
709 | if (IoIFP(wstio)) |
710 | do_close(wgv,FALSE); |
711 | |
712 | if (PerlProc_pipe(fd) < 0) |
713 | goto badexit; |
714 | IoIFP(rstio) = PerlIO_fdopen(fd[0], "r"PIPE_OPEN_MODE); |
715 | IoOFP(wstio) = PerlIO_fdopen(fd[1], "w"PIPE_OPEN_MODE); |
716 | IoOFP(rstio) = IoIFP(rstio); |
717 | IoIFP(wstio) = IoOFP(wstio); |
718 | IoTYPE(rstio) = IoTYPE_RDONLY; |
719 | IoTYPE(wstio) = IoTYPE_WRONLY; |
720 | if (!IoIFP(rstio) || !IoOFP(wstio)) { |
721 | if (IoIFP(rstio)) PerlIO_close(IoIFP(rstio)); |
722 | else PerlLIO_close(fd[0]); |
723 | if (IoOFP(wstio)) PerlIO_close(IoOFP(wstio)); |
724 | else PerlLIO_close(fd[1]); |
725 | goto badexit; |
726 | } |
727 | |
728 | sv_setsv(sv,&PL_sv_yes); |
729 | return; |
730 | |
731 | badexit: |
732 | sv_setsv(sv,&PL_sv_undef); |
733 | return; |
734 | } |
735 | #endif |
736 | |
89552e80 |
737 | /* Backwards compatibility. */ |
738 | int |
739 | Perl_init_i18nl14n(pTHX_ int printwarn) |
740 | { |
741 | return init_i18nl10n(printwarn); |
742 | } |
743 | |
ad5d783e |
744 | /* XXX kept for BINCOMPAT only */ |
745 | void |
746 | Perl_save_hints(pTHX) |
747 | { |
748 | Perl_croak(aTHX_ "internal error: obsolete function save_hints() called"); |
749 | } |
750 | |
c78ff979 |
751 | #if 0 |
752 | OP * |
753 | Perl_ck_retarget(pTHX_ OP *o) |
754 | { |
755 | Perl_croak(aTHX_ "NOT IMPL LINE %d",__LINE__); |
756 | /* STUB */ |
757 | return o; |
758 | } |
759 | #endif |
760 | |
761 | OP * |
762 | Perl_oopsCV(pTHX_ OP *o) |
763 | { |
764 | Perl_croak(aTHX_ "NOT IMPL LINE %d",__LINE__); |
765 | /* STUB */ |
766 | PERL_UNUSED_ARG(o); |
767 | NORETURN_FUNCTION_END; |
768 | } |
769 | |
770 | PP(pp_padany) |
771 | { |
772 | DIE(aTHX_ "NOT IMPL LINE %d",__LINE__); |
773 | } |
774 | |
775 | PP(pp_threadsv) |
776 | { |
777 | DIE(aTHX_ "tried to access per-thread data in non-threaded perl"); |
778 | } |
779 | |
780 | PP(pp_mapstart) |
781 | { |
782 | DIE(aTHX_ "panic: mapstart"); /* uses grepstart */ |
783 | } |
784 | |
814fafa7 |
785 | bool |
786 | Perl_is_utf8_string_loc(pTHX_ const U8 *s, STRLEN len, const U8 **ep) |
787 | { |
788 | return is_utf8_string_loclen(s, len, ep, 0); |
789 | } |
790 | |
7ee2227d |
791 | /* |
792 | * Local variables: |
793 | * c-indentation-style: bsd |
794 | * c-basic-offset: 4 |
795 | * indent-tabs-mode: t |
796 | * End: |
797 | * |
798 | * ex: set ts=8 sts=4 sw=4 noet: |
799 | */ |