Change 16368 by jhi@alpha on 2002/05/03 12:31:52
Integrate perlio;
Several of non-default builds now seem to work reasonably well
English.t seems to fail on an errno test, and socketpair blathers
about something.
Basic fix is to stop PERL_IMPLICIT_SYS turning on USE_PERLIO by the
back door, and instead have perlsdio.h vector stdio via iperlsys.h
function tables (latter was done in earlier change).
Update comments in Makefile.mk
Finish off 16350 for non-PERLIO build on linux,
non PERL_IMPLICIT_SYS parts of iperlsys.h had junk
for some slots which now perlsdio.h is targeting.
setbuf / setvbuf are not PerlIO_ concepts
perl_clone is a threads thing
Have perlsdio.h use the iperlsys.h aliases and see
if that helps non-PERLIO IMP_SYS on Win32.
(Miniperl okay on linux).
More layer syms
Use PerlSIO_fdupopen() if not using PerlIO
Do not build if not using layers
Affected files ...
.... //depot/perl/XSUB.h#64 integrate
.... //depot/perl/iperlsys.h#56 integrate
.... //depot/perl/makedef.pl#119 integrate
.... //depot/perl/perlio.c#170 integrate
.... //depot/perl/perlio.h#41 integrate
.... //depot/perl/perlsdio.h#25 integrate
.... //depot/perl/win32/makefile.mk#228 integrate
.... //depot/perl/win32/perlhost.h#52 integrate
.... //depot/perl/win32/win32.c#199 integrate
.... //depot/perl/win32/win32io.c#14 integrate
Differences ...
==== //depot/perl/XSUB.h#64 (text) ====
Index: perl/XSUB.h
--- perl/XSUB.h.~1~ Fri May 3 06:45:05 2002
+++ perl/XSUB.h Fri May 3 06:45:05 2002
@@ -339,9 +339,9 @@
# define putenv PerlEnv_putenv
# define getenv PerlEnv_getenv
# define uname PerlEnv_uname
-# define stdin PerlIO_stdin()
-# define stdout PerlIO_stdout()
-# define stderr PerlIO_stderr()
+# define stdin PerlSIO_stdin()
+# define stdout PerlSIO_stdout()
+# define stderr PerlSIO_stderr()
# define fopen PerlIO_open
# define fclose PerlIO_close
# define feof PerlIO_eof
@@ -357,9 +357,9 @@
# define freopen PerlIO_reopen
# define fread(b,s,c,f) PerlIO_read((f),(b),(s*c))
# define fwrite(b,s,c,f) PerlIO_write((f),(b),(s*c))
-# define setbuf PerlIO_setbuf
-# define setvbuf PerlIO_setvbuf
-# define setlinebuf PerlIO_setlinebuf
+# define setbuf PerlSIO_setbuf
+# define setvbuf PerlSIO_setvbuf
+# define setlinebuf PerlSIO_setlinebuf
# define stdoutf PerlIO_stdoutf
# define vfprintf PerlIO_vprintf
# define ftell PerlIO_tell
==== //depot/perl/iperlsys.h#56 (text) ====
Index: perl/iperlsys.h
--- perl/iperlsys.h.~1~ Fri May 3 06:45:05 2002
+++ perl/iperlsys.h Fri May 3 06:45:05 2002
@@ -340,9 +340,9 @@
#define PerlSIO_set_ptr(f,p) PerlIOProc_abort()
#endif
#define PerlSIO_setlinebuf(f) setlinebuf(f)
-#define PerlSIO_printf Perl_fprintf_nocontext
-#define PerlSIO_stdoutf *PL_StdIO->pPrintf
-#define PerlSIO_vprintf(f,fmt,a)
+#define PerlSIO_printf fprintf
+#define PerlSIO_stdoutf printf
+#define PerlSIO_vprintf(f,fmt,a) vfprintf(f,fmt,a)
#define PerlSIO_ftell(f) ftell(f)
#define PerlSIO_fseek(f,o,w) fseek(f,o,w)
#define PerlSIO_fgetpos(f,p) fgetpos(f,p)
@@ -809,7 +809,7 @@
/* Shared memory macros */
#ifdef NETWARE
-
+
#define PerlMemShared_malloc(size) \
(*PL_Mem->pMalloc)(PL_Mem, (size))
#define PerlMemShared_realloc(buf, size) \
==== //depot/perl/makedef.pl#119 (text) ====
Index: perl/makedef.pl
--- perl/makedef.pl.~1~ Fri May 3 06:45:05 2002
+++ perl/makedef.pl Fri May 3 06:45:05 2002
@@ -114,6 +114,8 @@
if ($define{PERL_IMPLICIT_SYS}) {
output_symbol("perl_get_host_info");
output_symbol("perl_alloc_override");
+ }
+ if ($define{USE_ITHREADS}) {
output_symbol("perl_clone_host");
}
}
@@ -695,6 +697,30 @@
PerlIO_push
PerlIO_sv_dup
PerlIO_perlio
+
+Perl_PerlIO_clearerr
+Perl_PerlIO_close
+Perl_PerlIO_eof
+Perl_PerlIO_error
+Perl_PerlIO_fileno
+Perl_PerlIO_fill
+Perl_PerlIO_flush
+Perl_PerlIO_get_base
+Perl_PerlIO_get_bufsiz
+Perl_PerlIO_get_cnt
+Perl_PerlIO_get_ptr
+Perl_PerlIO_read
+Perl_PerlIO_seek
+Perl_PerlIO_set_cnt
+Perl_PerlIO_set_ptrcnt
+Perl_PerlIO_setlinebuf
+Perl_PerlIO_stderr
+Perl_PerlIO_stdin
+Perl_PerlIO_stdout
+Perl_PerlIO_tell
+Perl_PerlIO_unread
+Perl_PerlIO_write
+
);
@@ -787,6 +813,8 @@
# Skip the PerlIO layer symbols - although
# nothing should have exported them any way
skip_symbols \@layer_syms;
+ skip_symbols [qw(PL_def_layerlist PL_known_layers PL_perlio)];
+
# Also do NOT add abstraction symbols from $perlio_sym
# abstraction is done as #define to stdio
# Remaining remnants that _may_ be functions
@@ -1242,14 +1270,11 @@
perl_parse
perl_run
# Oddities from PerlIO
-PerlIO_open
PerlIO_binmode
PerlIO_getpos
PerlIO_init
-PerlIO_perlio
PerlIO_setpos
PerlIO_sprintf
-PerlIO_printf
PerlIO_sv_dup
PerlIO_tmpfile
PerlIO_vsprintf
==== //depot/perl/perlio.c#170 (text) ====
Index: perl/perlio.c
--- perl/perlio.c.~1~ Fri May 3 06:45:05 2002
+++ perl/perlio.c Fri May 3 06:45:05 2002
@@ -186,7 +186,15 @@
PerlIO *
PerlIO_fdupopen(pTHX_ PerlIO *f, CLONE_PARAMS *param, int flags)
{
-#ifndef PERL_MICRO
+#ifdef PERL_MICRO
+ return NULL;
+#else
+#ifdef PERL_IMPLICIT_SYS
+ return PerlSIO_fdupopen(f);
+#else
+#ifdef WIN32
+ return win32_fdupopen(f);
+#else
if (f) {
int fd = PerlLIO_dup(PerlIO_fileno(f));
if (fd >= 0) {
@@ -206,6 +214,8 @@
}
#endif
return NULL;
+#endif
+#endif
}
==== //depot/perl/perlio.h#41 (text) ====
Index: perl/perlio.h
--- perl/perlio.h.~1~ Fri May 3 06:45:05 2002
+++ perl/perlio.h Fri May 3 06:45:05 2002
@@ -40,7 +40,7 @@
#if defined(PERL_IMPLICIT_SYS)
#ifndef USE_PERLIO
#ifndef NETWARE
-# define USE_PERLIO
+/* # define USE_PERLIO */
#endif
#endif
#endif
==== //depot/perl/perlsdio.h#25 (text) ====
Index: perl/perlsdio.h
--- perl/perlsdio.h.~1~ Fri May 3 06:45:05 2002
+++ perl/perlsdio.h Fri May 3 06:45:05 2002
@@ -18,23 +18,23 @@
* Make this as close to original stdio as possible.
*/
#define PerlIO FILE
-#define PerlIO_stderr() stderr
-#define PerlIO_stdout() stdout
-#define PerlIO_stdin() stdin
+#define PerlIO_stderr() PerlSIO_stderr
+#define PerlIO_stdout() PerlSIO_stdout
+#define PerlIO_stdin() PerlSIO_stdin
#define PerlIO_isutf8(f) 0
-#define PerlIO_printf fprintf
-#define PerlIO_stdoutf printf
-#define PerlIO_vprintf(f,fmt,a) vfprintf(f,fmt,a)
-#define PerlIO_write(f,buf,count) fwrite1(buf,1,count,f)
+#define PerlIO_printf PerlSIO_printf
+#define PerlIO_stdoutf PerlSIO_stdoutf
+#define PerlIO_vprintf(f,fmt,a) PerlSIO_vprintf(f,fmt,a)
+#define PerlIO_write(f,buf,count) PerlSIO_fwrite(buf,1,count,f)
#define PerlIO_unread(f,buf,count) (-1)
-#define PerlIO_open fopen
-#define PerlIO_fdopen fdopen
-#define PerlIO_reopen freopen
-#define PerlIO_close(f) fclose(f)
-#define PerlIO_puts(f,s) fputs(s,f)
-#define PerlIO_putc(f,c) fputc(c,f)
+#define PerlIO_open PerlSIO_fopen
+#define PerlIO_fdopen PerlSIO_fdopen
+#define PerlIO_reopen PerlSIO_freopen
+#define PerlIO_close(f) PerlSIO_fclose(f)
+#define PerlIO_puts(f,s) PerlSIO_fputs(f,s)
+#define PerlIO_putc(f,c) PerlSIO_fputc(f,c)
#if defined(VMS)
# if defined(__DECC)
/* Unusual definition of ungetc() here to accomodate fast_sv_gets()'
@@ -57,26 +57,26 @@
(feof(f) ? 0 : (SSize_t)fread(buf,1,count,f))
# define PerlIO_tell(f) ftell(f)
#else
-# define PerlIO_getc(f) getc(f)
-# define PerlIO_ungetc(f,c) ungetc(c,f)
-# define PerlIO_read(f,buf,count) (SSize_t)fread(buf,1,count,f)
-# define PerlIO_tell(f) ftell(f)
+# define PerlIO_getc(f) PerlSIO_fgetc(f)
+# define PerlIO_ungetc(f,c) PerlSIO_ungetc(c,f)
+# define PerlIO_read(f,buf,count) (SSize_t)PerlSIO_fread(buf,1,count,f)
+# define PerlIO_tell(f) PerlSIO_ftell(f)
#endif
-#define PerlIO_eof(f) feof(f)
+#define PerlIO_eof(f) PerlSIO_feof(f)
#define PerlIO_getname(f,b) fgetname(f,b)
-#define PerlIO_error(f) ferror(f)
-#define PerlIO_fileno(f) fileno(f)
-#define PerlIO_clearerr(f) clearerr(f)
-#define PerlIO_flush(f) Fflush(f)
+#define PerlIO_error(f) PerlSIO_ferror(f)
+#define PerlIO_fileno(f) PerlSIO_fileno(f)
+#define PerlIO_clearerr(f) PerlSIO_clearerr(f)
+#define PerlIO_flush(f) PerlSIO_fflush(f)
#if defined(VMS) && !defined(__DECC)
/* Old VAXC RTL doesn't reset EOF on seek; Perl folk seem to expect this */
#define PerlIO_seek(f,o,w) (((f) && (*f) && ((*f)->_flag &=
~_IOEOF)),fseek(f,o,w))
#else
-# define PerlIO_seek(f,o,w) fseek(f,o,w)
+# define PerlIO_seek(f,o,w) PerlSIO_fseek(f,o,w)
#endif
-#define PerlIO_rewind(f) rewind(f)
-#define PerlIO_tmpfile() tmpfile()
+#define PerlIO_rewind(f) PerlSIO_rewind(f)
+#define PerlIO_tmpfile() PerlSIO_tmpfile()
#define PerlIO_importFILE(f,fl) (f)
#define PerlIO_exportFILE(f,fl) (f)
@@ -84,21 +84,21 @@
#define PerlIO_releaseFILE(p,f) ((void) 0)
#ifdef HAS_SETLINEBUF
-#define PerlIO_setlinebuf(f) setlinebuf(f);
+#define PerlIO_setlinebuf(f) PerlSIO_setlinebuf(f);
#else
-#define PerlIO_setlinebuf(f) setvbuf(f, Nullch, _IOLBF, 0);
+#define PerlIO_setlinebuf(f) PerlSIO_setvbuf(f, Nullch, _IOLBF, 0);
#endif
/* Now our interface to Configure's FILE_xxx macros */
#ifdef USE_STDIO_PTR
#define PerlIO_has_cntptr(f) 1
-#define PerlIO_get_ptr(f) FILE_ptr(f)
-#define PerlIO_get_cnt(f) FILE_cnt(f)
+#define PerlIO_get_ptr(f) PerlSIO_get_ptr(f)
+#define PerlIO_get_cnt(f) PerlSIO_get_cnt(f)
#ifdef STDIO_CNT_LVALUE
#define PerlIO_canset_cnt(f) 1
-#define PerlIO_set_cnt(f,c) (FILE_cnt(f) = (c))
+#define PerlIO_set_cnt(f,c) PerlSIO_set_cnt(f,c)
#ifdef STDIO_PTR_LVALUE
#ifdef STDIO_PTR_LVAL_NOCHANGE_CNT
#define PerlIO_fast_gets(f) 1
@@ -111,11 +111,11 @@
#ifdef STDIO_PTR_LVALUE
#ifdef STDIO_PTR_LVAL_NOCHANGE_CNT
-#define PerlIO_set_ptrcnt(f,p,c) STMT_START {FILE_ptr(f) = (p),
PerlIO_set_cnt(f,c);} STMT_END
+#define PerlIO_set_ptrcnt(f,p,c) STMT_START {PerlSIO_set_ptr(f,p),
+PerlIO_set_cnt(f,c);} STMT_END
#else
#ifdef STDIO_PTR_LVAL_SETS_CNT
/* assert() may pre-process to ""; potential syntax error (FILE_ptr(), ) */
-#define PerlIO_set_ptrcnt(f,p,c) STMT_START {FILE_ptr(f) = (p);
assert(FILE_cnt(f) == (c));} STMT_END
+#define PerlIO_set_ptrcnt(f,p,c) STMT_START {PerlSIO_set_ptr(f,p);
+assert(PerlSIO_get_cnt(f) == (c));} STMT_END
#define PerlIO_fast_gets(f) 1
#else
#define PerlIO_set_ptrcnt(f,p,c) abort()
@@ -141,8 +141,8 @@
#ifdef FILE_base
#define PerlIO_has_base(f) 1
-#define PerlIO_get_base(f) FILE_base(f)
-#define PerlIO_get_bufsiz(f) FILE_bufsiz(f)
+#define PerlIO_get_base(f) PerlSIO_get_base(f)
+#define PerlIO_get_bufsiz(f) PerlSIO_get_bufsiz(f)
#else
#define PerlIO_has_base(f) 0
#define PerlIO_get_base(f) (abort(),(void *)0)
==== //depot/perl/win32/makefile.mk#228 (text) ====
Index: perl/win32/makefile.mk
--- perl/win32/makefile.mk.~1~ Fri May 3 06:45:05 2002
+++ perl/win32/makefile.mk Fri May 3 06:45:05 2002
@@ -49,26 +49,30 @@
#
# uncomment to enable multiple interpreters. This is need for fork()
-# emulation.
+# emulation and for thread support.
#
USE_MULTI *= define
#
-# Beginnings of interpreter cloning/threads; still very incomplete.
-# This should be enabled to get the fork() emulation. This needs
-# USE_MULTI as well.
+# Interpreter cloning/threads; now reasonably complete.
+# This should be enabled to get the fork() emulation.
+# This needs USE_MULTI above.
#
USE_ITHREADS *= define
#
# uncomment to enable the implicit "host" layer for all system calls
-# made by perl. This needs USE_MULTI above. This is also needed to
-# get fork().
+# made by perl. This needs USE_MULTI above.
+# This is also needed to get fork().
#
USE_IMP_SYS *= define
#
-# Comment to disable I/O subsystem and use compiler's stdio for IO
+# Comment out next assign to disable perl's I/O subsystem and use compiler's
+# stdio for IO - depending on your compiler vendor and run time library you may
+# then get a number of fails from make test i.e. bugs - complain to them not us ;-).
+# You will also be unable to take full advantage of perl5.8's support for multiple
+# encodings and may see lower IO performance. You have been warned.
USE_PERLIO = define
#
@@ -112,7 +116,7 @@
# If not enabled, we automatically try to use maximum optimization
# with all compilers that are known to have a working optimizer.
#
-CFG *= Debug
+#CFG *= Debug
#
# uncomment to enable use of PerlCRT.DLL when using the Visual C compiler.
==== //depot/perl/win32/perlhost.h#52 (text) ====
==== //depot/perl/win32/win32.c#199 (text) ====
Index: perl/win32/win32.c
--- perl/win32/win32.c.~1~ Fri May 3 06:45:05 2002
+++ perl/win32/win32.c Fri May 3 06:45:05 2002
@@ -2643,6 +2643,7 @@
#ifdef USE_RTL_POPEN
return _popen(command, mode);
#else
+ dTHX;
int p[2];
int parent, child;
int stdfd, oldfd;
@@ -4036,6 +4037,58 @@
return (intptr_t)_get_osfhandle(fd);
}
+FILE *
+win32_fdupopen(FILE *pf)
+{
+ FILE* pfdup;
+ fpos_t pos;
+ char mode[3];
+ int fileno = win32_dup(win32_fileno(pf));
+
+ /* open the file in the same mode */
+#ifdef __BORLANDC__
+ if((pf)->flags & _F_READ) {
+ mode[0] = 'r';
+ mode[1] = 0;
+ }
+ else if((pf)->flags & _F_WRIT) {
+ mode[0] = 'a';
+ mode[1] = 0;
+ }
+ else if((pf)->flags & _F_RDWR) {
+ mode[0] = 'r';
+ mode[1] = '+';
+ mode[2] = 0;
+ }
+#else
+ if((pf)->_flag & _IOREAD) {
+ mode[0] = 'r';
+ mode[1] = 0;
+ }
+ else if((pf)->_flag & _IOWRT) {
+ mode[0] = 'a';
+ mode[1] = 0;
+ }
+ else if((pf)->_flag & _IORW) {
+ mode[0] = 'r';
+ mode[1] = '+';
+ mode[2] = 0;
+ }
+#endif
+
+ /* it appears that the binmode is attached to the
+ * file descriptor so binmode files will be handled
+ * correctly
+ */
+ pfdup = win32_fdopen(fileno, mode);
+
+ /* move the file pointer to the same position */
+ if (!fgetpos(pf, &pos)) {
+ fsetpos(pfdup, &pos);
+ }
+ return pfdup;
+}
+
DllExport void*
win32_dynaload(const char* filename)
{
==== //depot/perl/win32/win32io.c#14 (text) ====
Index: perl/win32/win32io.c
--- perl/win32/win32io.c.~1~ Fri May 3 06:45:05 2002
+++ perl/win32/win32io.c Fri May 3 06:45:05 2002
@@ -10,11 +10,15 @@
#include <sys/stat.h>
#include "EXTERN.h"
#include "perl.h"
+
+#ifdef PERLIO_LAYERS
+
#include "perliol.h"
#define NO_XSLOCKS
#include "XSUB.h"
+
/* Bottom-most level for Win32 case */
typedef struct
@@ -359,5 +363,5 @@
NULL, /* set_ptrcnt */
};
-
+#endif
End of Patch.
