This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
adjust a Perl_malloc() flag for NeXT
[perl5.git] / perlio.c
CommitLineData
760ac839
LW
1/* perlio.c
2 *
3 * Copyright (c) 1996, Nick Ing-Simmons
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#define VOIDUSED 1
11#include "config.h"
12
13#define PERLIO_NOT_STDIO 0
14#if !defined(PERLIO_IS_STDIO) && !defined(USE_SFIO)
15#define PerlIO FILE
16#endif
17/*
18 * This file provides those parts of PerlIO abstraction
0f4eea8f 19 * which are not #defined in iperlsys.h.
760ac839
LW
20 * Which these are depends on various Configure #ifdef's
21 */
22
23#include "EXTERN.h"
24#include "perl.h"
25
26#ifdef PERLIO_IS_STDIO
27
28void
8ac85365 29PerlIO_init(void)
760ac839
LW
30{
31 /* Does nothing (yet) except force this file to be included
32 in perl binary. That allows this file to force inclusion
33 of other functions that may be required by loadable
34 extensions e.g. for FileHandle::tmpfile
35 */
36}
37
33dcbb9a
PP
38#undef PerlIO_tmpfile
39PerlIO *
8ac85365 40PerlIO_tmpfile(void)
33dcbb9a
PP
41{
42 return tmpfile();
43}
44
760ac839
LW
45#else /* PERLIO_IS_STDIO */
46
47#ifdef USE_SFIO
48
49#undef HAS_FSETPOS
50#undef HAS_FGETPOS
51
52/* This section is just to make sure these functions
53 get pulled in from libsfio.a
54*/
55
56#undef PerlIO_tmpfile
57PerlIO *
58PerlIO_tmpfile()
59{
60 return sftmp(0);
61}
62
63void
64PerlIO_init()
65{
66 /* Force this file to be included in perl binary. Which allows
67 * this file to force inclusion of other functions that may be
68 * required by loadable extensions e.g. for FileHandle::tmpfile
69 */
70
71 /* Hack
72 * sfio does its own 'autoflush' on stdout in common cases.
73 * Flush results in a lot of lseek()s to regular files and
74 * lot of small writes to pipes.
75 */
76 sfset(sfstdout,SF_SHARE,0);
77}
78
17c3b450 79#else /* USE_SFIO */
760ac839
LW
80
81/* Implement all the PerlIO interface using stdio.
82 - this should be only file to include <stdio.h>
83*/
84
85#undef PerlIO_stderr
86PerlIO *
87PerlIO_stderr()
88{
89 return (PerlIO *) stderr;
90}
91
92#undef PerlIO_stdin
93PerlIO *
94PerlIO_stdin()
95{
96 return (PerlIO *) stdin;
97}
98
99#undef PerlIO_stdout
100PerlIO *
101PerlIO_stdout()
102{
103 return (PerlIO *) stdout;
104}
105
760ac839
LW
106#undef PerlIO_fast_gets
107int
108PerlIO_fast_gets(f)
109PerlIO *f;
110{
111#if defined(USE_STDIO_PTR) && defined(STDIO_PTR_LVALUE) && defined(STDIO_CNT_LVALUE)
112 return 1;
113#else
114 return 0;
115#endif
116}
117
118#undef PerlIO_has_cntptr
119int
120PerlIO_has_cntptr(f)
121PerlIO *f;
122{
123#if defined(USE_STDIO_PTR)
124 return 1;
125#else
126 return 0;
127#endif
128}
129
130#undef PerlIO_canset_cnt
131int
132PerlIO_canset_cnt(f)
133PerlIO *f;
134{
135#if defined(USE_STDIO_PTR) && defined(STDIO_CNT_LVALUE)
136 return 1;
137#else
138 return 0;
139#endif
140}
141
142#undef PerlIO_set_cnt
143void
144PerlIO_set_cnt(f,cnt)
145PerlIO *f;
146int cnt;
147{
159bba36 148 if (cnt < -1)
760ac839
LW
149 warn("Setting cnt to %d\n",cnt);
150#if defined(USE_STDIO_PTR) && defined(STDIO_CNT_LVALUE)
151 FILE_cnt(f) = cnt;
152#else
153 croak("Cannot set 'cnt' of FILE * on this system");
154#endif
155}
156
157#undef PerlIO_set_ptrcnt
158void
159PerlIO_set_ptrcnt(f,ptr,cnt)
160PerlIO *f;
888911fc 161STDCHAR *ptr;
760ac839
LW
162int cnt;
163{
33dcbb9a 164#ifdef FILE_bufsiz
888911fc
CS
165 STDCHAR *e = FILE_base(f) + FILE_bufsiz(f);
166 int ec = e - ptr;
159bba36
CS
167 if (ptr > e + 1)
168 warn("Setting ptr %p > end+1 %p\n", ptr, e + 1);
760ac839
LW
169 if (cnt != ec)
170 warn("Setting cnt to %d, ptr implies %d\n",cnt,ec);
33dcbb9a 171#endif
760ac839 172#if defined(USE_STDIO_PTR) && defined(STDIO_PTR_LVALUE)
888911fc 173 FILE_ptr(f) = ptr;
760ac839
LW
174#else
175 croak("Cannot set 'ptr' of FILE * on this system");
176#endif
177#if defined(USE_STDIO_PTR) && defined(STDIO_CNT_LVALUE)
178 FILE_cnt(f) = cnt;
179#else
180 croak("Cannot set 'cnt' of FILE * on this system");
181#endif
182}
183
184#undef PerlIO_get_cnt
185int
186PerlIO_get_cnt(f)
187PerlIO *f;
188{
189#ifdef FILE_cnt
190 return FILE_cnt(f);
191#else
192 croak("Cannot get 'cnt' of FILE * on this system");
193 return -1;
194#endif
195}
196
197#undef PerlIO_get_bufsiz
198int
199PerlIO_get_bufsiz(f)
200PerlIO *f;
201{
202#ifdef FILE_bufsiz
203 return FILE_bufsiz(f);
204#else
205 croak("Cannot get 'bufsiz' of FILE * on this system");
206 return -1;
207#endif
208}
209
210#undef PerlIO_get_ptr
888911fc 211STDCHAR *
760ac839
LW
212PerlIO_get_ptr(f)
213PerlIO *f;
214{
215#ifdef FILE_ptr
888911fc 216 return FILE_ptr(f);
760ac839
LW
217#else
218 croak("Cannot get 'ptr' of FILE * on this system");
219 return NULL;
220#endif
221}
222
223#undef PerlIO_get_base
888911fc 224STDCHAR *
760ac839
LW
225PerlIO_get_base(f)
226PerlIO *f;
227{
228#ifdef FILE_base
888911fc 229 return FILE_base(f);
760ac839
LW
230#else
231 croak("Cannot get 'base' of FILE * on this system");
232 return NULL;
233#endif
234}
235
236#undef PerlIO_has_base
237int
238PerlIO_has_base(f)
239PerlIO *f;
240{
241#ifdef FILE_base
242 return 1;
243#else
244 return 0;
245#endif
246}
247
248#undef PerlIO_puts
249int
250PerlIO_puts(f,s)
251PerlIO *f;
252const char *s;
253{
254 return fputs(s,f);
255}
256
257#undef PerlIO_open
258PerlIO *
259PerlIO_open(path,mode)
260const char *path;
261const char *mode;
262{
263 return fopen(path,mode);
264}
265
266#undef PerlIO_fdopen
267PerlIO *
268PerlIO_fdopen(fd,mode)
269int fd;
270const char *mode;
271{
272 return fdopen(fd,mode);
273}
274
8c86a920
PP
275#undef PerlIO_reopen
276PerlIO *
111c4dfa
HK
277PerlIO_reopen(name, mode, f)
278const char *name;
8c86a920 279const char *mode;
111c4dfa 280PerlIO *f;
8c86a920
PP
281{
282 return freopen(name,mode,f);
283}
760ac839
LW
284
285#undef PerlIO_close
286int
287PerlIO_close(f)
288PerlIO *f;
289{
290 return fclose(f);
291}
292
293#undef PerlIO_eof
294int
295PerlIO_eof(f)
296PerlIO *f;
297{
298 return feof(f);
299}
300
8c86a920
PP
301#undef PerlIO_getname
302char *
303PerlIO_getname(f,buf)
304PerlIO *f;
305char *buf;
306{
307#ifdef VMS
308 return fgetname(f,buf);
309#else
310 croak("Don't know how to get file name");
c64afb19 311 return NULL;
8c86a920
PP
312#endif
313}
314
760ac839
LW
315#undef PerlIO_getc
316int
317PerlIO_getc(f)
318PerlIO *f;
319{
320 return fgetc(f);
321}
322
323#undef PerlIO_error
324int
325PerlIO_error(f)
326PerlIO *f;
327{
328 return ferror(f);
329}
330
331#undef PerlIO_clearerr
332void
333PerlIO_clearerr(f)
334PerlIO *f;
335{
336 clearerr(f);
337}
338
339#undef PerlIO_flush
340int
341PerlIO_flush(f)
342PerlIO *f;
343{
344 return Fflush(f);
345}
346
347#undef PerlIO_fileno
348int
349PerlIO_fileno(f)
350PerlIO *f;
351{
352 return fileno(f);
353}
354
355#undef PerlIO_setlinebuf
356void
357PerlIO_setlinebuf(f)
358PerlIO *f;
359{
360#ifdef HAS_SETLINEBUF
361 setlinebuf(f);
362#else
3e3baf6d
TB
363# ifdef __BORLANDC__ /* Borland doesn't like NULL size for _IOLBF */
364 setvbuf(f, Nullch, _IOLBF, BUFSIZ);
365# else
760ac839 366 setvbuf(f, Nullch, _IOLBF, 0);
3e3baf6d 367# endif
760ac839
LW
368#endif
369}
370
371#undef PerlIO_putc
372int
373PerlIO_putc(f,ch)
374PerlIO *f;
375int ch;
376{
9010f3dd 377 return putc(ch,f);
760ac839
LW
378}
379
380#undef PerlIO_ungetc
381int
382PerlIO_ungetc(f,ch)
383PerlIO *f;
384int ch;
385{
9010f3dd 386 return ungetc(ch,f);
760ac839
LW
387}
388
389#undef PerlIO_read
5b54f415 390SSize_t
760ac839
LW
391PerlIO_read(f,buf,count)
392PerlIO *f;
393void *buf;
5b54f415 394Size_t count;
760ac839
LW
395{
396 return fread(buf,1,count,f);
397}
398
399#undef PerlIO_write
5b54f415 400SSize_t
760ac839
LW
401PerlIO_write(f,buf,count)
402PerlIO *f;
403const void *buf;
5b54f415 404Size_t count;
760ac839
LW
405{
406 return fwrite1(buf,1,count,f);
407}
408
409#undef PerlIO_vprintf
410int
411PerlIO_vprintf(f,fmt,ap)
412PerlIO *f;
413const char *fmt;
414va_list ap;
415{
416 return vfprintf(f,fmt,ap);
417}
418
760ac839 419#undef PerlIO_tell
5ff3f7a4 420Off_t
760ac839
LW
421PerlIO_tell(f)
422PerlIO *f;
423{
5ff3f7a4
GS
424#ifdef HAS_FTELLO
425 return ftello(f);
426#else
760ac839 427 return ftell(f);
5ff3f7a4 428#endif
760ac839
LW
429}
430
431#undef PerlIO_seek
432int
433PerlIO_seek(f,offset,whence)
434PerlIO *f;
5ff3f7a4 435Off_t offset;
760ac839
LW
436int whence;
437{
5ff3f7a4
GS
438#ifdef HAS_FSEEKO
439 return fseeko(f,offset,whence);
440#else
760ac839 441 return fseek(f,offset,whence);
5ff3f7a4 442#endif
760ac839
LW
443}
444
445#undef PerlIO_rewind
446void
447PerlIO_rewind(f)
448PerlIO *f;
449{
450 rewind(f);
451}
452
453#undef PerlIO_printf
454int
760ac839 455PerlIO_printf(PerlIO *f,const char *fmt,...)
760ac839
LW
456{
457 va_list ap;
458 int result;
760ac839 459 va_start(ap,fmt);
760ac839
LW
460 result = vfprintf(f,fmt,ap);
461 va_end(ap);
462 return result;
463}
464
465#undef PerlIO_stdoutf
466int
760ac839 467PerlIO_stdoutf(const char *fmt,...)
760ac839
LW
468{
469 va_list ap;
470 int result;
760ac839 471 va_start(ap,fmt);
760ac839
LW
472 result = PerlIO_vprintf(PerlIO_stdout(),fmt,ap);
473 va_end(ap);
474 return result;
475}
476
477#undef PerlIO_tmpfile
478PerlIO *
479PerlIO_tmpfile()
480{
481 return tmpfile();
482}
483
484#undef PerlIO_importFILE
485PerlIO *
486PerlIO_importFILE(f,fl)
487FILE *f;
488int fl;
489{
490 return f;
491}
492
493#undef PerlIO_exportFILE
494FILE *
495PerlIO_exportFILE(f,fl)
496PerlIO *f;
497int fl;
498{
499 return f;
500}
501
502#undef PerlIO_findFILE
503FILE *
504PerlIO_findFILE(f)
505PerlIO *f;
506{
507 return f;
508}
509
510#undef PerlIO_releaseFILE
511void
512PerlIO_releaseFILE(p,f)
513PerlIO *p;
514FILE *f;
515{
516}
517
518void
519PerlIO_init()
520{
521 /* Does nothing (yet) except force this file to be included
522 in perl binary. That allows this file to force inclusion
523 of other functions that may be required by loadable
524 extensions e.g. for FileHandle::tmpfile
525 */
526}
527
528#endif /* USE_SFIO */
529#endif /* PERLIO_IS_STDIO */
530
531#ifndef HAS_FSETPOS
532#undef PerlIO_setpos
533int
534PerlIO_setpos(f,pos)
535PerlIO *f;
536const Fpos_t *pos;
537{
538 return PerlIO_seek(f,*pos,0);
539}
c411622e
PP
540#else
541#ifndef PERLIO_IS_STDIO
542#undef PerlIO_setpos
543int
544PerlIO_setpos(f,pos)
545PerlIO *f;
546const Fpos_t *pos;
547{
548 return fsetpos(f, pos);
549}
550#endif
760ac839
LW
551#endif
552
553#ifndef HAS_FGETPOS
554#undef PerlIO_getpos
555int
556PerlIO_getpos(f,pos)
557PerlIO *f;
558Fpos_t *pos;
559{
560 *pos = PerlIO_tell(f);
561 return 0;
562}
c411622e
PP
563#else
564#ifndef PERLIO_IS_STDIO
565#undef PerlIO_getpos
566int
567PerlIO_getpos(f,pos)
568PerlIO *f;
569Fpos_t *pos;
570{
571 return fgetpos(f, pos);
572}
573#endif
760ac839
LW
574#endif
575
576#if (defined(PERLIO_IS_STDIO) || !defined(USE_SFIO)) && !defined(HAS_VPRINTF)
577
578int
662a7e3f
CS
579vprintf(pat, args)
580char *pat, *args;
581{
582 _doprnt(pat, args, stdout);
583 return 0; /* wrong, but perl doesn't use the return value */
584}
585
586int
587vfprintf(fd, pat, args)
760ac839
LW
588FILE *fd;
589char *pat, *args;
590{
591 _doprnt(pat, args, fd);
592 return 0; /* wrong, but perl doesn't use the return value */
593}
594
595#endif
596
597#ifndef PerlIO_vsprintf
598int
8ac85365 599PerlIO_vsprintf(char *s, int n, const char *fmt, va_list ap)
760ac839
LW
600{
601 int val = vsprintf(s, fmt, ap);
602 if (n >= 0)
603 {
8c86a920 604 if (strlen(s) >= (STRLEN)n)
760ac839
LW
605 {
606 PerlIO_puts(PerlIO_stderr(),"panic: sprintf overflow - memory corrupted!\n");
607 my_exit(1);
608 }
609 }
610 return val;
611}
612#endif
613
614#ifndef PerlIO_sprintf
615int
760ac839 616PerlIO_sprintf(char *s, int n, const char *fmt,...)
760ac839
LW
617{
618 va_list ap;
619 int result;
760ac839 620 va_start(ap,fmt);
760ac839
LW
621 result = PerlIO_vsprintf(s, n, fmt, ap);
622 va_end(ap);
623 return result;
624}
625#endif
626