perl 5.003_04: os2/os2ish.h
[perl.git] / perlio.c
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
28 void
29 PerlIO_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
38 #undef PerlIO_tmpfile
39 PerlIO *
40 PerlIO_tmpfile()
41 {
42  return tmpfile();
43 }
44
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
57 PerlIO *
58 PerlIO_tmpfile()
59 {
60  return sftmp(0);
61 }
62
63 void
64 PerlIO_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
86 PerlIO *
87 PerlIO_stderr()
88 {
89  return (PerlIO *) stderr;
90 }
91
92 #undef PerlIO_stdin
93 PerlIO *
94 PerlIO_stdin()
95 {
96  return (PerlIO *) stdin;
97 }
98
99 #undef PerlIO_stdout
100 PerlIO *
101 PerlIO_stdout()
102 {
103  return (PerlIO *) stdout;
104 }
105
106 #ifdef HAS_SETLINEBUF
107 extern void setlinebuf _((FILE *iop));
108 #endif
109
110 #undef PerlIO_fast_gets
111 int 
112 PerlIO_fast_gets(f)
113 PerlIO *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
123 int 
124 PerlIO_has_cntptr(f)
125 PerlIO *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
135 int 
136 PerlIO_canset_cnt(f)
137 PerlIO *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
147 void
148 PerlIO_set_cnt(f,cnt)
149 PerlIO *f;
150 int 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
162 void
163 PerlIO_set_ptrcnt(f,ptr,cnt)
164 PerlIO *f;
165 char *ptr;
166 int cnt;
167 {
168 #ifdef FILE_bufsiz
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);
175 #endif
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
189 int 
190 PerlIO_get_cnt(f)
191 PerlIO *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
202 int 
203 PerlIO_get_bufsiz(f)
204 PerlIO *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
215 char *
216 PerlIO_get_ptr(f)
217 PerlIO *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
228 char *
229 PerlIO_get_base(f)
230 PerlIO *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 
241 int 
242 PerlIO_has_base(f)
243 PerlIO *f;
244 {
245 #ifdef FILE_base
246  return 1;
247 #else
248  return 0;
249 #endif
250 }
251
252 #undef PerlIO_puts
253 int
254 PerlIO_puts(f,s)
255 PerlIO *f;
256 const char *s;
257 {
258  return fputs(s,f);
259 }
260
261 #undef PerlIO_open 
262 PerlIO * 
263 PerlIO_open(path,mode)
264 const char *path;
265 const char *mode;
266 {
267  return fopen(path,mode);
268 }
269
270 #undef PerlIO_fdopen
271 PerlIO * 
272 PerlIO_fdopen(fd,mode)
273 int fd;
274 const char *mode;
275 {
276  return fdopen(fd,mode);
277 }
278
279
280 #undef PerlIO_close
281 int      
282 PerlIO_close(f)
283 PerlIO *f;
284 {
285  return fclose(f);
286 }
287
288 #undef PerlIO_eof
289 int      
290 PerlIO_eof(f)
291 PerlIO *f;
292 {
293  return feof(f);
294 }
295
296 #undef PerlIO_getc
297 int      
298 PerlIO_getc(f)
299 PerlIO *f;
300 {
301  return fgetc(f);
302 }
303
304 #undef PerlIO_error
305 int      
306 PerlIO_error(f)
307 PerlIO *f;
308 {
309  return ferror(f);
310 }
311
312 #undef PerlIO_clearerr
313 void
314 PerlIO_clearerr(f)
315 PerlIO *f;
316 {
317  clearerr(f);
318 }
319
320 #undef PerlIO_flush
321 int      
322 PerlIO_flush(f)
323 PerlIO *f;
324 {
325  return Fflush(f);
326 }
327
328 #undef PerlIO_fileno
329 int      
330 PerlIO_fileno(f)
331 PerlIO *f;
332 {
333  return fileno(f);
334 }
335
336 #undef PerlIO_setlinebuf
337 void
338 PerlIO_setlinebuf(f)
339 PerlIO *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
349 int      
350 PerlIO_putc(f,ch)
351 PerlIO *f;
352 int ch;
353 {
354  putc(ch,f);
355 }
356
357 #undef PerlIO_ungetc
358 int      
359 PerlIO_ungetc(f,ch)
360 PerlIO *f;
361 int ch;
362 {
363  ungetc(ch,f);
364 }
365
366 #undef PerlIO_read
367 int      
368 PerlIO_read(f,buf,count)
369 PerlIO *f;
370 void *buf;
371 size_t count;
372 {
373  return fread(buf,1,count,f);
374 }
375
376 #undef PerlIO_write
377 int      
378 PerlIO_write(f,buf,count)
379 PerlIO *f;
380 const void *buf;
381 size_t count;
382 {
383  return fwrite1(buf,1,count,f);
384 }
385
386 #undef PerlIO_vprintf
387 int      
388 PerlIO_vprintf(f,fmt,ap)
389 PerlIO *f;
390 const char *fmt;
391 va_list ap;
392 {
393  return vfprintf(f,fmt,ap);
394 }
395
396
397 #undef PerlIO_tell
398 long
399 PerlIO_tell(f)
400 PerlIO *f;
401 {
402  return ftell(f);
403 }
404
405 #undef PerlIO_seek
406 int
407 PerlIO_seek(f,offset,whence)
408 PerlIO *f;
409 off_t offset;
410 int whence;
411 {
412  return fseek(f,offset,whence);
413 }
414
415 #undef PerlIO_rewind
416 void
417 PerlIO_rewind(f)
418 PerlIO *f;
419 {
420  rewind(f);
421 }
422
423 #undef PerlIO_printf
424 int      
425 #ifdef I_STDARG
426 PerlIO_printf(PerlIO *f,const char *fmt,...)
427 #else
428 PerlIO_printf(f,fmt,va_alist)
429 PerlIO *f;
430 const char *fmt;
431 va_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
447 int      
448 #ifdef I_STDARG
449 PerlIO_stdoutf(const char *fmt,...)
450 #else
451 PerlIO_stdoutf(fmt, va_alist)
452 const char *fmt;
453 va_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
469 PerlIO *
470 PerlIO_tmpfile()
471 {
472  return tmpfile();
473 }
474
475 #undef PerlIO_importFILE
476 PerlIO *
477 PerlIO_importFILE(f,fl)
478 FILE *f;
479 int fl;
480 {
481  return f;
482 }
483
484 #undef PerlIO_exportFILE
485 FILE *
486 PerlIO_exportFILE(f,fl)
487 PerlIO *f;
488 int fl;
489 {
490  return f;
491 }
492
493 #undef PerlIO_findFILE
494 FILE *
495 PerlIO_findFILE(f)
496 PerlIO *f;
497 {
498  return f;
499 }
500
501 #undef PerlIO_releaseFILE
502 void
503 PerlIO_releaseFILE(p,f)
504 PerlIO *p;
505 FILE *f;
506 {
507 }
508
509 void
510 PerlIO_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
524 int
525 PerlIO_setpos(f,pos)
526 PerlIO *f;
527 const Fpos_t *pos;
528 {
529  return PerlIO_seek(f,*pos,0); 
530 }
531 #endif
532
533 #ifndef HAS_FGETPOS
534 #undef PerlIO_getpos
535 int
536 PerlIO_getpos(f,pos)
537 PerlIO *f;
538 Fpos_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
547 int
548 vprintf(fd, pat, args)
549 FILE *fd;
550 char *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
559 int 
560 PerlIO_vsprintf(s,n,fmt,ap)
561 char *s;
562 const char *fmt;
563 int n;
564 va_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
580 int      
581 #ifdef I_STDARG
582 PerlIO_sprintf(char *s, int n, const char *fmt,...)
583 #else
584 PerlIO_sprintf(s, n, fmt, va_alist)
585 char *s;
586 int n;
587 const char *fmt;
588 va_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