X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/798525938d9e11ee1067df2b2406ec14aa83dd2b..04a4d38e84a8a9c5528d4a7aecd68cc820b7a6ac:/perlio.c diff --git a/perlio.c b/perlio.c index 49b1b2d..0cb4922 100644 --- a/perlio.c +++ b/perlio.c @@ -1,5 +1,5 @@ /* - * perlio.c Copyright (c) 1996-2005, Nick Ing-Simmons You may distribute + * perlio.c Copyright (c) 1996-2006, Nick Ing-Simmons You may distribute * under the terms of either the GNU General Public License or the * Artistic License, as specified in the README file. */ @@ -56,8 +56,6 @@ #include "XSUB.h" -#define PERLIO_MAX_REFCOUNTABLE_FD 2048 - #ifdef __Lynx__ /* Missing proto on LynxOS */ int mkstemp(char*); @@ -360,6 +358,7 @@ Perl_boot_core_PerlIO(pTHX) void PerlIO_init(pTHX) { + PERL_UNUSED_CONTEXT; /* * Does nothing (yet) except force this file to be included in perl * binary. That allows this file to force inclusion of other functions @@ -397,6 +396,7 @@ PerlIO_tmpfile(void) void PerlIO_init(pTHX) { + PERL_UNUSED_CONTEXT; /* * Force this file to be included in perl binary. Which allows this * file to force inclusion of other functions that may be required by @@ -480,7 +480,7 @@ PerlIO_debug(const char *fmt, ...) #else const char *s = CopFILE(PL_curcop); STRLEN len; - SV * const sv = newSVpvn("", 0); + SV * const sv = newSVpvs(""); Perl_sv_catpvf(aTHX_ sv, "%s:%" IVdf " ", s ? s : "(none)", (IV) CopLINE(PL_curcop)); Perl_sv_vcatpvf(aTHX_ sv, fmt, &ap); @@ -507,6 +507,7 @@ PerlIO_debug(const char *fmt, ...) PerlIO * PerlIO_allocate(pTHX) { + dVAR; /* * Find a free slot in the table, allocating new table as necessary */ @@ -572,6 +573,7 @@ PerlIO_list_t * PerlIO_list_alloc(pTHX) { PerlIO_list_t *list; + PERL_UNUSED_CONTEXT; Newxz(list, 1, PerlIO_list_t); list->refcnt = 1; return list; @@ -598,7 +600,10 @@ PerlIO_list_free(pTHX_ PerlIO_list_t *list) void PerlIO_list_push(pTHX_ PerlIO_list_t *list, PerlIO_funcs *funcs, SV *arg) { + dVAR; PerlIO_pair_t *p; + PERL_UNUSED_CONTEXT; + if (list->cur >= list->len) { list->len += 8; if (list->array) @@ -609,19 +614,19 @@ PerlIO_list_push(pTHX_ PerlIO_list_t *list, PerlIO_funcs *funcs, SV *arg) p = &(list->array[list->cur++]); p->funcs = funcs; if ((p->arg = arg)) { - (void)SvREFCNT_inc(arg); + SvREFCNT_inc_void_NN(arg); } } PerlIO_list_t * PerlIO_clone_list(pTHX_ PerlIO_list_t *proto, CLONE_PARAMS *param) { - PerlIO_list_t *list = (PerlIO_list_t *) NULL; + PerlIO_list_t *list = NULL; if (proto) { int i; list = PerlIO_list_alloc(aTHX); for (i=0; i < proto->cur; i++) { - SV *arg = Nullsv; + SV *arg = NULL; if (proto->array[i].arg) arg = PerlIO_sv_dup(aTHX_ proto->array[i].arg,param); PerlIO_list_push(aTHX_ list, proto->array[i].funcs, arg); @@ -660,6 +665,7 @@ PerlIO_clone(pTHX_ PerlInterpreter *proto, CLONE_PARAMS *param) void PerlIO_destruct(pTHX) { + dVAR; PerlIO **table = &PL_perlio; PerlIO *f; #ifdef USE_ITHREADS @@ -715,6 +721,7 @@ PerlIO_pop(pTHX_ PerlIO *f) AV * PerlIO_get_layers(pTHX_ PerlIO *f) { + dVAR; AV * const av = newAV(); if (PerlIOValid(f)) { @@ -760,21 +767,20 @@ PerlIO_find_layer(pTHX_ const char *name, STRLEN len, int load) Perl_croak(aTHX_ "Recursive call to Perl_load_module in PerlIO_find_layer"); return NULL; } else { - SV * const pkgsv = newSVpvn("PerlIO", 6); + SV * const pkgsv = newSVpvs("PerlIO"); SV * const layer = newSVpvn(name, len); CV * const cv = get_cv("PerlIO::Layer::NoWarnings", FALSE); ENTER; SAVEINT(PL_in_load_module); if (cv) { SAVEGENERICSV(PL_warnhook); - (void)SvREFCNT_inc(cv); - PL_warnhook = (SV *) cv; + PL_warnhook = (SV *) (SvREFCNT_inc_simple_NN(cv)); } PL_in_load_module++; /* * The two SVs are magically freed by load_module */ - Perl_load_module(aTHX_ 0, pkgsv, Nullsv, layer, Nullsv); + Perl_load_module(aTHX_ 0, pkgsv, NULL, layer, NULL); PL_in_load_module--; LEAVE; return PerlIO_find_layer(aTHX_ name, len, 0); @@ -851,7 +857,7 @@ XS(XS_io_MODIFY_SCALAR_ATTRIBUTES) const char * const name = SvPV_const(ST(i), len); SV * const layer = PerlIO_find_layer(aTHX_ name, len, 1); if (layer) { - av_push(av, SvREFCNT_inc(layer)); + av_push(av, SvREFCNT_inc_simple_NN(layer)); } else { ST(count) = ST(i); @@ -867,7 +873,7 @@ XS(XS_io_MODIFY_SCALAR_ATTRIBUTES) SV * PerlIO_tab_sv(pTHX_ PerlIO_funcs *tab) { - HV * const stash = gv_stashpv("PerlIO::Layer", TRUE); + HV * const stash = gv_stashpvs("PerlIO::Layer", TRUE); SV * const sv = sv_bless(newRV_noinc(newSViv(PTR2IV(tab))), stash); return sv; } @@ -877,6 +883,7 @@ XS(XS_PerlIO__Layer__NoWarnings) /* This is used as a %SIG{__WARN__} handler to supress warnings during loading of layers. */ + dVAR; dXSARGS; if (items) PerlIO_debug("warning:%s\n",SvPV_nolen_const(ST(0))); @@ -885,6 +892,7 @@ XS(XS_PerlIO__Layer__NoWarnings) XS(XS_PerlIO__Layer__find) { + dVAR; dXSARGS; if (items < 2) Perl_croak(aTHX_ "Usage class->find(name[,load])"); @@ -903,15 +911,17 @@ XS(XS_PerlIO__Layer__find) void PerlIO_define_layer(pTHX_ PerlIO_funcs *tab) { + dVAR; if (!PL_known_layers) PL_known_layers = PerlIO_list_alloc(aTHX); - PerlIO_list_push(aTHX_ PL_known_layers, tab, Nullsv); + PerlIO_list_push(aTHX_ PL_known_layers, tab, NULL); PerlIO_debug("define %s %p\n", tab->name, (void*)tab); } int PerlIO_parse_layers(pTHX_ PerlIO_list_t *av, const char *names) { + dVAR; if (names) { const char *s = names; while (*s) { @@ -920,7 +930,7 @@ PerlIO_parse_layers(pTHX_ PerlIO_list_t *av, const char *names) if (*s) { STRLEN llen = 0; const char *e = s; - const char *as = Nullch; + const char *as = NULL; STRLEN alen = 0; if (!isIDFIRST(*s)) { /* @@ -1005,6 +1015,7 @@ PerlIO_parse_layers(pTHX_ PerlIO_list_t *av, const char *names) void PerlIO_default_buffer(pTHX_ PerlIO_list_t *av) { + dVAR; PERLIO_FUNCS_DECL(*tab) = &PerlIO_perlio; #ifdef PERLIO_USING_CRLF tab = &PerlIO_crlf; @@ -1084,8 +1095,9 @@ PERLIO_FUNCS_DECL(PerlIO_remove) = { PerlIO_list_t * PerlIO_default_layers(pTHX) { + dVAR; if (!PL_def_layerlist) { - const char * const s = (PL_tainting) ? Nullch : PerlEnv_getenv("PERLIO"); + const char * const s = (PL_tainting) ? NULL : PerlEnv_getenv("PERLIO"); PERLIO_FUNCS_DECL(*osLayer) = &PerlIO_unix; PL_def_layerlist = PerlIO_list_alloc(aTHX); PerlIO_define_layer(aTHX_ PERLIO_FUNCS_CAST(&PerlIO_unix)); @@ -1135,6 +1147,7 @@ Perl_boot_core_PerlIO(pTHX) PerlIO_funcs * PerlIO_default_layer(pTHX_ I32 n) { + dVAR; PerlIO_list_t * const av = PerlIO_default_layers(aTHX); if (n < 0) n += av->cur; @@ -1147,6 +1160,7 @@ PerlIO_default_layer(pTHX_ I32 n) void PerlIO_stdstreams(pTHX) { + dVAR; if (!PL_perlio) { PerlIO_allocate(aTHX); PerlIO_fdopen(0, "Ir" PERLIO_STDTEXT); @@ -1345,7 +1359,7 @@ PerlIO_binmode(pTHX_ PerlIO *f, int iotype, int mode, const char *names) /* Legacy binmode is now _defined_ as being equivalent to pushing :raw So code that used to be here is now in PerlIORaw_pushed(). */ - return PerlIO_push(aTHX_ f, PERLIO_FUNCS_CAST(&PerlIO_raw), Nullch, Nullsv) ? TRUE : FALSE; + return PerlIO_push(aTHX_ f, PERLIO_FUNCS_CAST(&PerlIO_raw), NULL, NULL) ? TRUE : FALSE; } } @@ -1378,12 +1392,14 @@ Perl_PerlIO_close(pTHX_ PerlIO *f) int Perl_PerlIO_fileno(pTHX_ PerlIO *f) { + dVAR; Perl_PerlIO_or_Base(f, Fileno, fileno, -1, (aTHX_ f)); } static const char * PerlIO_context_layers(pTHX_ const char *mode) { + dVAR; const char *type = NULL; /* * Need to supply default layer info from open.pm @@ -1410,24 +1426,25 @@ PerlIO_context_layers(pTHX_ const char *mode) static PerlIO_funcs * PerlIO_layer_from_ref(pTHX_ SV *sv) { + dVAR; /* * For any scalar type load the handler which is bundled with perl */ if (SvTYPE(sv) < SVt_PVAV) - return PerlIO_find_layer(aTHX_ "scalar", 6, 1); + return PerlIO_find_layer(aTHX_ STR_WITH_LEN("scalar"), 1); /* * For other types allow if layer is known but don't try and load it */ switch (SvTYPE(sv)) { case SVt_PVAV: - return PerlIO_find_layer(aTHX_ "Array", 5, 0); + return PerlIO_find_layer(aTHX_ STR_WITH_LEN("Array"), 0); case SVt_PVHV: - return PerlIO_find_layer(aTHX_ "Hash", 4, 0); + return PerlIO_find_layer(aTHX_ STR_WITH_LEN("Hash"), 0); case SVt_PVCV: - return PerlIO_find_layer(aTHX_ "Code", 4, 0); + return PerlIO_find_layer(aTHX_ STR_WITH_LEN("Code"), 0); case SVt_PVGV: - return PerlIO_find_layer(aTHX_ "Glob", 4, 0); + return PerlIO_find_layer(aTHX_ STR_WITH_LEN("Glob"), 0); } return NULL; } @@ -1436,6 +1453,7 @@ PerlIO_list_t * PerlIO_resolve_layers(pTHX_ const char *layers, const char *mode, int narg, SV **args) { + dVAR; PerlIO_list_t *def = PerlIO_default_layers(aTHX); int incdef = 1; if (!PL_perlio) @@ -1480,7 +1498,7 @@ PerlIO_resolve_layers(pTHX_ const char *layers, } else { PerlIO_list_free(aTHX_ av); - return (PerlIO_list_t *) NULL; + return NULL; } } else { @@ -1494,6 +1512,7 @@ PerlIO * PerlIO_openn(pTHX_ const char *layers, const char *mode, int fd, int imode, int perm, PerlIO *f, int narg, SV **args) { + dVAR; if (!f && narg == 1 && *args == &PL_sv_undef) { if ((f = PerlIO_tmpfile())) { if (!layers || !*layers) @@ -1609,6 +1628,7 @@ Perl_PerlIO_tell(pTHX_ PerlIO *f) int Perl_PerlIO_flush(pTHX_ PerlIO *f) { + dVAR; if (f) { if (*f) { const PerlIO_funcs *tab = PerlIOBase(f)->tab; @@ -1650,6 +1670,7 @@ Perl_PerlIO_flush(pTHX_ PerlIO *f) void PerlIOBase_flush_linebuf(pTHX) { + dVAR; PerlIO **table = &PL_perlio; PerlIO *f; while ((f = *table)) { @@ -1816,6 +1837,7 @@ Perl_PerlIO_set_ptrcnt(pTHX_ PerlIO *f, STDCHAR * ptr, int cnt) IV PerlIOUtf8_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab) { + PERL_UNUSED_CONTEXT; PERL_UNUSED_ARG(mode); PERL_UNUSED_ARG(arg); if (PerlIOValid(f)) { @@ -1983,6 +2005,7 @@ IV PerlIOBase_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab) { PerlIOl * const l = PerlIOBase(f); + PERL_UNUSED_CONTEXT; PERL_UNUSED_ARG(arg); l->flags &= ~(PERLIO_F_CANREAD | PERLIO_F_CANWRITE | @@ -2041,6 +2064,7 @@ PerlIOBase_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab) IV PerlIOBase_popped(pTHX_ PerlIO *f) { + PERL_UNUSED_CONTEXT; PERL_UNUSED_ARG(f); return 0; } @@ -2052,7 +2076,7 @@ PerlIOBase_unread(pTHX_ PerlIO *f, const void *vbuf, Size_t count) * Save the position as current head considers it */ const Off_t old = PerlIO_tell(f); - PerlIO_push(aTHX_ f, PERLIO_FUNCS_CAST(&PerlIO_pending), "r", Nullsv); + PerlIO_push(aTHX_ f, PERLIO_FUNCS_CAST(&PerlIO_pending), "r", NULL); PerlIOSelf(f, PerlIOBuf)->posn = old; return PerlIOBuf_unread(aTHX_ f, vbuf, count); } @@ -2097,6 +2121,7 @@ PerlIOBase_read(pTHX_ PerlIO *f, void *vbuf, Size_t count) IV PerlIOBase_noop_ok(pTHX_ PerlIO *f) { + PERL_UNUSED_CONTEXT; PERL_UNUSED_ARG(f); return 0; } @@ -2104,6 +2129,7 @@ PerlIOBase_noop_ok(pTHX_ PerlIO *f) IV PerlIOBase_noop_fail(pTHX_ PerlIO *f) { + PERL_UNUSED_CONTEXT; PERL_UNUSED_ARG(f); return -1; } @@ -2140,6 +2166,7 @@ PerlIOBase_close(pTHX_ PerlIO *f) IV PerlIOBase_eof(pTHX_ PerlIO *f) { + PERL_UNUSED_CONTEXT; if (PerlIOValid(f)) { return (PerlIOBase(f)->flags & PERLIO_F_EOF) != 0; } @@ -2149,6 +2176,7 @@ PerlIOBase_eof(pTHX_ PerlIO *f) IV PerlIOBase_error(pTHX_ PerlIO *f) { + PERL_UNUSED_CONTEXT; if (PerlIOValid(f)) { return (PerlIOBase(f)->flags & PERLIO_F_ERROR) != 0; } @@ -2169,6 +2197,7 @@ PerlIOBase_clearerr(pTHX_ PerlIO *f) void PerlIOBase_setlinebuf(pTHX_ PerlIO *f) { + PERL_UNUSED_CONTEXT; if (PerlIOValid(f)) { PerlIOBase(f)->flags |= PERLIO_F_LINEBUF; } @@ -2178,7 +2207,7 @@ SV * PerlIO_sv_dup(pTHX_ SV *arg, CLONE_PARAMS *param) { if (!arg) - return Nullsv; + return NULL; #ifdef sv_dup if (param) { return sv_dup(arg, param); @@ -2212,7 +2241,7 @@ PerlIOBase_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param, int flags) if (self->Getarg) arg = (*self->Getarg)(aTHX_ o, param, flags); else { - arg = Nullsv; + arg = NULL; } f = PerlIO_push(aTHX_ f, self, PerlIO_modestr(o,buf), arg); if (arg) { @@ -2228,12 +2257,52 @@ perl_mutex PerlIO_mutex; /* PL_perlio_fd_refcnt[] is in intrpvar.h */ +/* Must be called with PerlIO_mutex locked. */ +static void +S_more_refcounted_fds(pTHX_ const int new_fd) { + const int old_max = PL_perlio_fd_refcnt_size; + const int new_max = 16 + (new_fd & ~15); + int *new_array; + + PerlIO_debug("More fds - old=%d, need %d, new=%d\n", + old_max, new_fd, new_max); + + if (new_fd < old_max) { + return; + } + + assert (new_max > new_fd); + + new_array + = PerlMemShared_realloc(PL_perlio_fd_refcnt, new_max * sizeof(int)); + + if (!new_array) { +#ifdef USE_THREADS + MUTEX_UNLOCK(&PerlIO_mutex); +#endif + /* Can't use PerlIO to write as it allocates memory */ + PerlLIO_write(PerlIO_fileno(Perl_error_log), + PL_no_mem, strlen(PL_no_mem)); + my_exit(1); + } + + PL_perlio_fd_refcnt_size = new_max; + PL_perlio_fd_refcnt = new_array; + + PerlIO_debug("Zeroing %p, %d\n", new_array + old_max, new_max - old_max); + + Zero(new_array + old_max, new_max - old_max, int); +} + + void PerlIO_init(pTHX) { /* Place holder for stdstreams call ??? */ #ifdef USE_THREADS MUTEX_INIT(&PerlIO_mutex); +#else + PERL_UNUSED_CONTEXT; #endif } @@ -2241,12 +2310,18 @@ void PerlIOUnix_refcnt_inc(int fd) { dTHX; - if (fd >= 0 && fd < PERLIO_MAX_REFCOUNTABLE_FD) { + if (fd >= 0) { + dVAR; + #ifdef USE_THREADS MUTEX_LOCK(&PerlIO_mutex); #endif + if (fd >= PL_perlio_fd_refcnt_size) + S_more_refcounted_fds(aTHX_ fd); + PL_perlio_fd_refcnt[fd]++; PerlIO_debug("fd %d refcnt=%d\n",fd,PL_perlio_fd_refcnt[fd]); + #ifdef USE_THREADS MUTEX_UNLOCK(&PerlIO_mutex); #endif @@ -2258,10 +2333,16 @@ PerlIOUnix_refcnt_dec(int fd) { dTHX; int cnt = 0; - if (fd >= 0 && fd < PERLIO_MAX_REFCOUNTABLE_FD) { + if (fd >= 0) { + dVAR; #ifdef USE_THREADS MUTEX_LOCK(&PerlIO_mutex); #endif + /* XXX should this be a panic? */ + if (fd >= PL_perlio_fd_refcnt_size) + S_more_refcounted_fds(aTHX_ fd); + + /* XXX should this be a panic if it drops below 0? */ cnt = --PL_perlio_fd_refcnt[fd]; PerlIO_debug("fd %d refcnt=%d\n",fd,cnt); #ifdef USE_THREADS @@ -2274,6 +2355,7 @@ PerlIOUnix_refcnt_dec(int fd) void PerlIO_cleanup(pTHX) { + dVAR; int i; #ifdef USE_ITHREADS PerlIO_debug("Cleanup layers for %p\n",aTHX); @@ -2370,6 +2452,7 @@ PerlIOUnix_oflags(const char *mode) IV PerlIOUnix_fileno(pTHX_ PerlIO *f) { + PERL_UNUSED_CONTEXT; return PerlIOSelf(f, PerlIOUnix)->fd; } @@ -2392,6 +2475,7 @@ PerlIOUnix_setfd(pTHX_ PerlIO *f, int fd, int imode) s->fd = fd; s->oflags = imode; PerlIOUnix_refcnt_inc(fd); + PERL_UNUSED_CONTEXT; } IV @@ -2419,6 +2503,7 @@ PerlIOUnix_seek(pTHX_ PerlIO *f, Off_t offset, int whence) { const int fd = PerlIOSelf(f, PerlIOUnix)->fd; Off_t new_loc; + PERL_UNUSED_CONTEXT; if (PerlIOBase(f)->flags & PERLIO_F_NOTREG) { #ifdef ESPIPE SETERRNO(ESPIPE, LIB_INVARG); @@ -2474,6 +2559,7 @@ PerlIOUnix_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers, } else { if (f) { + /*EMPTY*/; /* * FIXME: pop layers ??? */ @@ -2490,7 +2576,7 @@ PerlIOUnix_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param, int flags) if (flags & PERLIO_DUP_FD) { fd = PerlLIO_dup(fd); } - if (fd >= 0 && fd < PERLIO_MAX_REFCOUNTABLE_FD) { + if (fd >= 0) { f = PerlIOBase_dup(aTHX_ f, o, param, flags); if (f) { /* If all went well overwrite fd in dup'ed lay with the dup()'ed fd */ @@ -2505,6 +2591,7 @@ PerlIOUnix_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param, int flags) SSize_t PerlIOUnix_read(pTHX_ PerlIO *f, void *vbuf, Size_t count) { + dVAR; const int fd = PerlIOSelf(f, PerlIOUnix)->fd; #ifdef PERLIO_STD_SPECIAL if (fd == 0) @@ -2536,6 +2623,7 @@ PerlIOUnix_read(pTHX_ PerlIO *f, void *vbuf, Size_t count) SSize_t PerlIOUnix_write(pTHX_ PerlIO *f, const void *vbuf, Size_t count) { + dVAR; const int fd = PerlIOSelf(f, PerlIOUnix)->fd; #ifdef PERLIO_STD_SPECIAL if (fd == 1 || fd == 2) @@ -2559,6 +2647,8 @@ PerlIOUnix_write(pTHX_ PerlIO *f, const void *vbuf, Size_t count) Off_t PerlIOUnix_tell(pTHX_ PerlIO *f) { + PERL_UNUSED_CONTEXT; + return PerlLIO_lseek(PerlIOSelf(f, PerlIOUnix)->fd, 0, SEEK_CUR); } @@ -2566,6 +2656,7 @@ PerlIOUnix_tell(pTHX_ PerlIO *f) IV PerlIOUnix_close(pTHX_ PerlIO *f) { + dVAR; const int fd = PerlIOSelf(f, PerlIOUnix)->fd; int code = 0; if (PerlIOBase(f)->flags & PERLIO_F_OPEN) { @@ -2643,6 +2734,8 @@ typedef struct { IV PerlIOStdio_fileno(pTHX_ PerlIO *f) { + PERL_UNUSED_CONTEXT; + if (PerlIOValid(f)) { FILE * const s = PerlIOSelf(f, PerlIOStdio)->stdio; if (s) @@ -2727,7 +2820,7 @@ PerlIO_importFILE(FILE *stdio, const char *mode) } fclose(f2); } - if ((f = PerlIO_push(aTHX_(f = PerlIO_allocate(aTHX)), PERLIO_FUNCS_CAST(&PerlIO_stdio), mode, Nullsv))) { + if ((f = PerlIO_push(aTHX_(f = PerlIO_allocate(aTHX)), PERLIO_FUNCS_CAST(&PerlIO_stdio), mode, NULL))) { s = PerlIOSelf(f, PerlIOStdio); s->stdio = stdio; } @@ -2847,6 +2940,7 @@ PerlIOStdio_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param, int flags) goto set_this; } else { + /*EMPTY*/; /* FIXME: To avoid messy error recovery if dup fails re-use the existing stdio as though flag was not set */ @@ -2863,6 +2957,8 @@ PerlIOStdio_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param, int flags) static int PerlIOStdio_invalidate_fileno(pTHX_ FILE *f) { + PERL_UNUSED_CONTEXT; + /* XXX this could use PerlIO_canset_fileno() and * PerlIO_set_fileno() support from Configure */ @@ -3038,6 +3134,7 @@ PerlIOStdio_close(pTHX_ PerlIO *f) SSize_t PerlIOStdio_read(pTHX_ PerlIO *f, void *vbuf, Size_t count) { + dVAR; FILE * const s = PerlIOSelf(f, PerlIOStdio)->stdio; SSize_t got = 0; for (;;) { @@ -3126,6 +3223,7 @@ PerlIOStdio_unread(pTHX_ PerlIO *f, const void *vbuf, Size_t count) SSize_t PerlIOStdio_write(pTHX_ PerlIO *f, const void *vbuf, Size_t count) { + dVAR; SSize_t got; for (;;) { got = PerlSIO_fwrite(vbuf, 1, count, @@ -3142,6 +3240,8 @@ IV PerlIOStdio_seek(pTHX_ PerlIO *f, Off_t offset, int whence) { FILE * const stdio = PerlIOSelf(f, PerlIOStdio)->stdio; + PERL_UNUSED_CONTEXT; + return PerlSIO_fseek(stdio, offset, whence); } @@ -3149,6 +3249,8 @@ Off_t PerlIOStdio_tell(pTHX_ PerlIO *f) { FILE * const stdio = PerlIOSelf(f, PerlIOStdio)->stdio; + PERL_UNUSED_CONTEXT; + return PerlSIO_ftell(stdio); } @@ -3156,10 +3258,13 @@ IV PerlIOStdio_flush(pTHX_ PerlIO *f) { FILE * const stdio = PerlIOSelf(f, PerlIOStdio)->stdio; + PERL_UNUSED_CONTEXT; + if (PerlIOBase(f)->flags & PERLIO_F_CANWRITE) { return PerlSIO_fflush(stdio); } else { + /*EMPTY*/; #if 0 /* * FIXME: This discards ungetc() and pre-read stuff which is not @@ -3181,28 +3286,36 @@ PerlIOStdio_flush(pTHX_ PerlIO *f) IV PerlIOStdio_eof(pTHX_ PerlIO *f) { + PERL_UNUSED_CONTEXT; + return PerlSIO_feof(PerlIOSelf(f, PerlIOStdio)->stdio); } IV PerlIOStdio_error(pTHX_ PerlIO *f) { + PERL_UNUSED_CONTEXT; + return PerlSIO_ferror(PerlIOSelf(f, PerlIOStdio)->stdio); } void PerlIOStdio_clearerr(pTHX_ PerlIO *f) { + PERL_UNUSED_CONTEXT; + PerlSIO_clearerr(PerlIOSelf(f, PerlIOStdio)->stdio); } void PerlIOStdio_setlinebuf(pTHX_ PerlIO *f) { + PERL_UNUSED_CONTEXT; + #ifdef HAS_SETLINEBUF PerlSIO_setlinebuf(PerlIOSelf(f, PerlIOStdio)->stdio); #else - PerlSIO_setvbuf(PerlIOSelf(f, PerlIOStdio)->stdio, Nullch, _IOLBF, 0); + PerlSIO_setvbuf(PerlIOSelf(f, PerlIOStdio)->stdio, NULL, _IOLBF, 0); #endif } @@ -3283,6 +3396,8 @@ PerlIOStdio_fill(pTHX_ PerlIO *f) { FILE * const stdio = PerlIOSelf(f, PerlIOStdio)->stdio; int c; + PERL_UNUSED_CONTEXT; + /* * fflush()ing read-only streams can cause trouble on some stdio-s */ @@ -3406,7 +3521,7 @@ PerlIO_exportFILE(PerlIO * f, const char *mode) PerlIO *f2; /* De-link any lower layers so new :stdio sticks */ *f = NULL; - if ((f2 = PerlIO_push(aTHX_ f, PERLIO_FUNCS_CAST(&PerlIO_stdio), buf, Nullsv))) { + if ((f2 = PerlIO_push(aTHX_ f, PERLIO_FUNCS_CAST(&PerlIO_stdio), buf, NULL))) { PerlIOStdio *s = PerlIOSelf((f = f2), PerlIOStdio); s->stdio = stdio; /* Link previous lower layers under new one */ @@ -3434,7 +3549,7 @@ PerlIO_findFILE(PerlIO *f) l = *PerlIONext(&l); } /* Uses fallback "mode" via PerlIO_modestr() in PerlIO_exportFILE */ - return PerlIO_exportFILE(f, Nullch); + return PerlIO_exportFILE(f, NULL); } /* Use this to reverse PerlIO_exportFILE calls. */ @@ -3528,7 +3643,7 @@ PerlIOBuf_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers, #ifdef PERLIO_USING_CRLF # ifdef PERLIO_IS_BINMODE_FD if (PERLIO_IS_BINMODE_FD(fd)) - PerlIO_binmode(aTHX_ f, '<'/*not used*/, O_BINARY, Nullch); + PerlIO_binmode(aTHX_ f, '<'/*not used*/, O_BINARY, NULL); else # endif /* @@ -3889,6 +4004,8 @@ STDCHAR * PerlIOBuf_get_base(pTHX_ PerlIO *f) { PerlIOBuf * const b = PerlIOSelf(f, PerlIOBuf); + PERL_UNUSED_CONTEXT; + if (!b->buf) { if (!b->bufsiz) b->bufsiz = 4096; @@ -4287,6 +4404,7 @@ PerlIOCrlf_set_ptrcnt(pTHX_ PerlIO *f, STDCHAR * ptr, SSize_t cnt) ptr -= cnt; } else { + /*EMPTY*/; #if 0 /* * Test code - delete when it works ... @@ -4715,6 +4833,7 @@ PERLIO_FUNCS_DECL(PerlIO_mmap) = { PerlIO * Perl_PerlIO_stdin(pTHX) { + dVAR; if (!PL_perlio) { PerlIO_stdstreams(aTHX); } @@ -4724,6 +4843,7 @@ Perl_PerlIO_stdin(pTHX) PerlIO * Perl_PerlIO_stdout(pTHX) { + dVAR; if (!PL_perlio) { PerlIO_stdstreams(aTHX); } @@ -4733,6 +4853,7 @@ Perl_PerlIO_stdout(pTHX) PerlIO * Perl_PerlIO_stderr(pTHX) { + dVAR; if (!PL_perlio) { PerlIO_stdstreams(aTHX); } @@ -4762,7 +4883,7 @@ PerlIO_getname(PerlIO *f, char *buf) PERL_UNUSED_ARG(f); PERL_UNUSED_ARG(buf); Perl_croak(aTHX_ "Don't know how to get file name"); - return Nullch; + return NULL; #endif } @@ -4778,7 +4899,7 @@ PerlIO * PerlIO_fdopen(int fd, const char *mode) { dTHX; - return PerlIO_openn(aTHX_ Nullch, mode, fd, 0, 0, NULL, 0, NULL); + return PerlIO_openn(aTHX_ NULL, mode, fd, 0, 0, NULL, 0, NULL); } #undef PerlIO_open @@ -4787,7 +4908,7 @@ PerlIO_open(const char *path, const char *mode) { dTHX; SV *name = sv_2mortal(newSVpv(path, 0)); - return PerlIO_openn(aTHX_ Nullch, mode, -1, 0, 0, NULL, 1, &name); + return PerlIO_openn(aTHX_ NULL, mode, -1, 0, 0, NULL, 1, &name); } #undef Perlio_reopen @@ -4796,7 +4917,7 @@ PerlIO_reopen(const char *path, const char *mode, PerlIO *f) { dTHX; SV *name = sv_2mortal(newSVpv(path,0)); - return PerlIO_openn(aTHX_ Nullch, mode, -1, 0, 0, f, 1, &name); + return PerlIO_openn(aTHX_ NULL, mode, -1, 0, 0, f, 1, &name); } #undef PerlIO_getc @@ -4855,7 +4976,7 @@ int PerlIO_vprintf(PerlIO *f, const char *fmt, va_list ap) { dTHX; - SV * const sv = newSVpvn("", 0); + SV * const sv = newSVpvs(""); const char *s; STRLEN len; SSize_t wrote; @@ -4909,7 +5030,7 @@ PerlIO_tmpfile(void) f = PerlIO_fdopen(fd, "w+b"); #else /* WIN32 */ # if defined(HAS_MKSTEMP) && ! defined(VMS) && ! defined(OS2) - SV * const sv = newSVpv("/tmp/PerlIO_XXXXXX", 0); + SV * const sv = newSVpvs("/tmp/PerlIO_XXXXXX"); /* * I have no idea how portable mkstemp() is ... NI-S */ @@ -4927,7 +5048,7 @@ PerlIO_tmpfile(void) if (stdio) { if ((f = PerlIO_push(aTHX_(PerlIO_allocate(aTHX)), PERLIO_FUNCS_CAST(&PerlIO_stdio), - "w+", Nullsv))) { + "w+", NULL))) { PerlIOStdio * const s = PerlIOSelf(f, PerlIOStdio); if (s)