/* Call the callback or PerlIOBase, and return failure. */
#define Perl_PerlIO_or_Base(f, callback, base, failure, args) \
if (PerlIOValid(f)) { \
- const PerlIO_funcs *tab = PerlIOBase(f)->tab; \
+ const PerlIO_funcs * const tab = PerlIOBase(f)->tab;\
if (tab && tab->callback) \
return (*tab->callback) args; \
else \
/* Call the callback or fail, and return failure. */
#define Perl_PerlIO_or_fail(f, callback, failure, args) \
if (PerlIOValid(f)) { \
- const PerlIO_funcs *tab = PerlIOBase(f)->tab; \
+ const PerlIO_funcs * const tab = PerlIOBase(f)->tab;\
if (tab && tab->callback) \
return (*tab->callback) args; \
SETERRNO(EINVAL, LIB_INVARG); \
/* Call the callback or PerlIOBase, and be void. */
#define Perl_PerlIO_or_Base_void(f, callback, base, args) \
if (PerlIOValid(f)) { \
- const PerlIO_funcs *tab = PerlIOBase(f)->tab; \
+ const PerlIO_funcs * const tab = PerlIOBase(f)->tab;\
if (tab && tab->callback) \
(*tab->callback) args; \
else \
/* Call the callback or fail, and be void. */
#define Perl_PerlIO_or_fail_void(f, callback, args) \
if (PerlIOValid(f)) { \
- const PerlIO_funcs *tab = PerlIOBase(f)->tab; \
+ const PerlIO_funcs * const tab = PerlIOBase(f)->tab;\
if (tab && tab->callback) \
(*tab->callback) args; \
else \
if ((SSize_t) len <= 0)
len = strlen(name);
for (i = 0; i < PL_known_layers->cur; i++) {
- PerlIO_funcs *f = PL_known_layers->array[i].funcs;
+ PerlIO_funcs * const f = PL_known_layers->array[i].funcs;
if (memEQ(f->name, name, len) && f->name[len] == 0) {
PerlIO_debug("%.*s => %p\n", (int) len, name, (void*)f);
return f;
Perl_croak(aTHX_ "Recursive call to Perl_load_module in PerlIO_find_layer");
return NULL;
} else {
- SV *pkgsv = newSVpvn("PerlIO", 6);
- SV *layer = newSVpvn(name, len);
- CV *cv = get_cv("PerlIO::Layer::NoWarnings", FALSE);
- ENTER;
+ SV * const pkgsv = newSVpvn("PerlIO", 6);
+ 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);
SV *
PerlIO_tab_sv(pTHX_ PerlIO_funcs *tab)
{
- HV *stash = gv_stashpv("PerlIO::Layer", TRUE);
- SV *sv = sv_bless(newRV_noinc(newSViv(PTR2IV(tab))), stash);
+ HV * const stash = gv_stashpv("PerlIO::Layer", TRUE);
+ SV * const sv = sv_bless(newRV_noinc(newSViv(PTR2IV(tab))), stash);
return sv;
}
Perl_croak(aTHX_ "Usage class->find(name[,load])");
else {
STRLEN len;
- const char *name = SvPV_const(ST(1), len);
+ const char * const name = SvPV_const(ST(1), len);
const bool load = (items > 2) ? SvTRUE(ST(2)) : 0;
- PerlIO_funcs *layer = PerlIO_find_layer(aTHX_ name, len, load);
+ PerlIO_funcs * const layer = PerlIO_find_layer(aTHX_ name, len, load);
ST(0) =
(layer) ? sv_2mortal(PerlIO_tab_sv(aTHX_ layer)) :
&PL_sv_undef;
}
}
if (e > s) {
- PerlIO_funcs *layer =
+ PerlIO_funcs * const layer =
PerlIO_find_layer(aTHX_ s, llen, 1);
if (layer) {
PerlIO_list_push(aTHX_ av, layer,
PerlIO_funcs *
PerlIO_default_layer(pTHX_ I32 n)
{
- PerlIO_list_t *av = PerlIO_default_layers(aTHX);
+ PerlIO_list_t * const av = PerlIO_default_layers(aTHX);
if (n < 0)
n += av->cur;
return PerlIO_layer_fetch(aTHX_ av, n, PERLIO_FUNCS_CAST(&PerlIO_stdio));
PerlIO__close(pTHX_ PerlIO *f)
{
if (PerlIOValid(f)) {
- PerlIO_funcs *tab = PerlIOBase(f)->tab;
+ PerlIO_funcs * const tab = PerlIOBase(f)->tab;
if (tab && tab->Close)
return (*tab->Close)(aTHX_ f);
else
* for it
*/
if (SvROK(arg) && !sv_isobject(arg)) {
- PerlIO_funcs *handler = PerlIO_layer_from_ref(aTHX_ SvRV(arg));
+ PerlIO_funcs * const handler = PerlIO_layer_from_ref(aTHX_ SvRV(arg));
if (handler) {
def = PerlIO_list_alloc(aTHX);
PerlIO_list_push(aTHX_ def, handler, &PL_sv_undef);
PerlIOl *l = *f;
layera = PerlIO_list_alloc(aTHX);
while (l) {
- SV *arg = (l->tab->Getarg)
+ SV * const arg = (l->tab->Getarg)
? (*l->tab->Getarg) (aTHX_ &l, NULL, 0)
: &PL_sv_undef;
PerlIO_list_push(aTHX_ layera, l->tab, arg);
*/
n = layera->cur - 1;
while (n >= 0) {
- PerlIO_funcs *t = PerlIO_layer_fetch(aTHX_ layera, n, NULL);
+ PerlIO_funcs * const t = PerlIO_layer_fetch(aTHX_ layera, n, NULL);
if (t && t->Open) {
tab = t;
break;
PerlIO_has_base(PerlIO *f)
{
if (PerlIOValid(f)) {
- const PerlIO_funcs *tab = PerlIOBase(f)->tab;
+ const PerlIO_funcs * const tab = PerlIOBase(f)->tab;
if (tab)
return (tab->Get_base != NULL);
PerlIO_fast_gets(PerlIO *f)
{
if (PerlIOValid(f) && (PerlIOBase(f)->flags & PERLIO_F_FASTGETS)) {
- const PerlIO_funcs *tab = PerlIOBase(f)->tab;
+ const PerlIO_funcs * const tab = PerlIOBase(f)->tab;
if (tab)
return (tab->Set_ptrcnt != NULL);
PerlIO_has_cntptr(PerlIO *f)
{
if (PerlIOValid(f)) {
- const PerlIO_funcs *tab = PerlIOBase(f)->tab;
+ const PerlIO_funcs * const tab = PerlIOBase(f)->tab;
if (tab)
return (tab->Get_ptr != NULL && tab->Get_cnt != NULL);
PerlIO_canset_cnt(PerlIO *f)
{
if (PerlIOValid(f)) {
- const PerlIO_funcs *tab = PerlIOBase(f)->tab;
+ const PerlIO_funcs * const tab = PerlIOBase(f)->tab;
if (tab)
return (tab->Set_ptrcnt != NULL);
return 0;
}
while (count > 0) {
+ get_cnt:
+ {
SSize_t avail = PerlIO_get_cnt(f);
SSize_t take = 0;
if (avail > 0)
PerlIO_set_ptrcnt(f, ptr + take, (avail -= take));
count -= take;
buf += take;
+ if (avail == 0) /* set_ptrcnt could have reset avail */
+ goto get_cnt;
}
if (count > 0 && avail <= 0) {
if (PerlIO_fill(f) != 0)
break;
}
+ }
}
return (buf - (STDCHAR *) vbuf);
}
{
PerlIO *n;
if (PerlIOValid(f) && PerlIOValid(n = PerlIONext(f))) {
- PerlIO_funcs *toptab = PerlIOBase(n)->tab;
+ PerlIO_funcs * const toptab = PerlIOBase(n)->tab;
if (toptab == tab) {
/* Top is already stdio - pop self (duplicate) and use original */
PerlIO_pop(aTHX_ f);
/*
* This "flush" is akin to sfio's sync in that it handles files in either
- * read or write state
+ * read or write state. For write state, we put the postponed data through
+ * the next layers. For read state, we seek() the next layers to the
+ * offset given by current position in the buffer, and discard the buffer
+ * state (XXXX supposed to be for seek()able buffers only, but now it is done
+ * in any case?). Then the pass the stick further in chain.
*/
IV
PerlIOBuf_flush(pTHX_ PerlIO *f)
return code;
}
+/* This discards the content of the buffer after b->ptr, and rereads
+ * the buffer from the position off in the layer downstream; here off
+ * is at offset corresponding to b->ptr - b->buf.
+ */
IV
PerlIOBuf_fill(pTHX_ PerlIO *f)
{
* Down-stream flush is defined not to loose read data so is harmless.
* we would not normally be fill'ing if there was data left in anycase.
*/
- if (PerlIO_flush(f) != 0)
+ if (PerlIO_flush(f) != 0) /* XXXX Check that its seek() succeeded?! */
return -1;
if (PerlIOBase(f)->flags & PERLIO_F_TTY)
PerlIOBase_flush_linebuf(aTHX);
* crlf - translation On read translate CR,LF to "\n" we do this by
* overriding ptr/cnt entries to hand back a line at a time and keeping a
* record of which nl we "lied" about. On write translate "\n" to CR,LF
+ *
+ * c->nl points on the first byte of CR LF pair when it is temporarily
+ * replaced by LF, or to the last CR of the buffer. In the former case
+ * the caller thinks that the buffer ends at c->nl + 1, in the latter
+ * that it ends at c->nl; these two cases can be distinguished by
+ * *c->nl. c->nl is set during _getcnt() call, and unset during
+ * _unread() and _flush() calls.
+ * It only matters for read operations.
*/
typedef struct {
PerlIOCrlf_unread(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
{
PerlIOCrlf *c = PerlIOSelf(f, PerlIOCrlf);
- if (c->nl) {
+ if (c->nl) { /* XXXX Shouldn't it be done only if b->ptr > c->nl? */
*(c->nl) = 0xd;
c->nl = NULL;
}
count--;
}
else {
- buf++;
- break;
+ /* If b->ptr - 1 == b->buf, we are undoing reading 0xa */
+ *--(b->ptr) = 0xa; /* Works even if 0xa == '\r' */
+ unread++;
+ count--;
}
}
else {
}
}
+/* XXXX This code assumes that buffer size >=2, but does not check it... */
SSize_t
PerlIOCrlf_get_cnt(pTHX_ PerlIO *f)
{
https://perl5.git.perl.org / perl5.git / blobdiff