PerlIO *
PerlIO_push(pTHX_ PerlIO *f, PerlIO_funcs *tab, const char *mode, SV *arg)
{
- if (tab->fsize != sizeof(PerlIO_funcs)) {
- mismatch:
- Perl_croak(aTHX_ "Layer does not match this perl");
- }
- if (tab->size) {
- PerlIOl *l = NULL;
- if (tab->size < sizeof(PerlIOl)) {
- goto mismatch;
- }
- /* Real layer with a data area */
- Newc('L',l,tab->size,char,PerlIOl);
- if (l && f) {
- Zero(l, tab->size, char);
- l->next = *f;
- l->tab = tab;
- *f = l;
- PerlIO_debug("PerlIO_push f=%p %s %s %p\n", (void*)f, tab->name,
- (mode) ? mode : "(Null)", (void*)arg);
- if ((*l->tab->Pushed) (aTHX_ f, mode, arg, tab) != 0) {
- PerlIO_pop(aTHX_ f);
- return NULL;
- }
- }
- }
- else if (f) {
- /* Pseudo-layer where push does its own stack adjust */
- if ((*tab->Pushed) (aTHX_ f, mode, arg, tab) != 0) {
+ PerlIOl *l = NULL;
+ Newc('L',l,tab->size,char,PerlIOl);
+ if (l && f) {
+ Zero(l, tab->size, char);
+ l->next = *f;
+ l->tab = tab;
+ *f = l;
+ PerlIO_debug("PerlIO_push f=%p %s %s %p\n", (void*)f, tab->name,
+ (mode) ? mode : "(Null)", (void*)arg);
+ if ((*l->tab->Pushed) (aTHX_ f, mode, arg) != 0) {
+ PerlIO_pop(aTHX_ f);
return NULL;
}
}
}
IV
-PerlIOPop_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab)
+PerlIOPop_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg)
{
PerlIO_pop(aTHX_ f);
if (*f) {
}
IV
-PerlIORaw_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab)
+PerlIORaw_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg)
{
if (PerlIOValid(f)) {
PerlIO *t;
PerlIOl *l;
+ PerlIO_pop(aTHX_ f); /* Remove the dummy layer */
PerlIO_flush(f);
/*
* Strip all layers that are not suitable for a raw stream
*/
IV
-PerlIOUtf8_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab)
+PerlIOUtf8_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg)
{
if (*PerlIONext(f)) {
+ PerlIO_funcs *tab = PerlIOBase(f)->tab;
+ PerlIO_pop(aTHX_ f);
if (tab->kind & PERLIO_K_UTF8)
PerlIOBase(f)->flags |= PERLIO_F_UTF8;
else
}
PerlIO_funcs PerlIO_utf8 = {
- sizeof(PerlIO_funcs),
"utf8",
- 0,
+ sizeof(PerlIOl),
PERLIO_K_DUMMY | PERLIO_K_UTF8,
PerlIOUtf8_pushed,
NULL,
};
PerlIO_funcs PerlIO_byte = {
- sizeof(PerlIO_funcs),
"bytes",
- 0,
+ sizeof(PerlIOl),
PERLIO_K_DUMMY,
PerlIOUtf8_pushed,
NULL,
}
PerlIO_funcs PerlIO_raw = {
- sizeof(PerlIO_funcs),
"raw",
- 0,
+ sizeof(PerlIOl),
PERLIO_K_DUMMY,
PerlIORaw_pushed,
PerlIOBase_popped,
}
IV
-PerlIOBase_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab)
+PerlIOBase_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg)
{
PerlIOl *l = PerlIOBase(f);
#if 0
const char *omode = mode;
char temp[8];
#endif
+ PerlIO_funcs *tab = PerlIOBase(f)->tab;
l->flags &= ~(PERLIO_F_CANREAD | PERLIO_F_CANWRITE |
PERLIO_F_TRUNCATE | PERLIO_F_APPEND);
if (tab->Set_ptrcnt != NULL)
}
IV
-PerlIOUnix_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab)
+PerlIOUnix_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg)
{
- IV code = PerlIOBase_pushed(aTHX_ f, mode, arg, tab);
+ IV code = PerlIOBase_pushed(aTHX_ f, mode, arg);
PerlIOUnix *s = PerlIOSelf(f, PerlIOUnix);
if (*PerlIONext(f)) {
/* We never call down so do any pending stuff now */
}
PerlIO_funcs PerlIO_unix = {
- sizeof(PerlIO_funcs),
"unix",
sizeof(PerlIOUnix),
PERLIO_K_RAW,
* This isn't used yet ...
*/
IV
-PerlIOStdio_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab)
+PerlIOStdio_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg)
{
if (*PerlIONext(f)) {
PerlIOStdio *s = PerlIOSelf(f, PerlIOStdio);
else
return -1;
}
- return PerlIOBase_pushed(aTHX_ f, mode, arg, tab);
+ return PerlIOBase_pushed(aTHX_ f, mode, arg);
}
PerlIO_funcs PerlIO_stdio = {
- sizeof(PerlIO_funcs),
"stdio",
sizeof(PerlIOStdio),
PERLIO_K_BUFFERED|PERLIO_K_RAW,
*/
IV
-PerlIOBuf_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab)
+PerlIOBuf_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg)
{
PerlIOBuf *b = PerlIOSelf(f, PerlIOBuf);
int fd = PerlIO_fileno(f);
b->posn = posn;
}
}
- return PerlIOBase_pushed(aTHX_ f, mode, arg, tab);
+ return PerlIOBase_pushed(aTHX_ f, mode, arg);
}
PerlIO *
PerlIO_funcs *tab = PerlIO_layer_fetch(aTHX_ layers, n - 1, PerlIOBase(next)->tab);
next = (*tab->Open) (aTHX_ tab, layers, n - 1, mode, fd, imode, perm,
next, narg, args);
- if (!next || (*PerlIOBase(f)->tab->Pushed) (aTHX_ f, mode, PerlIOArg, self) != 0) {
+ if (!next || (*PerlIOBase(f)->tab->Pushed) (aTHX_ f, mode, PerlIOArg) != 0) {
return NULL;
}
}
PerlIO_funcs PerlIO_perlio = {
- sizeof(PerlIO_funcs),
"perlio",
sizeof(PerlIOBuf),
PERLIO_K_BUFFERED|PERLIO_K_RAW,
}
IV
-PerlIOPending_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab)
+PerlIOPending_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg)
{
- IV code = PerlIOBase_pushed(aTHX_ f, mode, arg, tab);
+ IV code = PerlIOBase_pushed(aTHX_ f, mode, arg);
PerlIOl *l = PerlIOBase(f);
/*
* Our PerlIO_fast_gets must match what we are pushed on, or sv_gets()
}
PerlIO_funcs PerlIO_pending = {
- sizeof(PerlIO_funcs),
"pending",
sizeof(PerlIOBuf),
PERLIO_K_BUFFERED|PERLIO_K_RAW, /* not sure about RAW here */
} PerlIOCrlf;
IV
-PerlIOCrlf_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab)
+PerlIOCrlf_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg)
{
IV code;
PerlIOBase(f)->flags |= PERLIO_F_CRLF;
- code = PerlIOBuf_pushed(aTHX_ f, mode, arg, tab);
+ code = PerlIOBuf_pushed(aTHX_ f, mode, arg);
#if 0
PerlIO_debug("PerlIOCrlf_pushed f=%p %s %s fl=%08" UVxf "\n",
f, PerlIOBase(f)->tab->name, (mode) ? mode : "(Null)",
}
PerlIO_funcs PerlIO_crlf = {
- sizeof(PerlIO_funcs),
"crlf",
sizeof(PerlIOCrlf),
PERLIO_K_BUFFERED | PERLIO_K_CANCRLF | PERLIO_K_RAW,
PerlIO_funcs PerlIO_mmap = {
- sizeof(PerlIO_funcs),
"mmap",
sizeof(PerlIOMmap),
PERLIO_K_BUFFERED|PERLIO_K_RAW,
};
struct _PerlIO_funcs {
- Size_t fsize;
char *name;
Size_t size;
U32 kind;
- IV (*Pushed) (pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab);
+ IV (*Pushed) (pTHX_ PerlIO *f, const char *mode, SV *arg);
IV (*Popped) (pTHX_ PerlIO *f);
PerlIO *(*Open) (pTHX_ PerlIO_funcs *tab,
PerlIO_list_t *layers, IV n,
extern IV PerlIOBase_fileno(pTHX_ PerlIO *f);
extern PerlIO *PerlIOBase_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param, int flags);
-extern IV PerlIOBase_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab);
+extern IV PerlIOBase_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg);
extern IV PerlIOBase_popped(pTHX_ PerlIO *f);
extern IV PerlIOBase_binmode(pTHX_ PerlIO *f);
extern SSize_t PerlIOBase_read(pTHX_ PerlIO *f, void *vbuf, Size_t count);
PerlIO_list_t *layers, IV n,
const char *mode, int fd, int imode,
int perm, PerlIO *old, int narg, SV **args);
-extern IV PerlIOBuf_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab);
+extern IV PerlIOBuf_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg);
extern IV PerlIOBuf_popped(pTHX_ PerlIO *f);
extern PerlIO *PerlIOBuf_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param, int flags);
extern SSize_t PerlIOBuf_read(pTHX_ PerlIO *f, void *vbuf, Size_t count);
struct _PerlIO_funcs
{
- Size_t fsize;
char * name;
Size_t size;
IV kind;
- IV (*Pushed)(pTHX_ PerlIO *f,const char *mode,SV *arg, PerlIO_funcs *tab);
+ IV (*Pushed)(pTHX_ PerlIO *f,const char *mode,SV *arg);
IV (*Popped)(pTHX_ PerlIO *f);
PerlIO * (*Open)(pTHX_ PerlIO_funcs *tab,
AV *layers, IV n,
void (*Set_ptrcnt)(pTHX_ PerlIO *f,STDCHAR *ptr,SSize_t cnt);
};
-The first few members of the struct give a function table size for
-compatibility check "name" for the layer, the size to C<malloc> for the per-instance data,
-and some flags which are attributes of the class as whole (such as whether it is a buffering
+The first few members of the struct give a "name" for the layer, the
+size to C<malloc> for the per-instance data, and some flags which are
+attributes of the class as whole (such as whether it is a buffering
layer), then follow the functions which fall into four basic groups:
=over 4
=over 4
-=item size
-
- Size_t fsize;
-
-Size of the function table. This is compared against the value PerlIO code "knows"
-as a compatibility check. Future versions I<may> be able to tolerate layers
-compiled against an old version of the headers.
-
=item name
char * name;
sizeof(PerlIOAPR)
-If this field is zero then C<PerlIO_pushed> does not malloc anything and assumes
-layer's Pushed function will do any required layer stack manipulation - used
-to avoid malloc/free overhead for dummy layers.
-If the field is non-zero it must be at least the size of C<PerlIOl>,
-C<PerlIO_pushed> will allocate memory for the layer's data structures
-and link new layer onto the stream's stack. (If the layer's Pushed
-method returns an error indication the layer is popped again.)
-
=item kind
IV kind;
C<PerlIOBase_fileno()> (which just asks next layer down) will suffice
for this.
-Returns -1 on error, which is considered to include the case where the layer cannot
-provide such a file descriptor.
+Returns -1 if the layer cannot provide such a file descriptor, or in
+the case of the error.
+
+XXX: two possible results end up in -1, one is an error the other is
+not.
=item Dup
PerlIO * (*Dup)(pTHX_ PerlIO *f, PerlIO *o,
CLONE_PARAMS *param, int flags);
-XXX: Needs more docs.
-
-Used as part of the "clone" process when a thread is spawned (in which case
-param will be non-NULL) and when a stream is being duplicated via '&' in the C<open>.
+XXX: not documented
Similar to C<Open>, returns PerlIO* on success, C<NULL> on failure.
projects / p5sagit/p5-mst-13.2.git / commitdiff