utf8.c: White-space only
[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 #   elif defined(__osf__) && defined(__alpha) && defined(SIABUFSIZ)
63         PL_reentrant_buffer->_grent_size = SIABUFSIZ;
64 #   elif defined(__sgi)
65         PL_reentrant_buffer->_grent_size = BUFSIZ;
66 #   else
67         PL_reentrant_buffer->_grent_size = REENTRANTUSUALSIZE;
68 #   endif 
69 #endif /* HAS_GETGRNAM_R */
70 #ifdef HAS_GETHOSTBYNAME_R
71 #if   !(GETHOSTBYNAME_R_PROTO == REENTRANT_PROTO_I_CSD)
72         PL_reentrant_buffer->_hostent_size = REENTRANTUSUALSIZE;
73 #endif
74 #endif /* HAS_GETHOSTBYNAME_R */
75 #ifdef HAS_GETLOGIN_R
76         PL_reentrant_buffer->_getlogin_size = REENTRANTSMALLSIZE;
77 #endif /* HAS_GETLOGIN_R */
78 #ifdef HAS_GETNETBYNAME_R
79 #if   !(GETNETBYNAME_R_PROTO == REENTRANT_PROTO_I_CSD)
80         PL_reentrant_buffer->_netent_size = REENTRANTUSUALSIZE;
81 #endif
82 #endif /* HAS_GETNETBYNAME_R */
83 #ifdef HAS_GETPROTOBYNAME_R
84 #if   !(GETPROTOBYNAME_R_PROTO == REENTRANT_PROTO_I_CSD)
85         PL_reentrant_buffer->_protoent_size = REENTRANTUSUALSIZE;
86 #endif
87 #endif /* HAS_GETPROTOBYNAME_R */
88 #ifdef HAS_GETPWNAM_R
89 #   if defined(HAS_SYSCONF) && defined(_SC_GETPW_R_SIZE_MAX) && !defined(__GLIBC__)
90         PL_reentrant_buffer->_pwent_size = sysconf(_SC_GETPW_R_SIZE_MAX);
91         if (PL_reentrant_buffer->_pwent_size == (size_t) -1)
92                 PL_reentrant_buffer->_pwent_size = REENTRANTUSUALSIZE;
93 #   elif defined(__osf__) && defined(__alpha) && defined(SIABUFSIZ)
94         PL_reentrant_buffer->_pwent_size = SIABUFSIZ;
95 #   elif defined(__sgi)
96         PL_reentrant_buffer->_pwent_size = BUFSIZ;
97 #   else
98         PL_reentrant_buffer->_pwent_size = REENTRANTUSUALSIZE;
99 #   endif 
100 #endif /* HAS_GETPWNAM_R */
101 #ifdef HAS_GETSERVBYNAME_R
102 #if   !(GETSERVBYNAME_R_PROTO == REENTRANT_PROTO_I_CCSD)
103         PL_reentrant_buffer->_servent_size = REENTRANTUSUALSIZE;
104 #endif
105 #endif /* HAS_GETSERVBYNAME_R */
106 #ifdef HAS_GETSPNAM_R
107 #   if defined(HAS_SYSCONF) && defined(_SC_GETPW_R_SIZE_MAX) && !defined(__GLIBC__)
108         PL_reentrant_buffer->_spent_size = sysconf(_SC_GETPW_R_SIZE_MAX);
109         if (PL_reentrant_buffer->_spent_size == (size_t) -1)
110                 PL_reentrant_buffer->_spent_size = REENTRANTUSUALSIZE;
111 #   elif defined(__osf__) && defined(__alpha) && defined(SIABUFSIZ)
112         PL_reentrant_buffer->_spent_size = SIABUFSIZ;
113 #   elif defined(__sgi)
114         PL_reentrant_buffer->_spent_size = BUFSIZ;
115 #   else
116         PL_reentrant_buffer->_spent_size = REENTRANTUSUALSIZE;
117 #   endif 
118 #endif /* HAS_GETSPNAM_R */
119 #ifdef HAS_READDIR_R
120         /* This is the size Solaris recommends.
121          * (though we go static, should use pathconf() instead) */
122         PL_reentrant_buffer->_readdir_size = sizeof(struct dirent) + MAXPATHLEN + 1;
123 #endif /* HAS_READDIR_R */
124 #ifdef HAS_READDIR64_R
125         /* This is the size Solaris recommends.
126          * (though we go static, should use pathconf() instead) */
127         PL_reentrant_buffer->_readdir64_size = sizeof(struct dirent64) + MAXPATHLEN + 1;
128 #endif /* HAS_READDIR64_R */
129 #ifdef HAS_SETLOCALE_R
130         PL_reentrant_buffer->_setlocale_size = REENTRANTSMALLSIZE;
131 #endif /* HAS_SETLOCALE_R */
132 #ifdef HAS_STRERROR_R
133         PL_reentrant_buffer->_strerror_size = REENTRANTSMALLSIZE;
134 #endif /* HAS_STRERROR_R */
135 #ifdef HAS_TTYNAME_R
136         PL_reentrant_buffer->_ttyname_size = REENTRANTSMALLSIZE;
137 #endif /* HAS_TTYNAME_R */
138
139 #endif /* USE_REENTRANT_API */
140 }
141
142 void
143 Perl_reentrant_init(pTHX) {
144         PERL_UNUSED_CONTEXT;
145 #ifdef USE_REENTRANT_API
146         Newx(PL_reentrant_buffer, 1, REENTR);
147         Perl_reentrant_size(aTHX);
148 #ifdef HAS_ASCTIME_R
149         Newx(PL_reentrant_buffer->_asctime_buffer, PL_reentrant_buffer->_asctime_size, char);
150 #endif /* HAS_ASCTIME_R */
151 #ifdef HAS_CRYPT_R
152 #if CRYPT_R_PROTO != REENTRANT_PROTO_B_CCD
153         PL_reentrant_buffer->_crypt_struct_buffer = 0;
154 #endif
155 #endif /* HAS_CRYPT_R */
156 #ifdef HAS_CTIME_R
157         Newx(PL_reentrant_buffer->_ctime_buffer, PL_reentrant_buffer->_ctime_size, char);
158 #endif /* HAS_CTIME_R */
159 #ifdef HAS_GETGRNAM_R
160 #   ifdef USE_GRENT_FPTR
161         PL_reentrant_buffer->_grent_fptr = NULL;
162 #   endif
163         Newx(PL_reentrant_buffer->_grent_buffer, PL_reentrant_buffer->_grent_size, char);
164 #endif /* HAS_GETGRNAM_R */
165 #ifdef HAS_GETHOSTBYNAME_R
166 #if   !(GETHOSTBYNAME_R_PROTO == REENTRANT_PROTO_I_CSD)
167         Newx(PL_reentrant_buffer->_hostent_buffer, PL_reentrant_buffer->_hostent_size, char);
168 #endif
169 #endif /* HAS_GETHOSTBYNAME_R */
170 #ifdef HAS_GETLOGIN_R
171         Newx(PL_reentrant_buffer->_getlogin_buffer, PL_reentrant_buffer->_getlogin_size, char);
172 #endif /* HAS_GETLOGIN_R */
173 #ifdef HAS_GETNETBYNAME_R
174 #if   !(GETNETBYNAME_R_PROTO == REENTRANT_PROTO_I_CSD)
175         Newx(PL_reentrant_buffer->_netent_buffer, PL_reentrant_buffer->_netent_size, char);
176 #endif
177 #endif /* HAS_GETNETBYNAME_R */
178 #ifdef HAS_GETPROTOBYNAME_R
179 #if   !(GETPROTOBYNAME_R_PROTO == REENTRANT_PROTO_I_CSD)
180         Newx(PL_reentrant_buffer->_protoent_buffer, PL_reentrant_buffer->_protoent_size, char);
181 #endif
182 #endif /* HAS_GETPROTOBYNAME_R */
183 #ifdef HAS_GETPWNAM_R
184 #   ifdef USE_PWENT_FPTR
185         PL_reentrant_buffer->_pwent_fptr = NULL;
186 #   endif
187         Newx(PL_reentrant_buffer->_pwent_buffer, PL_reentrant_buffer->_pwent_size, char);
188 #endif /* HAS_GETPWNAM_R */
189 #ifdef HAS_GETSERVBYNAME_R
190 #if   !(GETSERVBYNAME_R_PROTO == REENTRANT_PROTO_I_CCSD)
191         Newx(PL_reentrant_buffer->_servent_buffer, PL_reentrant_buffer->_servent_size, char);
192 #endif
193 #endif /* HAS_GETSERVBYNAME_R */
194 #ifdef HAS_GETSPNAM_R
195 #   ifdef USE_SPENT_FPTR
196         PL_reentrant_buffer->_spent_fptr = NULL;
197 #   endif
198         Newx(PL_reentrant_buffer->_spent_buffer, PL_reentrant_buffer->_spent_size, char);
199 #endif /* HAS_GETSPNAM_R */
200 #ifdef HAS_READDIR_R
201         PL_reentrant_buffer->_readdir_struct = (struct dirent*)safemalloc(PL_reentrant_buffer->_readdir_size);
202 #endif /* HAS_READDIR_R */
203 #ifdef HAS_READDIR64_R
204         PL_reentrant_buffer->_readdir64_struct = (struct dirent64*)safemalloc(PL_reentrant_buffer->_readdir64_size);
205 #endif /* HAS_READDIR64_R */
206 #ifdef HAS_SETLOCALE_R
207         Newx(PL_reentrant_buffer->_setlocale_buffer, PL_reentrant_buffer->_setlocale_size, char);
208 #endif /* HAS_SETLOCALE_R */
209 #ifdef HAS_STRERROR_R
210         Newx(PL_reentrant_buffer->_strerror_buffer, PL_reentrant_buffer->_strerror_size, char);
211 #endif /* HAS_STRERROR_R */
212 #ifdef HAS_TTYNAME_R
213         Newx(PL_reentrant_buffer->_ttyname_buffer, PL_reentrant_buffer->_ttyname_size, char);
214 #endif /* HAS_TTYNAME_R */
215
216 #endif /* USE_REENTRANT_API */
217 }
218
219 void
220 Perl_reentrant_free(pTHX) {
221         PERL_UNUSED_CONTEXT;
222 #ifdef USE_REENTRANT_API
223 #ifdef HAS_ASCTIME_R
224         Safefree(PL_reentrant_buffer->_asctime_buffer);
225 #endif /* HAS_ASCTIME_R */
226 #ifdef HAS_CRYPT_R
227 #if CRYPT_R_PROTO != REENTRANT_PROTO_B_CCD
228         Safefree(PL_reentrant_buffer->_crypt_struct_buffer);
229 #endif
230 #endif /* HAS_CRYPT_R */
231 #ifdef HAS_CTIME_R
232         Safefree(PL_reentrant_buffer->_ctime_buffer);
233 #endif /* HAS_CTIME_R */
234 #ifdef HAS_GETGRNAM_R
235         Safefree(PL_reentrant_buffer->_grent_buffer);
236 #endif /* HAS_GETGRNAM_R */
237 #ifdef HAS_GETHOSTBYNAME_R
238 #if   !(GETHOSTBYNAME_R_PROTO == REENTRANT_PROTO_I_CSD)
239         Safefree(PL_reentrant_buffer->_hostent_buffer);
240 #endif
241 #endif /* HAS_GETHOSTBYNAME_R */
242 #ifdef HAS_GETLOGIN_R
243         Safefree(PL_reentrant_buffer->_getlogin_buffer);
244 #endif /* HAS_GETLOGIN_R */
245 #ifdef HAS_GETNETBYNAME_R
246 #if   !(GETNETBYNAME_R_PROTO == REENTRANT_PROTO_I_CSD)
247         Safefree(PL_reentrant_buffer->_netent_buffer);
248 #endif
249 #endif /* HAS_GETNETBYNAME_R */
250 #ifdef HAS_GETPROTOBYNAME_R
251 #if   !(GETPROTOBYNAME_R_PROTO == REENTRANT_PROTO_I_CSD)
252         Safefree(PL_reentrant_buffer->_protoent_buffer);
253 #endif
254 #endif /* HAS_GETPROTOBYNAME_R */
255 #ifdef HAS_GETPWNAM_R
256         Safefree(PL_reentrant_buffer->_pwent_buffer);
257 #endif /* HAS_GETPWNAM_R */
258 #ifdef HAS_GETSERVBYNAME_R
259 #if   !(GETSERVBYNAME_R_PROTO == REENTRANT_PROTO_I_CCSD)
260         Safefree(PL_reentrant_buffer->_servent_buffer);
261 #endif
262 #endif /* HAS_GETSERVBYNAME_R */
263 #ifdef HAS_GETSPNAM_R
264         Safefree(PL_reentrant_buffer->_spent_buffer);
265 #endif /* HAS_GETSPNAM_R */
266 #ifdef HAS_READDIR_R
267         Safefree(PL_reentrant_buffer->_readdir_struct);
268 #endif /* HAS_READDIR_R */
269 #ifdef HAS_READDIR64_R
270         Safefree(PL_reentrant_buffer->_readdir64_struct);
271 #endif /* HAS_READDIR64_R */
272 #ifdef HAS_SETLOCALE_R
273         Safefree(PL_reentrant_buffer->_setlocale_buffer);
274 #endif /* HAS_SETLOCALE_R */
275 #ifdef HAS_STRERROR_R
276         Safefree(PL_reentrant_buffer->_strerror_buffer);
277 #endif /* HAS_STRERROR_R */
278 #ifdef HAS_TTYNAME_R
279         Safefree(PL_reentrant_buffer->_ttyname_buffer);
280 #endif /* HAS_TTYNAME_R */
281
282         Safefree(PL_reentrant_buffer);
283 #endif /* USE_REENTRANT_API */
284 }
285
286 void*
287 Perl_reentrant_retry(const char *f, ...)
288 {
289     void *retptr = NULL;
290     va_list ap;
291 #ifdef USE_REENTRANT_API
292     dTHX;
293     /* Easier to special case this here than in embed.pl. (Look at what it
294        generates for proto.h) */
295     PERL_ARGS_ASSERT_REENTRANT_RETRY;
296 #endif
297     va_start(ap, f);
298     {
299 #ifdef USE_REENTRANT_API
300 #  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)
301     void *p0;
302 #  endif
303 #  if defined(USE_SERVENT_BUFFER)
304     void *p1;
305 #  endif
306 #  if defined(USE_HOSTENT_BUFFER)
307     size_t asize;
308 #  endif
309 #  if defined(USE_HOSTENT_BUFFER) || defined(USE_NETENT_BUFFER) || defined(USE_PROTOENT_BUFFER) || defined(USE_SERVENT_BUFFER)
310     int anint;
311 #  endif
312
313     switch (PL_op->op_type) {
314 #ifdef USE_HOSTENT_BUFFER
315     case OP_GHBYADDR:
316     case OP_GHBYNAME:
317     case OP_GHOSTENT:
318         {
319 #ifdef PERL_REENTRANT_MAXSIZE
320             if (PL_reentrant_buffer->_hostent_size <=
321                 PERL_REENTRANT_MAXSIZE / 2)
322 #endif
323             {
324                 RenewDouble(PL_reentrant_buffer->_hostent_buffer,
325                         &PL_reentrant_buffer->_hostent_size, char);
326                 switch (PL_op->op_type) {
327                 case OP_GHBYADDR:
328                     p0    = va_arg(ap, void *);
329                     asize = va_arg(ap, size_t);
330                     anint  = va_arg(ap, int);
331                     retptr = gethostbyaddr(p0, asize, anint); break;
332                 case OP_GHBYNAME:
333                     p0 = va_arg(ap, void *);
334                     retptr = gethostbyname((char *)p0); break;
335                 case OP_GHOSTENT:
336                     retptr = gethostent(); break;
337                 default:
338                     SETERRNO(ERANGE, LIB_INVARG);
339                     break;
340                 }
341             }
342         }
343         break;
344 #endif
345 #ifdef USE_GRENT_BUFFER
346     case OP_GGRNAM:
347     case OP_GGRGID:
348     case OP_GGRENT:
349         {
350 #ifdef PERL_REENTRANT_MAXSIZE
351             if (PL_reentrant_buffer->_grent_size <=
352                 PERL_REENTRANT_MAXSIZE / 2)
353 #endif
354             {
355                 Gid_t gid;
356                 RenewDouble(PL_reentrant_buffer->_grent_buffer,
357                       &PL_reentrant_buffer->_grent_size, char);
358                 switch (PL_op->op_type) {
359                 case OP_GGRNAM:
360                     p0 = va_arg(ap, void *);
361                     retptr = getgrnam((char *)p0); break;
362                 case OP_GGRGID:
363 #if Gid_t_size < INTSIZE
364                     gid = (Gid_t)va_arg(ap, int);
365 #else
366                     gid = va_arg(ap, Gid_t);
367 #endif
368                     retptr = getgrgid(gid); break;
369                 case OP_GGRENT:
370                     retptr = getgrent(); break;
371                 default:
372                     SETERRNO(ERANGE, LIB_INVARG);
373                     break;
374                 }
375             }
376         }
377         break;
378 #endif
379 #ifdef USE_NETENT_BUFFER
380     case OP_GNBYADDR:
381     case OP_GNBYNAME:
382     case OP_GNETENT:
383         {
384 #ifdef PERL_REENTRANT_MAXSIZE
385             if (PL_reentrant_buffer->_netent_size <=
386                 PERL_REENTRANT_MAXSIZE / 2)
387 #endif
388             {
389                 Netdb_net_t net;
390                 RenewDouble(PL_reentrant_buffer->_netent_buffer,
391                       &PL_reentrant_buffer->_netent_size, char);
392                 switch (PL_op->op_type) {
393                 case OP_GNBYADDR:
394                     net = va_arg(ap, Netdb_net_t);
395                     anint = va_arg(ap, int);
396                     retptr = getnetbyaddr(net, anint); break;
397                 case OP_GNBYNAME:
398                     p0 = va_arg(ap, void *);
399                     retptr = getnetbyname((char *)p0); break;
400                 case OP_GNETENT:
401                     retptr = getnetent(); break;
402                 default:
403                     SETERRNO(ERANGE, LIB_INVARG);
404                     break;
405                 }
406             }
407         }
408         break;
409 #endif
410 #ifdef USE_PWENT_BUFFER
411     case OP_GPWNAM:
412     case OP_GPWUID:
413     case OP_GPWENT:
414         {
415 #ifdef PERL_REENTRANT_MAXSIZE
416             if (PL_reentrant_buffer->_pwent_size <=
417                 PERL_REENTRANT_MAXSIZE / 2)
418 #endif
419             {
420                 Uid_t uid;
421                 RenewDouble(PL_reentrant_buffer->_pwent_buffer,
422                       &PL_reentrant_buffer->_pwent_size, char);
423                 switch (PL_op->op_type) {
424                 case OP_GPWNAM:
425                     p0 = va_arg(ap, void *);
426                     retptr = getpwnam((char *)p0); break;
427                 case OP_GPWUID:
428 #if Uid_t_size < INTSIZE
429                     uid = (Uid_t)va_arg(ap, int);
430 #else
431                     uid = va_arg(ap, Uid_t);
432 #endif
433                     retptr = getpwuid(uid); break;
434 #if defined(HAS_GETPWENT) || defined(HAS_GETPWENT_R)
435                 case OP_GPWENT:
436                     retptr = getpwent(); break;
437 #endif
438                 default:
439                     SETERRNO(ERANGE, LIB_INVARG);
440                     break;
441                 }
442             }
443         }
444         break;
445 #endif
446 #ifdef USE_PROTOENT_BUFFER
447     case OP_GPBYNAME:
448     case OP_GPBYNUMBER:
449     case OP_GPROTOENT:
450         {
451 #ifdef PERL_REENTRANT_MAXSIZE
452             if (PL_reentrant_buffer->_protoent_size <=
453                 PERL_REENTRANT_MAXSIZE / 2)
454 #endif
455             {
456                 RenewDouble(PL_reentrant_buffer->_protoent_buffer,
457                       &PL_reentrant_buffer->_protoent_size, char);
458                 switch (PL_op->op_type) {
459                 case OP_GPBYNAME:
460                     p0 = va_arg(ap, void *);
461                     retptr = getprotobyname((char *)p0); break;
462                 case OP_GPBYNUMBER:
463                     anint = va_arg(ap, int);
464                     retptr = getprotobynumber(anint); break;
465                 case OP_GPROTOENT:
466                     retptr = getprotoent(); break;
467                 default:
468                     SETERRNO(ERANGE, LIB_INVARG);
469                     break;
470                 }
471             }
472         }
473         break;
474 #endif
475 #ifdef USE_SERVENT_BUFFER
476     case OP_GSBYNAME:
477     case OP_GSBYPORT:
478     case OP_GSERVENT:
479         {
480 #ifdef PERL_REENTRANT_MAXSIZE
481             if (PL_reentrant_buffer->_servent_size <=
482                 PERL_REENTRANT_MAXSIZE / 2)
483 #endif
484             {
485                 RenewDouble(PL_reentrant_buffer->_servent_buffer,
486                       &PL_reentrant_buffer->_servent_size, char);
487                 switch (PL_op->op_type) {
488                 case OP_GSBYNAME:
489                     p0 = va_arg(ap, void *);
490                     p1 = va_arg(ap, void *);
491                     retptr = getservbyname((char *)p0, (char *)p1); break;
492                 case OP_GSBYPORT:
493                     anint = va_arg(ap, int);
494                     p0 = va_arg(ap, void *);
495                     retptr = getservbyport(anint, (char *)p0); break;
496                 case OP_GSERVENT:
497                     retptr = getservent(); break;
498                 default:
499                     SETERRNO(ERANGE, LIB_INVARG);
500                     break;
501                 }
502             }
503         }
504         break;
505 #endif
506     default:
507         /* Not known how to retry, so just fail. */
508         break;
509     }
510 #else
511     PERL_UNUSED_ARG(f);
512 #endif
513     }
514     va_end(ap);
515     return retptr;
516 }
517
518 /* ex: set ro: */