Add new API function sv_rvunweaken
[perl.git] / reentr.c
1 /* -*- buffer-read-only: t -*-
2  *
3  *    reentr.c
4  *
5  *    Copyright (C) 2002, 2003, 2005, 2006, 2007 by Larry Wall and others
6  *
7  *    You may distribute under the terms of either the GNU General Public
8  *    License or the Artistic License, as specified in the README file.
9  *
10  * !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!!
11  * This file is built by regen/reentr.pl from data in regen/reentr.pl.
12  * Any changes made here will be lost!
13  */
14
15 /*
16  * "Saruman," I said, standing away from him, "only one hand at a time can
17  *  wield the One, and you know that well, so do not trouble to say we!"
18  *
19  *     [p.260 of _The Lord of the Rings_, II/ii: "The Council of Elrond"]
20  */
21
22 /*
23  * This file contains a collection of automatically created wrappers
24  * (created by running reentr.pl) for reentrant (thread-safe) versions of
25  * various library calls, such as getpwent_r.  The wrapping is done so
26  * that other files like pp_sys.c calling those library functions need not
27  * care about the differences between various platforms' idiosyncrasies
28  * regarding these reentrant interfaces.  
29  */
30
31 #include "EXTERN.h"
32 #define PERL_IN_REENTR_C
33 #include "perl.h"
34 #include "reentr.h"
35
36 #define RenewDouble(data_pointer, size_pointer, type) \
37     STMT_START { \
38         const size_t size = *(size_pointer) * 2; \
39         Renew((data_pointer), (size), type); \
40         *(size_pointer) = size; \
41     } STMT_END
42
43 void
44 Perl_reentrant_size(pTHX) {
45         PERL_UNUSED_CONTEXT;
46 #ifdef USE_REENTRANT_API
47 #define REENTRANTSMALLSIZE       256    /* Make something up. */
48 #define REENTRANTUSUALSIZE      4096    /* Make something up. */
49 #ifdef HAS_ASCTIME_R
50         PL_reentrant_buffer->_asctime_size = REENTRANTSMALLSIZE;
51 #endif /* HAS_ASCTIME_R */
52 #ifdef HAS_CRYPT_R
53 #endif /* HAS_CRYPT_R */
54 #ifdef HAS_CTIME_R
55         PL_reentrant_buffer->_ctime_size = REENTRANTSMALLSIZE;
56 #endif /* HAS_CTIME_R */
57 #ifdef HAS_GETGRNAM_R
58 #   if defined(HAS_SYSCONF) && defined(_SC_GETGR_R_SIZE_MAX) && !defined(__GLIBC__)
59         PL_reentrant_buffer->_grent_size = sysconf(_SC_GETGR_R_SIZE_MAX);
60         if (PL_reentrant_buffer->_grent_size == (size_t) -1)
61                 PL_reentrant_buffer->_grent_size = REENTRANTUSUALSIZE;
62 #   else
63 #       if defined(__osf__) && defined(__alpha) && defined(SIABUFSIZ)
64         PL_reentrant_buffer->_grent_size = SIABUFSIZ;
65 #       else
66 #           ifdef __sgi
67         PL_reentrant_buffer->_grent_size = BUFSIZ;
68 #           else
69         PL_reentrant_buffer->_grent_size = REENTRANTUSUALSIZE;
70 #           endif
71 #       endif
72 #   endif 
73 #endif /* HAS_GETGRNAM_R */
74 #ifdef HAS_GETHOSTBYNAME_R
75 #if   !(GETHOSTBYNAME_R_PROTO == REENTRANT_PROTO_I_CSD)
76         PL_reentrant_buffer->_hostent_size = REENTRANTUSUALSIZE;
77 #endif
78 #endif /* HAS_GETHOSTBYNAME_R */
79 #ifdef HAS_GETLOGIN_R
80         PL_reentrant_buffer->_getlogin_size = REENTRANTSMALLSIZE;
81 #endif /* HAS_GETLOGIN_R */
82 #ifdef HAS_GETNETBYNAME_R
83 #if   !(GETNETBYNAME_R_PROTO == REENTRANT_PROTO_I_CSD)
84         PL_reentrant_buffer->_netent_size = REENTRANTUSUALSIZE;
85 #endif
86 #endif /* HAS_GETNETBYNAME_R */
87 #ifdef HAS_GETPROTOBYNAME_R
88 #if   !(GETPROTOBYNAME_R_PROTO == REENTRANT_PROTO_I_CSD)
89         PL_reentrant_buffer->_protoent_size = REENTRANTUSUALSIZE;
90 #endif
91 #endif /* HAS_GETPROTOBYNAME_R */
92 #ifdef HAS_GETPWNAM_R
93 #   if defined(HAS_SYSCONF) && defined(_SC_GETPW_R_SIZE_MAX) && !defined(__GLIBC__)
94         PL_reentrant_buffer->_pwent_size = sysconf(_SC_GETPW_R_SIZE_MAX);
95         if (PL_reentrant_buffer->_pwent_size == (size_t) -1)
96                 PL_reentrant_buffer->_pwent_size = REENTRANTUSUALSIZE;
97 #   else
98 #       if defined(__osf__) && defined(__alpha) && defined(SIABUFSIZ)
99         PL_reentrant_buffer->_pwent_size = SIABUFSIZ;
100 #       else
101 #           ifdef __sgi
102         PL_reentrant_buffer->_pwent_size = BUFSIZ;
103 #           else
104         PL_reentrant_buffer->_pwent_size = REENTRANTUSUALSIZE;
105 #           endif
106 #       endif
107 #   endif 
108 #endif /* HAS_GETPWNAM_R */
109 #ifdef HAS_GETSERVBYNAME_R
110 #if   !(GETSERVBYNAME_R_PROTO == REENTRANT_PROTO_I_CCSD)
111         PL_reentrant_buffer->_servent_size = REENTRANTUSUALSIZE;
112 #endif
113 #endif /* HAS_GETSERVBYNAME_R */
114 #ifdef HAS_GETSPNAM_R
115 #   if defined(HAS_SYSCONF) && defined(_SC_GETPW_R_SIZE_MAX) && !defined(__GLIBC__)
116         PL_reentrant_buffer->_spent_size = sysconf(_SC_GETPW_R_SIZE_MAX);
117         if (PL_reentrant_buffer->_spent_size == (size_t) -1)
118                 PL_reentrant_buffer->_spent_size = REENTRANTUSUALSIZE;
119 #   else
120 #       if defined(__osf__) && defined(__alpha) && defined(SIABUFSIZ)
121         PL_reentrant_buffer->_spent_size = SIABUFSIZ;
122 #       else
123 #           ifdef __sgi
124         PL_reentrant_buffer->_spent_size = BUFSIZ;
125 #           else
126         PL_reentrant_buffer->_spent_size = REENTRANTUSUALSIZE;
127 #           endif
128 #       endif
129 #   endif 
130 #endif /* HAS_GETSPNAM_R */
131 #ifdef HAS_READDIR_R
132         /* This is the size Solaris recommends.
133          * (though we go static, should use pathconf() instead) */
134         PL_reentrant_buffer->_readdir_size = sizeof(struct dirent) + MAXPATHLEN + 1;
135 #endif /* HAS_READDIR_R */
136 #ifdef HAS_READDIR64_R
137         /* This is the size Solaris recommends.
138          * (though we go static, should use pathconf() instead) */
139         PL_reentrant_buffer->_readdir64_size = sizeof(struct dirent64) + MAXPATHLEN + 1;
140 #endif /* HAS_READDIR64_R */
141 #ifdef HAS_SETLOCALE_R
142         PL_reentrant_buffer->_setlocale_size = REENTRANTSMALLSIZE;
143 #endif /* HAS_SETLOCALE_R */
144 #ifdef HAS_STRERROR_R
145         PL_reentrant_buffer->_strerror_size = REENTRANTSMALLSIZE;
146 #endif /* HAS_STRERROR_R */
147 #ifdef HAS_TTYNAME_R
148         PL_reentrant_buffer->_ttyname_size = REENTRANTSMALLSIZE;
149 #endif /* HAS_TTYNAME_R */
150
151 #endif /* USE_REENTRANT_API */
152 }
153
154 void
155 Perl_reentrant_init(pTHX) {
156         PERL_UNUSED_CONTEXT;
157 #ifdef USE_REENTRANT_API
158         Newx(PL_reentrant_buffer, 1, REENTR);
159         Perl_reentrant_size(aTHX);
160 #ifdef HAS_ASCTIME_R
161         Newx(PL_reentrant_buffer->_asctime_buffer, PL_reentrant_buffer->_asctime_size, char);
162 #endif /* HAS_ASCTIME_R */
163 #ifdef HAS_CRYPT_R
164 #if CRYPT_R_PROTO != REENTRANT_PROTO_B_CCD
165         PL_reentrant_buffer->_crypt_struct_buffer = 0;
166 #endif
167 #endif /* HAS_CRYPT_R */
168 #ifdef HAS_CTIME_R
169         Newx(PL_reentrant_buffer->_ctime_buffer, PL_reentrant_buffer->_ctime_size, char);
170 #endif /* HAS_CTIME_R */
171 #ifdef HAS_GETGRNAM_R
172 #   ifdef USE_GRENT_FPTR
173         PL_reentrant_buffer->_grent_fptr = NULL;
174 #   endif
175         Newx(PL_reentrant_buffer->_grent_buffer, PL_reentrant_buffer->_grent_size, char);
176 #endif /* HAS_GETGRNAM_R */
177 #ifdef HAS_GETHOSTBYNAME_R
178 #if   !(GETHOSTBYNAME_R_PROTO == REENTRANT_PROTO_I_CSD)
179         Newx(PL_reentrant_buffer->_hostent_buffer, PL_reentrant_buffer->_hostent_size, char);
180 #endif
181 #endif /* HAS_GETHOSTBYNAME_R */
182 #ifdef HAS_GETLOGIN_R
183         Newx(PL_reentrant_buffer->_getlogin_buffer, PL_reentrant_buffer->_getlogin_size, char);
184 #endif /* HAS_GETLOGIN_R */
185 #ifdef HAS_GETNETBYNAME_R
186 #if   !(GETNETBYNAME_R_PROTO == REENTRANT_PROTO_I_CSD)
187         Newx(PL_reentrant_buffer->_netent_buffer, PL_reentrant_buffer->_netent_size, char);
188 #endif
189 #endif /* HAS_GETNETBYNAME_R */
190 #ifdef HAS_GETPROTOBYNAME_R
191 #if   !(GETPROTOBYNAME_R_PROTO == REENTRANT_PROTO_I_CSD)
192         Newx(PL_reentrant_buffer->_protoent_buffer, PL_reentrant_buffer->_protoent_size, char);
193 #endif
194 #endif /* HAS_GETPROTOBYNAME_R */
195 #ifdef HAS_GETPWNAM_R
196 #   ifdef USE_PWENT_FPTR
197         PL_reentrant_buffer->_pwent_fptr = NULL;
198 #   endif
199         Newx(PL_reentrant_buffer->_pwent_buffer, PL_reentrant_buffer->_pwent_size, char);
200 #endif /* HAS_GETPWNAM_R */
201 #ifdef HAS_GETSERVBYNAME_R
202 #if   !(GETSERVBYNAME_R_PROTO == REENTRANT_PROTO_I_CCSD)
203         Newx(PL_reentrant_buffer->_servent_buffer, PL_reentrant_buffer->_servent_size, char);
204 #endif
205 #endif /* HAS_GETSERVBYNAME_R */
206 #ifdef HAS_GETSPNAM_R
207 #   ifdef USE_SPENT_FPTR
208         PL_reentrant_buffer->_spent_fptr = NULL;
209 #   endif
210         Newx(PL_reentrant_buffer->_spent_buffer, PL_reentrant_buffer->_spent_size, char);
211 #endif /* HAS_GETSPNAM_R */
212 #ifdef HAS_READDIR_R
213         PL_reentrant_buffer->_readdir_struct = (struct dirent*)safemalloc(PL_reentrant_buffer->_readdir_size);
214 #endif /* HAS_READDIR_R */
215 #ifdef HAS_READDIR64_R
216         PL_reentrant_buffer->_readdir64_struct = (struct dirent64*)safemalloc(PL_reentrant_buffer->_readdir64_size);
217 #endif /* HAS_READDIR64_R */
218 #ifdef HAS_SETLOCALE_R
219         Newx(PL_reentrant_buffer->_setlocale_buffer, PL_reentrant_buffer->_setlocale_size, char);
220 #endif /* HAS_SETLOCALE_R */
221 #ifdef HAS_STRERROR_R
222         Newx(PL_reentrant_buffer->_strerror_buffer, PL_reentrant_buffer->_strerror_size, char);
223 #endif /* HAS_STRERROR_R */
224 #ifdef HAS_TTYNAME_R
225         Newx(PL_reentrant_buffer->_ttyname_buffer, PL_reentrant_buffer->_ttyname_size, char);
226 #endif /* HAS_TTYNAME_R */
227
228 #endif /* USE_REENTRANT_API */
229 }
230
231 void
232 Perl_reentrant_free(pTHX) {
233         PERL_UNUSED_CONTEXT;
234 #ifdef USE_REENTRANT_API
235 #ifdef HAS_ASCTIME_R
236         Safefree(PL_reentrant_buffer->_asctime_buffer);
237 #endif /* HAS_ASCTIME_R */
238 #ifdef HAS_CRYPT_R
239 #if CRYPT_R_PROTO != REENTRANT_PROTO_B_CCD
240         Safefree(PL_reentrant_buffer->_crypt_struct_buffer);
241 #endif
242 #endif /* HAS_CRYPT_R */
243 #ifdef HAS_CTIME_R
244         Safefree(PL_reentrant_buffer->_ctime_buffer);
245 #endif /* HAS_CTIME_R */
246 #ifdef HAS_GETGRNAM_R
247         Safefree(PL_reentrant_buffer->_grent_buffer);
248 #endif /* HAS_GETGRNAM_R */
249 #ifdef HAS_GETHOSTBYNAME_R
250 #if   !(GETHOSTBYNAME_R_PROTO == REENTRANT_PROTO_I_CSD)
251         Safefree(PL_reentrant_buffer->_hostent_buffer);
252 #endif
253 #endif /* HAS_GETHOSTBYNAME_R */
254 #ifdef HAS_GETLOGIN_R
255         Safefree(PL_reentrant_buffer->_getlogin_buffer);
256 #endif /* HAS_GETLOGIN_R */
257 #ifdef HAS_GETNETBYNAME_R
258 #if   !(GETNETBYNAME_R_PROTO == REENTRANT_PROTO_I_CSD)
259         Safefree(PL_reentrant_buffer->_netent_buffer);
260 #endif
261 #endif /* HAS_GETNETBYNAME_R */
262 #ifdef HAS_GETPROTOBYNAME_R
263 #if   !(GETPROTOBYNAME_R_PROTO == REENTRANT_PROTO_I_CSD)
264         Safefree(PL_reentrant_buffer->_protoent_buffer);
265 #endif
266 #endif /* HAS_GETPROTOBYNAME_R */
267 #ifdef HAS_GETPWNAM_R
268         Safefree(PL_reentrant_buffer->_pwent_buffer);
269 #endif /* HAS_GETPWNAM_R */
270 #ifdef HAS_GETSERVBYNAME_R
271 #if   !(GETSERVBYNAME_R_PROTO == REENTRANT_PROTO_I_CCSD)
272         Safefree(PL_reentrant_buffer->_servent_buffer);
273 #endif
274 #endif /* HAS_GETSERVBYNAME_R */
275 #ifdef HAS_GETSPNAM_R
276         Safefree(PL_reentrant_buffer->_spent_buffer);
277 #endif /* HAS_GETSPNAM_R */
278 #ifdef HAS_READDIR_R
279         Safefree(PL_reentrant_buffer->_readdir_struct);
280 #endif /* HAS_READDIR_R */
281 #ifdef HAS_READDIR64_R
282         Safefree(PL_reentrant_buffer->_readdir64_struct);
283 #endif /* HAS_READDIR64_R */
284 #ifdef HAS_SETLOCALE_R
285         Safefree(PL_reentrant_buffer->_setlocale_buffer);
286 #endif /* HAS_SETLOCALE_R */
287 #ifdef HAS_STRERROR_R
288         Safefree(PL_reentrant_buffer->_strerror_buffer);
289 #endif /* HAS_STRERROR_R */
290 #ifdef HAS_TTYNAME_R
291         Safefree(PL_reentrant_buffer->_ttyname_buffer);
292 #endif /* HAS_TTYNAME_R */
293
294         Safefree(PL_reentrant_buffer);
295 #endif /* USE_REENTRANT_API */
296 }
297
298 void*
299 Perl_reentrant_retry(const char *f, ...)
300 {
301     void *retptr = NULL;
302     va_list ap;
303 #ifdef USE_REENTRANT_API
304     dTHX;
305     /* Easier to special case this here than in embed.pl. (Look at what it
306        generates for proto.h) */
307     PERL_ARGS_ASSERT_REENTRANT_RETRY;
308 #endif
309     va_start(ap, f);
310     {
311 #ifdef USE_REENTRANT_API
312 #  if defined(USE_HOSTENT_BUFFER) || defined(USE_GRENT_BUFFER) || defined(USE_NETENT_BUFFER) || defined(USE_PWENT_BUFFER) || defined(USE_PROTOENT_BUFFER) || defined(USE_SERVENT_BUFFER)
313     void *p0;
314 #  endif
315 #  if defined(USE_SERVENT_BUFFER)
316     void *p1;
317 #  endif
318 #  if defined(USE_HOSTENT_BUFFER)
319     size_t asize;
320 #  endif
321 #  if defined(USE_HOSTENT_BUFFER) || defined(USE_NETENT_BUFFER) || defined(USE_PROTOENT_BUFFER) || defined(USE_SERVENT_BUFFER)
322     int anint;
323 #  endif
324
325     switch (PL_op->op_type) {
326 #ifdef USE_HOSTENT_BUFFER
327     case OP_GHBYADDR:
328     case OP_GHBYNAME:
329     case OP_GHOSTENT:
330         {
331 #ifdef PERL_REENTRANT_MAXSIZE
332             if (PL_reentrant_buffer->_hostent_size <=
333                 PERL_REENTRANT_MAXSIZE / 2)
334 #endif
335             {
336                 RenewDouble(PL_reentrant_buffer->_hostent_buffer,
337                         &PL_reentrant_buffer->_hostent_size, char);
338                 switch (PL_op->op_type) {
339                 case OP_GHBYADDR:
340                     p0    = va_arg(ap, void *);
341                     asize = va_arg(ap, size_t);
342                     anint  = va_arg(ap, int);
343                     retptr = gethostbyaddr(p0, asize, anint); break;
344                 case OP_GHBYNAME:
345                     p0 = va_arg(ap, void *);
346                     retptr = gethostbyname((char *)p0); break;
347                 case OP_GHOSTENT:
348                     retptr = gethostent(); break;
349                 default:
350                     SETERRNO(ERANGE, LIB_INVARG);
351                     break;
352                 }
353             }
354         }
355         break;
356 #endif
357 #ifdef USE_GRENT_BUFFER
358     case OP_GGRNAM:
359     case OP_GGRGID:
360     case OP_GGRENT:
361         {
362 #ifdef PERL_REENTRANT_MAXSIZE
363             if (PL_reentrant_buffer->_grent_size <=
364                 PERL_REENTRANT_MAXSIZE / 2)
365 #endif
366             {
367                 Gid_t gid;
368                 RenewDouble(PL_reentrant_buffer->_grent_buffer,
369                       &PL_reentrant_buffer->_grent_size, char);
370                 switch (PL_op->op_type) {
371                 case OP_GGRNAM:
372                     p0 = va_arg(ap, void *);
373                     retptr = getgrnam((char *)p0); break;
374                 case OP_GGRGID:
375 #if Gid_t_size < INTSIZE
376                     gid = (Gid_t)va_arg(ap, int);
377 #else
378                     gid = va_arg(ap, Gid_t);
379 #endif
380                     retptr = getgrgid(gid); break;
381                 case OP_GGRENT:
382                     retptr = getgrent(); break;
383                 default:
384                     SETERRNO(ERANGE, LIB_INVARG);
385                     break;
386                 }
387             }
388         }
389         break;
390 #endif
391 #ifdef USE_NETENT_BUFFER
392     case OP_GNBYADDR:
393     case OP_GNBYNAME:
394     case OP_GNETENT:
395         {
396 #ifdef PERL_REENTRANT_MAXSIZE
397             if (PL_reentrant_buffer->_netent_size <=
398                 PERL_REENTRANT_MAXSIZE / 2)
399 #endif
400             {
401                 Netdb_net_t net;
402                 RenewDouble(PL_reentrant_buffer->_netent_buffer,
403                       &PL_reentrant_buffer->_netent_size, char);
404                 switch (PL_op->op_type) {
405                 case OP_GNBYADDR:
406                     net = va_arg(ap, Netdb_net_t);
407                     anint = va_arg(ap, int);
408                     retptr = getnetbyaddr(net, anint); break;
409                 case OP_GNBYNAME:
410                     p0 = va_arg(ap, void *);
411                     retptr = getnetbyname((char *)p0); break;
412                 case OP_GNETENT:
413                     retptr = getnetent(); break;
414                 default:
415                     SETERRNO(ERANGE, LIB_INVARG);
416                     break;
417                 }
418             }
419         }
420         break;
421 #endif
422 #ifdef USE_PWENT_BUFFER
423     case OP_GPWNAM:
424     case OP_GPWUID:
425     case OP_GPWENT:
426         {
427 #ifdef PERL_REENTRANT_MAXSIZE
428             if (PL_reentrant_buffer->_pwent_size <=
429                 PERL_REENTRANT_MAXSIZE / 2)
430 #endif
431             {
432                 Uid_t uid;
433                 RenewDouble(PL_reentrant_buffer->_pwent_buffer,
434                       &PL_reentrant_buffer->_pwent_size, char);
435                 switch (PL_op->op_type) {
436                 case OP_GPWNAM:
437                     p0 = va_arg(ap, void *);
438                     retptr = getpwnam((char *)p0); break;
439                 case OP_GPWUID:
440 #if Uid_t_size < INTSIZE
441                     uid = (Uid_t)va_arg(ap, int);
442 #else
443                     uid = va_arg(ap, Uid_t);
444 #endif
445                     retptr = getpwuid(uid); break;
446 #if defined(HAS_GETPWENT) || defined(HAS_GETPWENT_R)
447                 case OP_GPWENT:
448                     retptr = getpwent(); break;
449 #endif
450                 default:
451                     SETERRNO(ERANGE, LIB_INVARG);
452                     break;
453                 }
454             }
455         }
456         break;
457 #endif
458 #ifdef USE_PROTOENT_BUFFER
459     case OP_GPBYNAME:
460     case OP_GPBYNUMBER:
461     case OP_GPROTOENT:
462         {
463 #ifdef PERL_REENTRANT_MAXSIZE
464             if (PL_reentrant_buffer->_protoent_size <=
465                 PERL_REENTRANT_MAXSIZE / 2)
466 #endif
467             {
468                 RenewDouble(PL_reentrant_buffer->_protoent_buffer,
469                       &PL_reentrant_buffer->_protoent_size, char);
470                 switch (PL_op->op_type) {
471                 case OP_GPBYNAME:
472                     p0 = va_arg(ap, void *);
473                     retptr = getprotobyname((char *)p0); break;
474                 case OP_GPBYNUMBER:
475                     anint = va_arg(ap, int);
476                     retptr = getprotobynumber(anint); break;
477                 case OP_GPROTOENT:
478                     retptr = getprotoent(); break;
479                 default:
480                     SETERRNO(ERANGE, LIB_INVARG);
481                     break;
482                 }
483             }
484         }
485         break;
486 #endif
487 #ifdef USE_SERVENT_BUFFER
488     case OP_GSBYNAME:
489     case OP_GSBYPORT:
490     case OP_GSERVENT:
491         {
492 #ifdef PERL_REENTRANT_MAXSIZE
493             if (PL_reentrant_buffer->_servent_size <=
494                 PERL_REENTRANT_MAXSIZE / 2)
495 #endif
496             {
497                 RenewDouble(PL_reentrant_buffer->_servent_buffer,
498                       &PL_reentrant_buffer->_servent_size, char);
499                 switch (PL_op->op_type) {
500                 case OP_GSBYNAME:
501                     p0 = va_arg(ap, void *);
502                     p1 = va_arg(ap, void *);
503                     retptr = getservbyname((char *)p0, (char *)p1); break;
504                 case OP_GSBYPORT:
505                     anint = va_arg(ap, int);
506                     p0 = va_arg(ap, void *);
507                     retptr = getservbyport(anint, (char *)p0); break;
508                 case OP_GSERVENT:
509                     retptr = getservent(); break;
510                 default:
511                     SETERRNO(ERANGE, LIB_INVARG);
512                     break;
513                 }
514             }
515         }
516         break;
517 #endif
518     default:
519         /* Not known how to retry, so just fail. */
520         break;
521     }
522 #else
523     PERL_UNUSED_ARG(f);
524 #endif
525     }
526     va_end(ap);
527     return retptr;
528 }
529
530 /* ex: set ro: */