This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
perl 5.003_04: os2/os2ish.h
[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
19 * which are not #defined in perlio.h.
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
29PerlIO_init()
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 *
40PerlIO_tmpfile()
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
79#else
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
106#ifdef HAS_SETLINEBUF
107extern void setlinebuf _((FILE *iop));
108#endif
109
110#undef PerlIO_fast_gets
111int
112PerlIO_fast_gets(f)
113PerlIO *f;
114{
115#if defined(USE_STDIO_PTR) && defined(STDIO_PTR_LVALUE) && defined(STDIO_CNT_LVALUE)
116 return 1;
117#else
118 return 0;
119#endif
120}
121
122#undef PerlIO_has_cntptr
123int
124PerlIO_has_cntptr(f)
125PerlIO *f;
126{
127#if defined(USE_STDIO_PTR)
128 return 1;
129#else
130 return 0;
131#endif
132}
133
134#undef PerlIO_canset_cnt
135int
136PerlIO_canset_cnt(f)
137PerlIO *f;
138{
139#if defined(USE_STDIO_PTR) && defined(STDIO_CNT_LVALUE)
140 return 1;
141#else
142 return 0;
143#endif
144}
145
146#undef PerlIO_set_cnt
147void
148PerlIO_set_cnt(f,cnt)
149PerlIO *f;
150int cnt;
151{
152 if (cnt < 0)
153 warn("Setting cnt to %d\n",cnt);
154#if defined(USE_STDIO_PTR) && defined(STDIO_CNT_LVALUE)
155 FILE_cnt(f) = cnt;
156#else
157 croak("Cannot set 'cnt' of FILE * on this system");
158#endif
159}
160
161#undef PerlIO_set_ptrcnt
162void
163PerlIO_set_ptrcnt(f,ptr,cnt)
164PerlIO *f;
165char *ptr;
166int cnt;
167{
33dcbb9a 168#ifdef FILE_bufsiz
760ac839
LW
169 char *e = (char *)(FILE_base(f) + FILE_bufsiz(f));
170 int ec = e - ptr;
171 if (ptr > e)
172 warn("Setting ptr %p > base %p\n",ptr, FILE_base(f)+FILE_bufsiz(f));
173 if (cnt != ec)
174 warn("Setting cnt to %d, ptr implies %d\n",cnt,ec);
33dcbb9a 175#endif
760ac839
LW
176#if defined(USE_STDIO_PTR) && defined(STDIO_PTR_LVALUE)
177 FILE_ptr(f) = (STDCHAR *) ptr;
178#else
179 croak("Cannot set 'ptr' of FILE * on this system");
180#endif
181#if defined(USE_STDIO_PTR) && defined(STDIO_CNT_LVALUE)
182 FILE_cnt(f) = cnt;
183#else
184 croak("Cannot set 'cnt' of FILE * on this system");
185#endif
186}
187
188#undef PerlIO_get_cnt
189int
190PerlIO_get_cnt(f)
191PerlIO *f;
192{
193#ifdef FILE_cnt
194 return FILE_cnt(f);
195#else
196 croak("Cannot get 'cnt' of FILE * on this system");
197 return -1;
198#endif
199}
200
201#undef PerlIO_get_bufsiz
202int
203PerlIO_get_bufsiz(f)
204PerlIO *f;
205{
206#ifdef FILE_bufsiz
207 return FILE_bufsiz(f);
208#else
209 croak("Cannot get 'bufsiz' of FILE * on this system");
210 return -1;
211#endif
212}
213
214#undef PerlIO_get_ptr
215char *
216PerlIO_get_ptr(f)
217PerlIO *f;
218{
219#ifdef FILE_ptr
220 return (char *) FILE_ptr(f);
221#else
222 croak("Cannot get 'ptr' of FILE * on this system");
223 return NULL;
224#endif
225}
226
227#undef PerlIO_get_base
228char *
229PerlIO_get_base(f)
230PerlIO *f;
231{
232#ifdef FILE_base
233 return (char *) FILE_base(f);
234#else
235 croak("Cannot get 'base' of FILE * on this system");
236 return NULL;
237#endif
238}
239
240#undef PerlIO_has_base
241int
242PerlIO_has_base(f)
243PerlIO *f;
244{
245#ifdef FILE_base
246 return 1;
247#else
248 return 0;
249#endif
250}
251
252#undef PerlIO_puts
253int
254PerlIO_puts(f,s)
255PerlIO *f;
256const char *s;
257{
258 return fputs(s,f);
259}
260
261#undef PerlIO_open
262PerlIO *
263PerlIO_open(path,mode)
264const char *path;
265const char *mode;
266{
267 return fopen(path,mode);
268}
269
270#undef PerlIO_fdopen
271PerlIO *
272PerlIO_fdopen(fd,mode)
273int fd;
274const char *mode;
275{
276 return fdopen(fd,mode);
277}
278
279
280#undef PerlIO_close
281int
282PerlIO_close(f)
283PerlIO *f;
284{
285 return fclose(f);
286}
287
288#undef PerlIO_eof
289int
290PerlIO_eof(f)
291PerlIO *f;
292{
293 return feof(f);
294}
295
296#undef PerlIO_getc
297int
298PerlIO_getc(f)
299PerlIO *f;
300{
301 return fgetc(f);
302}
303
304#undef PerlIO_error
305int
306PerlIO_error(f)
307PerlIO *f;
308{
309 return ferror(f);
310}
311
312#undef PerlIO_clearerr
313void
314PerlIO_clearerr(f)
315PerlIO *f;
316{
317 clearerr(f);
318}
319
320#undef PerlIO_flush
321int
322PerlIO_flush(f)
323PerlIO *f;
324{
325 return Fflush(f);
326}
327
328#undef PerlIO_fileno
329int
330PerlIO_fileno(f)
331PerlIO *f;
332{
333 return fileno(f);
334}
335
336#undef PerlIO_setlinebuf
337void
338PerlIO_setlinebuf(f)
339PerlIO *f;
340{
341#ifdef HAS_SETLINEBUF
342 setlinebuf(f);
343#else
344 setvbuf(f, Nullch, _IOLBF, 0);
345#endif
346}
347
348#undef PerlIO_putc
349int
350PerlIO_putc(f,ch)
351PerlIO *f;
352int ch;
353{
354 putc(ch,f);
355}
356
357#undef PerlIO_ungetc
358int
359PerlIO_ungetc(f,ch)
360PerlIO *f;
361int ch;
362{
363 ungetc(ch,f);
364}
365
366#undef PerlIO_read
367int
368PerlIO_read(f,buf,count)
369PerlIO *f;
370void *buf;
371size_t count;
372{
373 return fread(buf,1,count,f);
374}
375
376#undef PerlIO_write
377int
378PerlIO_write(f,buf,count)
379PerlIO *f;
380const void *buf;
381size_t count;
382{
383 return fwrite1(buf,1,count,f);
384}
385
386#undef PerlIO_vprintf
387int
388PerlIO_vprintf(f,fmt,ap)
389PerlIO *f;
390const char *fmt;
391va_list ap;
392{
393 return vfprintf(f,fmt,ap);
394}
395
396
397#undef PerlIO_tell
398long
399PerlIO_tell(f)
400PerlIO *f;
401{
402 return ftell(f);
403}
404
405#undef PerlIO_seek
406int
407PerlIO_seek(f,offset,whence)
408PerlIO *f;
409off_t offset;
410int whence;
411{
412 return fseek(f,offset,whence);
413}
414
415#undef PerlIO_rewind
416void
417PerlIO_rewind(f)
418PerlIO *f;
419{
420 rewind(f);
421}
422
423#undef PerlIO_printf
424int
425#ifdef I_STDARG
426PerlIO_printf(PerlIO *f,const char *fmt,...)
427#else
428PerlIO_printf(f,fmt,va_alist)
429PerlIO *f;
430const char *fmt;
431va_dcl
432#endif
433{
434 va_list ap;
435 int result;
436#ifdef I_STDARG
437 va_start(ap,fmt);
438#else
439 va_start(ap);
440#endif
441 result = vfprintf(f,fmt,ap);
442 va_end(ap);
443 return result;
444}
445
446#undef PerlIO_stdoutf
447int
448#ifdef I_STDARG
449PerlIO_stdoutf(const char *fmt,...)
450#else
451PerlIO_stdoutf(fmt, va_alist)
452const char *fmt;
453va_dcl
454#endif
455{
456 va_list ap;
457 int result;
458#ifdef I_STDARG
459 va_start(ap,fmt);
460#else
461 va_start(ap);
462#endif
463 result = PerlIO_vprintf(PerlIO_stdout(),fmt,ap);
464 va_end(ap);
465 return result;
466}
467
468#undef PerlIO_tmpfile
469PerlIO *
470PerlIO_tmpfile()
471{
472 return tmpfile();
473}
474
475#undef PerlIO_importFILE
476PerlIO *
477PerlIO_importFILE(f,fl)
478FILE *f;
479int fl;
480{
481 return f;
482}
483
484#undef PerlIO_exportFILE
485FILE *
486PerlIO_exportFILE(f,fl)
487PerlIO *f;
488int fl;
489{
490 return f;
491}
492
493#undef PerlIO_findFILE
494FILE *
495PerlIO_findFILE(f)
496PerlIO *f;
497{
498 return f;
499}
500
501#undef PerlIO_releaseFILE
502void
503PerlIO_releaseFILE(p,f)
504PerlIO *p;
505FILE *f;
506{
507}
508
509void
510PerlIO_init()
511{
512 /* Does nothing (yet) except force this file to be included
513 in perl binary. That allows this file to force inclusion
514 of other functions that may be required by loadable
515 extensions e.g. for FileHandle::tmpfile
516 */
517}
518
519#endif /* USE_SFIO */
520#endif /* PERLIO_IS_STDIO */
521
522#ifndef HAS_FSETPOS
523#undef PerlIO_setpos
524int
525PerlIO_setpos(f,pos)
526PerlIO *f;
527const Fpos_t *pos;
528{
529 return PerlIO_seek(f,*pos,0);
530}
531#endif
532
533#ifndef HAS_FGETPOS
534#undef PerlIO_getpos
535int
536PerlIO_getpos(f,pos)
537PerlIO *f;
538Fpos_t *pos;
539{
540 *pos = PerlIO_tell(f);
541 return 0;
542}
543#endif
544
545#if (defined(PERLIO_IS_STDIO) || !defined(USE_SFIO)) && !defined(HAS_VPRINTF)
546
547int
548vprintf(fd, pat, args)
549FILE *fd;
550char *pat, *args;
551{
552 _doprnt(pat, args, fd);
553 return 0; /* wrong, but perl doesn't use the return value */
554}
555
556#endif
557
558#ifndef PerlIO_vsprintf
559int
560PerlIO_vsprintf(s,n,fmt,ap)
561char *s;
562const char *fmt;
563int n;
564va_list ap;
565{
566 int val = vsprintf(s, fmt, ap);
567 if (n >= 0)
568 {
569 if (strlen(s) >= n)
570 {
571 PerlIO_puts(PerlIO_stderr(),"panic: sprintf overflow - memory corrupted!\n");
572 my_exit(1);
573 }
574 }
575 return val;
576}
577#endif
578
579#ifndef PerlIO_sprintf
580int
581#ifdef I_STDARG
582PerlIO_sprintf(char *s, int n, const char *fmt,...)
583#else
584PerlIO_sprintf(s, n, fmt, va_alist)
585char *s;
586int n;
587const char *fmt;
588va_dcl
589#endif
590{
591 va_list ap;
592 int result;
593#ifdef I_STDARG
594 va_start(ap,fmt);
595#else
596 va_start(ap);
597#endif
598 result = PerlIO_vsprintf(s, n, fmt, ap);
599 va_end(ap);
600 return result;
601}
602#endif
603