Change 13862 by jhi@alpha on 2001/12/23 01:47:23
Integrate perlio;
Add at least the "important" PerlIO_xxxx functions to embed.pl
so that they get implicit pTHX_ and we can avoid slow dTHX.
Put PerlIO stuff inside EXTERN C
Win32 and makedef.pl fall-out of PerlIO/pTHX stuff
Affected files ...
.... //depot/perl/embed.h#318 integrate
.... //depot/perl/embed.pl#308 integrate
.... //depot/perl/ext/IO/IO.xs#30 integrate
.... //depot/perl/global.sym#194 integrate
.... //depot/perl/globals.c#29 integrate
.... //depot/perl/makedef.pl#100 integrate
.... //depot/perl/perlio.c#155 integrate
.... //depot/perl/perlio.h#37 integrate
.... //depot/perl/perlio.sym#5 integrate
.... //depot/perl/pod/perlapi.pod#117 integrate
.... //depot/perl/proto.h#361 integrate
.... //depot/perl/win32/win32.c#180 integrate
Differences ...
==== //depot/perl/embed.h#318 (text+w) ====
Index: perl/embed.h
--- perl/embed.h.~1~ Sat Dec 22 19:00:05 2001
+++ perl/embed.h Sat Dec 22 19:00:05 2001
@@ -1203,9 +1203,30 @@
#define sv_pvn_force_flags Perl_sv_pvn_force_flags
#define sv_2pv_flags Perl_sv_2pv_flags
#define my_atof2 Perl_my_atof2
-#if !defined(HAS_SOCKETPAIR) && defined(HAS_SOCKET)
-#define my_socketpair Perl_my_socketpair
-#endif
+#if defined(USE_PERLIO) && !defined(USE_SFIO)
+#define PerlIO_close Perl_PerlIO_close
+#define PerlIO_fill Perl_PerlIO_fill
+#define PerlIO_fileno Perl_PerlIO_fileno
+#define PerlIO_eof Perl_PerlIO_eof
+#define PerlIO_error Perl_PerlIO_error
+#define PerlIO_flush Perl_PerlIO_flush
+#define PerlIO_clearerr Perl_PerlIO_clearerr
+#define PerlIO_set_cnt Perl_PerlIO_set_cnt
+#define PerlIO_set_ptrcnt Perl_PerlIO_set_ptrcnt
+#define PerlIO_setlinebuf Perl_PerlIO_setlinebuf
+#define PerlIO_read Perl_PerlIO_read
+#define PerlIO_write Perl_PerlIO_write
+#define PerlIO_unread Perl_PerlIO_unread
+#define PerlIO_tell Perl_PerlIO_tell
+#define PerlIO_seek Perl_PerlIO_seek
+#define PerlIO_get_base Perl_PerlIO_get_base
+#define PerlIO_get_ptr Perl_PerlIO_get_ptr
+#define PerlIO_get_bufsiz Perl_PerlIO_get_bufsiz
+#define PerlIO_get_cnt Perl_PerlIO_get_cnt
+#define PerlIO_stdin Perl_PerlIO_stdin
+#define PerlIO_stdout Perl_PerlIO_stdout
+#define PerlIO_stderr Perl_PerlIO_stderr
+#endif /* PERLIO_LAYERS */
#define ck_anoncode Perl_ck_anoncode
#define ck_bitop Perl_ck_bitop
#define ck_concat Perl_ck_concat
@@ -2720,9 +2741,30 @@
#define sv_pvn_force_flags(a,b,c) Perl_sv_pvn_force_flags(aTHX_ a,b,c)
#define sv_2pv_flags(a,b,c) Perl_sv_2pv_flags(aTHX_ a,b,c)
#define my_atof2(a,b) Perl_my_atof2(aTHX_ a,b)
-#if !defined(HAS_SOCKETPAIR) && defined(HAS_SOCKET)
-#define my_socketpair(a,b,c,d) Perl_my_socketpair(aTHX_ a,b,c,d)
-#endif
+#if defined(USE_PERLIO) && !defined(USE_SFIO)
+#define PerlIO_close(a) Perl_PerlIO_close(aTHX_ a)
+#define PerlIO_fill(a) Perl_PerlIO_fill(aTHX_ a)
+#define PerlIO_fileno(a) Perl_PerlIO_fileno(aTHX_ a)
+#define PerlIO_eof(a) Perl_PerlIO_eof(aTHX_ a)
+#define PerlIO_error(a) Perl_PerlIO_error(aTHX_ a)
+#define PerlIO_flush(a) Perl_PerlIO_flush(aTHX_ a)
+#define PerlIO_clearerr(a) Perl_PerlIO_clearerr(aTHX_ a)
+#define PerlIO_set_cnt(a,b) Perl_PerlIO_set_cnt(aTHX_ a,b)
+#define PerlIO_set_ptrcnt(a,b,c) Perl_PerlIO_set_ptrcnt(aTHX_ a,b,c)
+#define PerlIO_setlinebuf(a) Perl_PerlIO_setlinebuf(aTHX_ a)
+#define PerlIO_read(a,b,c) Perl_PerlIO_read(aTHX_ a,b,c)
+#define PerlIO_write(a,b,c) Perl_PerlIO_write(aTHX_ a,b,c)
+#define PerlIO_unread(a,b,c) Perl_PerlIO_unread(aTHX_ a,b,c)
+#define PerlIO_tell(a) Perl_PerlIO_tell(aTHX_ a)
+#define PerlIO_seek(a,b,c) Perl_PerlIO_seek(aTHX_ a,b,c)
+#define PerlIO_get_base(a) Perl_PerlIO_get_base(aTHX_ a)
+#define PerlIO_get_ptr(a) Perl_PerlIO_get_ptr(aTHX_ a)
+#define PerlIO_get_bufsiz(a) Perl_PerlIO_get_bufsiz(aTHX_ a)
+#define PerlIO_get_cnt(a) Perl_PerlIO_get_cnt(aTHX_ a)
+#define PerlIO_stdin() Perl_PerlIO_stdin(aTHX)
+#define PerlIO_stdout() Perl_PerlIO_stdout(aTHX)
+#define PerlIO_stderr() Perl_PerlIO_stderr(aTHX)
+#endif /* PERLIO_LAYERS */
#define ck_anoncode(a) Perl_ck_anoncode(aTHX_ a)
#define ck_bitop(a) Perl_ck_bitop(aTHX_ a)
#define ck_concat(a) Perl_ck_concat(aTHX_ a)
==== //depot/perl/embed.pl#308 (xtext) ====
Index: perl/embed.pl
--- perl/embed.pl.~1~ Sat Dec 22 19:00:05 2001
+++ perl/embed.pl Sat Dec 22 19:00:05 2001
@@ -2357,5 +2357,33 @@
Ap |int |my_socketpair |int family|int type|int protocol|int fd[2]
#endif
+
+#if defined(USE_PERLIO) && !defined(USE_SFIO)
+Ap |int |PerlIO_close |PerlIO *
+Ap |int |PerlIO_fill |PerlIO *
+Ap |int |PerlIO_fileno |PerlIO *
+Ap |int |PerlIO_eof |PerlIO *
+Ap |int |PerlIO_error |PerlIO *
+Ap |int |PerlIO_flush |PerlIO *
+Ap |void |PerlIO_clearerr |PerlIO *
+Ap |void |PerlIO_set_cnt |PerlIO *|int
+Ap |void |PerlIO_set_ptrcnt |PerlIO *|STDCHAR *|int
+Ap |void |PerlIO_setlinebuf |PerlIO *
+Ap |SSize_t|PerlIO_read |PerlIO *|void *|Size_t
+Ap |SSize_t|PerlIO_write |PerlIO *|const void *|Size_t
+Ap |SSize_t|PerlIO_unread |PerlIO *|const void *|Size_t
+Ap |Off_t |PerlIO_tell |PerlIO *
+Ap |int |PerlIO_seek |PerlIO *|Off_t|int
+
+Ap |STDCHAR *|PerlIO_get_base |PerlIO *
+Ap |STDCHAR *|PerlIO_get_ptr |PerlIO *
+Ap |int |PerlIO_get_bufsiz |PerlIO *
+Ap |int |PerlIO_get_cnt |PerlIO *
+
+Ap |PerlIO *|PerlIO_stdin
+Ap |PerlIO *|PerlIO_stdout
+Ap |PerlIO *|PerlIO_stderr
+#endif /* PERLIO_LAYERS */
+
END_EXTERN_C
==== //depot/perl/ext/IO/IO.xs#30 (text) ====
Index: perl/ext/IO/IO.xs
--- perl/ext/IO/IO.xs.~1~ Sat Dec 22 19:00:05 2001
+++ perl/ext/IO/IO.xs Sat Dec 22 19:00:05 2001
@@ -55,7 +55,7 @@
#endif
static int
-io_blocking(InputStream f, int block)
+io_blocking(pTHX_ InputStream f, int block)
{
int RETVAL;
if(!f) {
@@ -261,7 +261,7 @@
PROTOTYPE: $;$
CODE:
{
- int ret = io_blocking(handle, items == 1 ? -1 : blk ? 1 : 0);
+ int ret = io_blocking(aTHX_ handle, items == 1 ? -1 : blk ? 1 : 0);
if(ret >= 0)
XSRETURN_IV(ret);
else
==== //depot/perl/global.sym#194 (text+w) ====
Index: perl/global.sym
--- perl/global.sym.~1~ Sat Dec 22 19:00:05 2001
+++ perl/global.sym Sat Dec 22 19:00:05 2001
@@ -604,4 +604,25 @@
Perl_sv_pvn_force_flags
Perl_sv_2pv_flags
Perl_my_atof2
-Perl_my_socketpair
+Perl_PerlIO_close
+Perl_PerlIO_fill
+Perl_PerlIO_fileno
+Perl_PerlIO_eof
+Perl_PerlIO_error
+Perl_PerlIO_flush
+Perl_PerlIO_clearerr
+Perl_PerlIO_set_cnt
+Perl_PerlIO_set_ptrcnt
+Perl_PerlIO_setlinebuf
+Perl_PerlIO_read
+Perl_PerlIO_write
+Perl_PerlIO_unread
+Perl_PerlIO_tell
+Perl_PerlIO_seek
+Perl_PerlIO_get_base
+Perl_PerlIO_get_ptr
+Perl_PerlIO_get_bufsiz
+Perl_PerlIO_get_cnt
+Perl_PerlIO_stdin
+Perl_PerlIO_stdout
+Perl_PerlIO_stderr
==== //depot/perl/globals.c#29 (text) ====
Index: perl/globals.c
--- perl/globals.c.~1~ Sat Dec 22 19:00:05 2001
+++ perl/globals.c Sat Dec 22 19:00:05 2001
@@ -14,7 +14,7 @@
int
Perl_printf_nocontext(const char *format, ...)
{
- dTHXs;
+ dTHX;
va_list(arglist);
va_start(arglist, format);
return PerlIO_vprintf(PerlIO_stdout(), format, arglist);
==== //depot/perl/makedef.pl#100 (text) ====
Index: perl/makedef.pl
--- perl/makedef.pl.~1~ Sat Dec 22 19:00:05 2001
+++ perl/makedef.pl Sat Dec 22 19:00:05 2001
@@ -174,7 +174,7 @@
if ($define{PERL_IMPLICIT_SYS}) {
output_symbol("perl_get_host_info");
output_symbol("perl_alloc_override");
- output_symbol("perl_clone_host");
+ output_symbol("perl_clone_host");
}
}
@@ -655,7 +655,6 @@
PerlIO_pending
PerlIO_push
PerlIO_sv_dup
- PerlIO_unread
PL_def_layerlist
PL_known_layers
PL_perlio
@@ -1200,6 +1199,5 @@
PerlIO_sprintf
PerlIO_sv_dup
PerlIO_tmpfile
-PerlIO_unread
PerlIO_vsprintf
perlsio_binmode
==== //depot/perl/perlio.c#155 (text) ====
Index: perl/perlio.c
--- perl/perlio.c.~1~ Sat Dec 22 19:00:05 2001
+++ perl/perlio.c Sat Dec 22 19:00:05 2001
@@ -1091,11 +1091,9 @@
return PerlIO_apply_layers(aTHX_ f, NULL, names) == 0 ? TRUE : FALSE;
}
-#undef PerlIO__close
int
-PerlIO__close(PerlIO *f)
+PerlIO__close(pTHX_ PerlIO *f)
{
- dTHX;
if (f && *f)
return (*PerlIOBase(f)->tab->Close) (aTHX_ f);
else {
@@ -1104,11 +1102,9 @@
}
}
-#undef PerlIO_close
int
-PerlIO_close(PerlIO *f)
+Perl_PerlIO_close(pTHX_ PerlIO *f)
{
- dTHX;
int code = -1;
if (f && *f) {
code = (*PerlIOBase(f)->tab->Close) (aTHX_ f);
@@ -1119,11 +1115,9 @@
return code;
}
-#undef PerlIO_fileno
int
-PerlIO_fileno(PerlIO *f)
+Perl_PerlIO_fileno(pTHX_ PerlIO *f)
{
- dTHX;
if (f && *f)
return (*PerlIOBase(f)->tab->Fileno) (aTHX_ f);
else {
@@ -1313,37 +1307,9 @@
}
-#undef PerlIO_fdopen
-PerlIO *
-PerlIO_fdopen(int fd, const char *mode)
-{
- dTHX;
- return PerlIO_openn(aTHX_ Nullch, mode, fd, 0, 0, NULL, 0, NULL);
-}
-
-#undef PerlIO_open
-PerlIO *
-PerlIO_open(const char *path, const char *mode)
-{
- dTHX;
- SV *name = sv_2mortal(newSVpvn(path, strlen(path)));
- return PerlIO_openn(aTHX_ Nullch, mode, -1, 0, 0, NULL, 1, &name);
-}
-
-#undef PerlIO_reopen
-PerlIO *
-PerlIO_reopen(const char *path, const char *mode, PerlIO *f)
-{
- dTHX;
- SV *name = sv_2mortal(newSVpvn(path, strlen(path)));
- return PerlIO_openn(aTHX_ Nullch, mode, -1, 0, 0, f, 1, &name);
-}
-
-#undef PerlIO_read
SSize_t
-PerlIO_read(PerlIO *f, void *vbuf, Size_t count)
+Perl_PerlIO_read(pTHX_ PerlIO *f, void *vbuf, Size_t count)
{
- dTHX;
if (f && *f)
return (*PerlIOBase(f)->tab->Read) (aTHX_ f, vbuf, count);
else {
@@ -1352,11 +1318,9 @@
}
}
-#undef PerlIO_unread
SSize_t
-PerlIO_unread(PerlIO *f, const void *vbuf, Size_t count)
+Perl_PerlIO_unread(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
{
- dTHX;
if (f && *f)
return (*PerlIOBase(f)->tab->Unread) (aTHX_ f, vbuf, count);
else {
@@ -1365,11 +1329,9 @@
}
}
-#undef PerlIO_write
SSize_t
-PerlIO_write(PerlIO *f, const void *vbuf, Size_t count)
+Perl_PerlIO_write(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
{
- dTHX;
if (f && *f)
return (*PerlIOBase(f)->tab->Write) (aTHX_ f, vbuf, count);
else {
@@ -1378,11 +1340,9 @@
}
}
-#undef PerlIO_seek
int
-PerlIO_seek(PerlIO *f, Off_t offset, int whence)
+Perl_PerlIO_seek(pTHX_ PerlIO *f, Off_t offset, int whence)
{
- dTHX;
if (f && *f)
return (*PerlIOBase(f)->tab->Seek) (aTHX_ f, offset, whence);
else {
@@ -1391,11 +1351,9 @@
}
}
-#undef PerlIO_tell
Off_t
-PerlIO_tell(PerlIO *f)
+Perl_PerlIO_tell(pTHX_ PerlIO *f)
{
- dTHX;
if (f && *f)
return (*PerlIOBase(f)->tab->Tell) (aTHX_ f);
else {
@@ -1404,11 +1362,9 @@
}
}
-#undef PerlIO_flush
int
-PerlIO_flush(PerlIO *f)
+Perl_PerlIO_flush(pTHX_ PerlIO *f)
{
- dTHX;
if (f) {
if (*f) {
PerlIO_funcs *tab = PerlIOBase(f)->tab;
@@ -1469,11 +1425,9 @@
}
}
-#undef PerlIO_fill
int
-PerlIO_fill(PerlIO *f)
+Perl_PerlIO_fill(pTHX_ PerlIO *f)
{
- dTHX;
if (f && *f)
return (*PerlIOBase(f)->tab->Fill) (aTHX_ f);
else {
@@ -1482,7 +1436,6 @@
}
}
-#undef PerlIO_isutf8
int
PerlIO_isutf8(PerlIO *f)
{
@@ -1494,11 +1447,9 @@
}
}
-#undef PerlIO_eof
int
-PerlIO_eof(PerlIO *f)
+Perl_PerlIO_eof(pTHX_ PerlIO *f)
{
- dTHX;
if (f && *f)
return (*PerlIOBase(f)->tab->Eof) (aTHX_ f);
else {
@@ -1507,11 +1458,9 @@
}
}
-#undef PerlIO_error
int
-PerlIO_error(PerlIO *f)
+Perl_PerlIO_error(pTHX_ PerlIO *f)
{
- dTHX;
if (f && *f)
return (*PerlIOBase(f)->tab->Error) (aTHX_ f);
else {
@@ -1520,29 +1469,24 @@
}
}
-#undef PerlIO_clearerr
void
-PerlIO_clearerr(PerlIO *f)
+Perl_PerlIO_clearerr(pTHX_ PerlIO *f)
{
- dTHX;
if (f && *f)
(*PerlIOBase(f)->tab->Clearerr) (aTHX_ f);
else
SETERRNO(EBADF, SS$_IVCHAN);
}
-#undef PerlIO_setlinebuf
void
-PerlIO_setlinebuf(PerlIO *f)
+Perl_PerlIO_setlinebuf(pTHX_ PerlIO *f)
{
- dTHX;
if (f && *f)
(*PerlIOBase(f)->tab->Setlinebuf) (aTHX_ f);
else
SETERRNO(EBADF, SS$_IVCHAN);
}
-#undef PerlIO_has_base
int
PerlIO_has_base(PerlIO *f)
{
@@ -1552,7 +1496,6 @@
return 0;
}
-#undef PerlIO_fast_gets
int
PerlIO_fast_gets(PerlIO *f)
{
@@ -1563,7 +1506,6 @@
return 0;
}
-#undef PerlIO_has_cntptr
int
PerlIO_has_cntptr(PerlIO *f)
{
@@ -1574,7 +1516,6 @@
return 0;
}
-#undef PerlIO_canset_cnt
int
PerlIO_canset_cnt(PerlIO *f)
{
@@ -1585,61 +1526,49 @@
return 0;
}
-#undef PerlIO_get_base
STDCHAR *
-PerlIO_get_base(PerlIO *f)
+Perl_PerlIO_get_base(pTHX_ PerlIO *f)
{
- dTHX;
if (f && *f)
return (*PerlIOBase(f)->tab->Get_base) (aTHX_ f);
return NULL;
}
-#undef PerlIO_get_bufsiz
int
-PerlIO_get_bufsiz(PerlIO *f)
+Perl_PerlIO_get_bufsiz(pTHX_ PerlIO *f)
{
- dTHX;
if (f && *f)
return (*PerlIOBase(f)->tab->Get_bufsiz) (aTHX_ f);
return 0;
}
-#undef PerlIO_get_ptr
STDCHAR *
-PerlIO_get_ptr(PerlIO *f)
+Perl_PerlIO_get_ptr(pTHX_ PerlIO *f)
{
- dTHX;
PerlIO_funcs *tab = PerlIOBase(f)->tab;
if (tab->Get_ptr == NULL)
return NULL;
return (*tab->Get_ptr) (aTHX_ f);
}
-#undef PerlIO_get_cnt
int
-PerlIO_get_cnt(PerlIO *f)
+Perl_PerlIO_get_cnt(pTHX_ PerlIO *f)
{
- dTHX;
PerlIO_funcs *tab = PerlIOBase(f)->tab;
if (tab->Get_cnt == NULL)
return 0;
return (*tab->Get_cnt) (aTHX_ f);
}
-#undef PerlIO_set_cnt
void
-PerlIO_set_cnt(PerlIO *f, int cnt)
+Perl_PerlIO_set_cnt(pTHX_ PerlIO *f, int cnt)
{
- dTHX;
(*PerlIOBase(f)->tab->Set_ptrcnt) (aTHX_ f, NULL, cnt);
}
-#undef PerlIO_set_ptrcnt
void
-PerlIO_set_ptrcnt(PerlIO *f, STDCHAR * ptr, int cnt)
+Perl_PerlIO_set_ptrcnt(pTHX_ PerlIO *f, STDCHAR * ptr, int cnt)
{
- dTHX;
PerlIO_funcs *tab = PerlIOBase(f)->tab;
if (tab->Set_ptrcnt == NULL) {
Perl_croak(aTHX_ "PerlIO buffer snooping abuse");
@@ -2401,7 +2330,6 @@
return PerlIOBase_pushed(aTHX_ f, mode, arg);
}
-#undef PerlIO_importFILE
PerlIO *
PerlIO_importFILE(FILE *stdio, int fl)
{
@@ -2721,7 +2649,6 @@
PerlSIO_set_ptr(stdio, (void*)ptr); /* LHS STDCHAR* cast non-portable */
#ifdef STDIO_PTR_LVAL_SETS_CNT
if (PerlSIO_get_cnt(stdio) != (cnt)) {
- dTHX;
assert(PerlSIO_get_cnt(stdio) == (cnt));
}
#endif
@@ -2797,15 +2724,14 @@
#endif /* USE_STDIO_PTR */
};
-#undef PerlIO_exportFILE
FILE *
PerlIO_exportFILE(PerlIO *f, int fl)
{
+ dTHX;
FILE *stdio;
PerlIO_flush(f);
stdio = fdopen(PerlIO_fileno(f), "r+");
if (stdio) {
- dTHX;
PerlIOStdio *s =
PerlIOSelf(PerlIO_push(aTHX_ f, &PerlIO_stdio, "r+", Nullsv),
PerlIOStdio);
@@ -2814,7 +2740,6 @@
return stdio;
}
-#undef PerlIO_findFILE
FILE *
PerlIO_findFILE(PerlIO *f)
{
@@ -2829,7 +2754,6 @@
return PerlIO_exportFILE(f, 0);
}
-#undef PerlIO_releaseFILE
void
PerlIO_releaseFILE(PerlIO *p, FILE *f)
{
@@ -3244,7 +3168,6 @@
PerlIO_get_base(f);
b->ptr = ptr;
if (PerlIO_get_cnt(f) != cnt || b->ptr < b->buf) {
- dTHX;
assert(PerlIO_get_cnt(f) == cnt);
assert(b->ptr >= b->buf);
}
@@ -3520,7 +3443,7 @@
/*
* Blast - found CR as last char in buffer
*/
-
+
if (b->ptr < nl) {
/*
* They may not care, defer work as long as
@@ -3586,7 +3509,7 @@
if (ptr+cnt == c->nl && c->nl+1 == b->end && *c->nl == 0xd) {
/* Defered CR at end of buffer case - we lied about count */
chk--;
- }
+ }
chk -= cnt;
if (ptr != chk ) {
@@ -3811,7 +3734,7 @@
}
IV
-PerlIOMmap_unmap(PerlIO *f)
+PerlIOMmap_unmap(pTHX_ PerlIO *f)
{
PerlIOMmap *m = PerlIOSelf(f, PerlIOMmap);
PerlIOBuf *b = &m->base;
@@ -3905,7 +3828,7 @@
* No, or wrong sort of, buffer
*/
if (m->len) {
- if (PerlIOMmap_unmap(f) != 0)
+ if (PerlIOMmap_unmap(aTHX_ f) != 0)
return 0;
}
/*
@@ -3935,7 +3858,7 @@
/*
* Unmap the buffer
*/
- if (PerlIOMmap_unmap(f) != 0)
+ if (PerlIOMmap_unmap(aTHX_ f) != 0)
code = -1;
}
else {
@@ -4017,33 +3940,27 @@
#endif /* HAS_MMAP */
-#undef PerlIO_stdin
PerlIO *
-PerlIO_stdin(void)
+Perl_PerlIO_stdin(pTHX)
{
- dTHX;
if (!PL_perlio) {
PerlIO_stdstreams(aTHX);
}
return &PL_perlio[1];
}
-#undef PerlIO_stdout
PerlIO *
-PerlIO_stdout(void)
+Perl_PerlIO_stdout(pTHX)
{
- dTHX;
if (!PL_perlio) {
PerlIO_stdstreams(aTHX);
}
return &PL_perlio[2];
}
-#undef PerlIO_stderr
PerlIO *
-PerlIO_stderr(void)
+Perl_PerlIO_stderr(pTHX)
{
- dTHX;
if (!PL_perlio) {
PerlIO_stdstreams(aTHX);
}
@@ -4052,7 +3969,6 @@
/*--------------------------------------------------------------------------------------*/
-#undef PerlIO_getname
char *
PerlIO_getname(PerlIO *f, char *buf)
{
@@ -4075,10 +3991,37 @@
* terms of above
*/
+#undef PerlIO_fdopen
+PerlIO *
+PerlIO_fdopen(int fd, const char *mode)
+{
+ dTHX;
+ return PerlIO_openn(aTHX_ Nullch, mode, fd, 0, 0, NULL, 0, NULL);
+}
+
+#undef PerlIO_open
+PerlIO *
+PerlIO_open(const char *path, const char *mode)
+{
+ dTHX;
+ SV *name = sv_2mortal(newSVpvn(path, strlen(path)));
+ return PerlIO_openn(aTHX_ Nullch, mode, -1, 0, 0, NULL, 1, &name);
+}
+
+#undef Perlio_reopen
+PerlIO *
+PerlIO_reopen(const char *path, const char *mode, PerlIO *f)
+{
+ dTHX;
+ SV *name = sv_2mortal(newSVpvn(path, strlen(path)));
+ return PerlIO_openn(aTHX_ Nullch, mode, -1, 0, 0, f, 1, &name);
+}
+
#undef PerlIO_getc
int
PerlIO_getc(PerlIO *f)
{
+ dTHX;
STDCHAR buf[1];
SSize_t count = PerlIO_read(f, buf, 1);
if (count == 1) {
@@ -4091,6 +4034,7 @@
int
PerlIO_ungetc(PerlIO *f, int ch)
{
+ dTHX;
if (ch != EOF) {
STDCHAR buf = ch;
if (PerlIO_unread(f, &buf, 1) == 1)
@@ -4103,6 +4047,7 @@
int
PerlIO_putc(PerlIO *f, int ch)
{
+ dTHX;
STDCHAR buf = ch;
return PerlIO_write(f, &buf, 1);
}
@@ -4111,6 +4056,7 @@
int
PerlIO_puts(PerlIO *f, const char *s)
{
+ dTHX;
STRLEN len = strlen(s);
return PerlIO_write(f, s, len);
}
@@ -4119,6 +4065,7 @@
void
PerlIO_rewind(PerlIO *f)
{
+ dTHX;
PerlIO_seek(f, (Off_t) 0, SEEK_SET);
PerlIO_clearerr(f);
}
@@ -4161,6 +4108,7 @@
int
PerlIO_stdoutf(const char *fmt, ...)
{
+ dTHX;
va_list ap;
int result;
va_start(ap, fmt);
==== //depot/perl/perlio.h#37 (text) ====
Index: perl/perlio.h
--- perl/perlio.h.~1~ Sat Dec 22 19:00:05 2001
+++ perl/perlio.h Sat Dec 22 19:00:05 2001
@@ -210,9 +210,6 @@
int fd, int imode, int perm, PerlIO *old,
int narg, SV **arg);
#endif
-#ifndef PerlIO_close
-extern int PerlIO_close(PerlIO *);
-#endif
#ifndef PerlIO_eof
extern int PerlIO_eof(PerlIO *);
#endif
@@ -228,15 +225,9 @@
#ifndef PerlIO_putc
extern int PerlIO_putc(PerlIO *, int);
#endif
-#ifndef PerlIO_flush
-extern int PerlIO_flush(PerlIO *);
-#endif
#ifndef PerlIO_ungetc
extern int PerlIO_ungetc(PerlIO *, int);
#endif
-#ifndef PerlIO_fileno
-extern int PerlIO_fileno(PerlIO *);
-#endif
#ifndef PerlIO_fdopen
extern PerlIO *PerlIO_fdopen(int, const char *);
#endif
==== //depot/perl/perlio.sym#5 (text) ====
Index: perl/perlio.sym
--- perl/perlio.sym.~1~ Sat Dec 22 19:00:05 2001
+++ perl/perlio.sym Sat Dec 22 19:00:05 2001
@@ -1,39 +1,18 @@
# Symbols which arise as part of the PerlIO abstraction
-PerlIO_stderr
-PerlIO_stderr
-PerlIO_stdin
-PerlIO_stdout
PerlIO_fast_gets
PerlIO_has_cntptr
PerlIO_canset_cnt
-PerlIO_set_cnt
-PerlIO_set_ptrcnt
-PerlIO_get_cnt
-PerlIO_get_bufsiz
-PerlIO_get_ptr
-PerlIO_get_base
PerlIO_has_base
PerlIO_puts
PerlIO_open
PerlIO_fdopen
PerlIO_reopen
-PerlIO_close
-PerlIO_eof
PerlIO_getname
PerlIO_getc
-PerlIO_error
-PerlIO_clearerr
-PerlIO_flush
-PerlIO_fileno
-PerlIO_setlinebuf
PerlIO_putc
PerlIO_ungetc
-PerlIO_read
-PerlIO_write
PerlIO_vprintf
-PerlIO_tell
-PerlIO_seek
PerlIO_rewind
PerlIO_printf
PerlIO_stdoutf
==== //depot/perl/pod/perlapi.pod#117 (text+w) ====
Index: perl/pod/perlapi.pod
--- perl/pod/perlapi.pod.~1~ Sat Dec 22 19:00:05 2001
+++ perl/pod/perlapi.pod Sat Dec 22 19:00:05 2001
@@ -2328,22 +2328,22 @@
=for hackers
Found in file sv.h
-=item SvIVx
+=item SvIVX
-Coerces the given SV to an integer and returns it. Guarantees to evaluate
-sv only once. Use the more efficient C<SvIV> otherwise.
+Returns the raw value in the SV's IV slot, without checks or conversions.
+Only use when you are sure SvIOK is true. See also C<SvIV()>.
- IV SvIVx(SV* sv)
+ IV SvIVX(SV* sv)
=for hackers
Found in file sv.h
-=item SvIVX
+=item SvIVx
-Returns the raw value in the SV's IV slot, without checks or conversions.
-Only use when you are sure SvIOK is true. See also C<SvIV()>.
+Coerces the given SV to an integer and returns it. Guarantees to evaluate
+sv only once. Use the more efficient C<SvIV> otherwise.
- IV SvIVX(SV* sv)
+ IV SvIVx(SV* sv)
=for hackers
Found in file sv.h
@@ -2996,22 +2996,22 @@
=for hackers
Found in file sv.h
-=item SvUVx
+=item SvUVX
-Coerces the given SV to an unsigned integer and returns it. Guarantees to
-evaluate sv only once. Use the more efficient C<SvUV> otherwise.
+Returns the raw value in the SV's UV slot, without checks or conversions.
+Only use when you are sure SvIOK is true. See also C<SvUV()>.
- UV SvUVx(SV* sv)
+ UV SvUVX(SV* sv)
=for hackers
Found in file sv.h
-=item SvUVX
+=item SvUVx
-Returns the raw value in the SV's UV slot, without checks or conversions.
-Only use when you are sure SvIOK is true. See also C<SvUV()>.
+Coerces the given SV to an unsigned integer and returns it. Guarantees to
+evaluate sv only once. Use the more efficient C<SvUV> otherwise.
- UV SvUVX(SV* sv)
+ UV SvUVx(SV* sv)
=for hackers
Found in file sv.h
==== //depot/perl/proto.h#361 (text+w) ====
Index: perl/proto.h
--- perl/proto.h.~1~ Sat Dec 22 19:00:05 2001
+++ perl/proto.h Sat Dec 22 19:00:05 2001
@@ -1335,5 +1335,33 @@
PERL_CALLCONV int Perl_my_socketpair(pTHX_ int family, int type, int protocol,
int fd[2]);
#endif
+
+#if defined(USE_PERLIO) && !defined(USE_SFIO)
+PERL_CALLCONV int Perl_PerlIO_close(pTHX_ PerlIO *);
+PERL_CALLCONV int Perl_PerlIO_fill(pTHX_ PerlIO *);
+PERL_CALLCONV int Perl_PerlIO_fileno(pTHX_ PerlIO *);
+PERL_CALLCONV int Perl_PerlIO_eof(pTHX_ PerlIO *);
+PERL_CALLCONV int Perl_PerlIO_error(pTHX_ PerlIO *);
+PERL_CALLCONV int Perl_PerlIO_flush(pTHX_ PerlIO *);
+PERL_CALLCONV void Perl_PerlIO_clearerr(pTHX_ PerlIO *);
+PERL_CALLCONV void Perl_PerlIO_set_cnt(pTHX_ PerlIO *, int);
+PERL_CALLCONV void Perl_PerlIO_set_ptrcnt(pTHX_ PerlIO *, STDCHAR *, int);
+PERL_CALLCONV void Perl_PerlIO_setlinebuf(pTHX_ PerlIO *);
+PERL_CALLCONV SSize_t Perl_PerlIO_read(pTHX_ PerlIO *, void *, Size_t);
+PERL_CALLCONV SSize_t Perl_PerlIO_write(pTHX_ PerlIO *, const void *, Size_t);
+PERL_CALLCONV SSize_t Perl_PerlIO_unread(pTHX_ PerlIO *, const void *, Size_t);
+PERL_CALLCONV Off_t Perl_PerlIO_tell(pTHX_ PerlIO *);
+PERL_CALLCONV int Perl_PerlIO_seek(pTHX_ PerlIO *, Off_t, int);
+
+PERL_CALLCONV STDCHAR * Perl_PerlIO_get_base(pTHX_ PerlIO *);
+PERL_CALLCONV STDCHAR * Perl_PerlIO_get_ptr(pTHX_ PerlIO *);
+PERL_CALLCONV int Perl_PerlIO_get_bufsiz(pTHX_ PerlIO *);
+PERL_CALLCONV int Perl_PerlIO_get_cnt(pTHX_ PerlIO *);
+
+PERL_CALLCONV PerlIO * Perl_PerlIO_stdin(pTHX);
+PERL_CALLCONV PerlIO * Perl_PerlIO_stdout(pTHX);
+PERL_CALLCONV PerlIO * Perl_PerlIO_stderr(pTHX);
+#endif /* PERLIO_LAYERS */
+
END_EXTERN_C
==== //depot/perl/win32/win32.c#180 (text) ====
Index: perl/win32/win32.c
--- perl/win32/win32.c.~1~ Sat Dec 22 19:00:05 2001
+++ perl/win32/win32.c Sat Dec 22 19:00:05 2001
@@ -7,7 +7,7 @@
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
*/
-
+#define PERLIO_NOT_STDIO 0
#define WIN32_LEAN_AND_MEAN
#define WIN32IO_IS_STDIO
#include <tchar.h>
@@ -25,7 +25,6 @@
/* #include "config.h" */
-#define PERLIO_NOT_STDIO 0
#if !defined(PERLIO_IS_STDIO) && !defined(USE_SFIO)
#define PerlIO FILE
#endif
End of Patch.
