Integrate perlio:

[ 13808]
Add pTHX to all vtable functions for future-proofing and
consistency of PerlIO layers.

[ 13797]
Remove the sometimes-lvalue cast

[ 13796]
alarm.t with -Uuseperlio fix
- SA_RESTART should only be function of PERL_OLD_SIGNALS
not USE_PERLIO

[ 13795]
Fix READONLY hashes:
1. Discovered need for disabled scope.c part of Jeff's patch.
2. Corrected hv_delete* - entry was being de-linked from
chain (patch program not smart enough?)

p4raw-link: @13808 on //depot/perlio: f62ce20a4126b1e303e2d4d0a5c1e049ef2cb0c2
p4raw-link: @13797 on //depot/perlio: 205c8ad3acbda0df8cac03a0c7e619f1855229a8
p4raw-link: @13796 on //depot/perlio: 0dd95eb270db2cdad9a8acda96ac3a3aab8775c2
p4raw-link: @13795 on //depot/perlio: a26e96dff1c9d91b0bf389e6149016d8a3f26e49

p4raw-id: //depot/perl@13809

3 files changed, 57 insertions, 85 deletions

diff --git a/ext/Encode/Encode.xs b/ext/Encode/Encode.xs
index 7546573d10..ba7935e176 100644
--- a/ext/Encode/Encode.xs
+++ b/ext/Encode/Encode.xs
@@ -75,13 +75,12 @@ PerlIOEncode_getarg(pTHX_ PerlIO *f, CLONE_PARAMS *param, int flags)
 }
 
 IV
-PerlIOEncode_pushed(PerlIO *f, const char *mode, SV *arg)
+PerlIOEncode_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg)
 {
  PerlIOEncode *e = PerlIOSelf(f,PerlIOEncode);
- dTHX;
  dSP;
  IV code;
- code = PerlIOBuf_pushed(f,mode,Nullsv);
+ code = PerlIOBuf_pushed(aTHX_ f,mode,Nullsv);
  ENTER;
  SAVETMPS;
  PUSHMARK(sp);
@@ -114,10 +113,9 @@ PerlIOEncode_pushed(PerlIO *f, const char *mode, SV *arg)
 }
 
 IV
-PerlIOEncode_popped(PerlIO *f)
+PerlIOEncode_popped(pTHX_ PerlIO *f)
 {
  PerlIOEncode *e = PerlIOSelf(f,PerlIOEncode);
- dTHX;
  if (e->enc)
   {
    SvREFCNT_dec(e->enc);
@@ -132,10 +130,9 @@ PerlIOEncode_popped(PerlIO *f)
 }
 
 STDCHAR *
-PerlIOEncode_get_base(PerlIO *f)
+PerlIOEncode_get_base(pTHX_ PerlIO *f)
 {
  PerlIOEncode *e = PerlIOSelf(f,PerlIOEncode);
- dTHX;
  if (!e->base.bufsiz)
   e->base.bufsiz = 1024;
  if (!e->bufsv)
@@ -172,13 +169,12 @@ PerlIOEncode_get_base(PerlIO *f)
 }
 
 IV
-PerlIOEncode_fill(PerlIO *f)
+PerlIOEncode_fill(pTHX_ PerlIO *f)
 {
  PerlIOEncode *e = PerlIOSelf(f,PerlIOEncode);
- dTHX;
  dSP;
  IV code;
- code = PerlIOBuf_fill(f);
+ code = PerlIOBuf_fill(aTHX_ f);
  if (code == 0)
   {
    SV *uni;
@@ -221,7 +217,7 @@ PerlIOEncode_fill(PerlIO *f)
 }
 
 IV
-PerlIOEncode_flush(PerlIO *f)
+PerlIOEncode_flush(pTHX_ PerlIO *f)
 {
  PerlIOEncode *e = PerlIOSelf(f,PerlIOEncode);
  IV code = 0;
@@ -229,7 +225,6 @@ PerlIOEncode_flush(PerlIO *f)
      &&(e->base.ptr > e->base.buf)
     )
   {
-   dTHX;
    dSP;
    SV *str;
    char *s;
@@ -270,18 +265,17 @@ PerlIOEncode_flush(PerlIO *f)
    e->base.end = e->base.ptr + left;
    FREETMPS;
    LEAVE;
-   if (PerlIOBuf_flush(f) != 0)
+   if (PerlIOBuf_flush(aTHX_ f) != 0)
     code = -1;
   }
  return code;
 }
 
 IV
-PerlIOEncode_close(PerlIO *f)
+PerlIOEncode_close(pTHX_ PerlIO *f)
 {
  PerlIOEncode *e = PerlIOSelf(f,PerlIOEncode);
- IV code = PerlIOBase_close(f);
- dTHX;
+ IV code = PerlIOBase_close(aTHX_ f);
  if (e->bufsv)
   {
    SvREFCNT_dec(e->bufsv);
@@ -295,9 +289,8 @@ PerlIOEncode_close(PerlIO *f)
 }
 
 Off_t
-PerlIOEncode_tell(PerlIO *f)
+PerlIOEncode_tell(pTHX_ PerlIO *f)
 {
- dTHX;
  PerlIOBuf *b = PerlIOSelf(f,PerlIOBuf);
  /* Unfortunately the only way to get a postion is to back-translate,
     the UTF8-bytes we have buf..ptr and adjust accordingly.
diff --git a/ext/PerlIO/Scalar/Scalar.xs b/ext/PerlIO/Scalar/Scalar.xs
index 8784a48804..86c54fa62c 100644
--- a/ext/PerlIO/Scalar/Scalar.xs
+++ b/ext/PerlIO/Scalar/Scalar.xs
@@ -14,9 +14,8 @@ typedef struct
 } PerlIOScalar;
 
 IV
-PerlIOScalar_pushed(PerlIO *f, const char *mode, SV *arg)
+PerlIOScalar_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg)
 {
- dTHX;
  IV code;
  PerlIOScalar *s = PerlIOSelf(f,PerlIOScalar);
  /* If called (normally) via open() then arg is ref to scalar we are
@@ -39,7 +38,7 @@ PerlIOScalar_pushed(PerlIO *f, const char *mode, SV *arg)
    s->var = newSVpvn("",0);
   }
  sv_upgrade(s->var,SVt_PV);
- code = PerlIOBase_pushed(f,mode,Nullsv);
+ code = PerlIOBase_pushed(aTHX_ f,mode,Nullsv);
  if ((PerlIOBase(f)->flags) & PERLIO_F_TRUNCATE)
    SvCUR(s->var) = 0;
  if ((PerlIOBase(f)->flags) & PERLIO_F_APPEND)
@@ -50,12 +49,11 @@ PerlIOScalar_pushed(PerlIO *f, const char *mode, SV *arg)
 }
 
 IV
-PerlIOScalar_popped(PerlIO *f)
+PerlIOScalar_popped(pTHX_ PerlIO *f)
 {
  PerlIOScalar *s = PerlIOSelf(f,PerlIOScalar);
  if (s->var)
   {
-   dTHX;
    SvREFCNT_dec(s->var);
    s->var = Nullsv;
   }
@@ -63,21 +61,21 @@ PerlIOScalar_popped(PerlIO *f)
 }
 
 IV
-PerlIOScalar_close(PerlIO *f)
+PerlIOScalar_close(pTHX_ PerlIO *f)
 {
- IV code = PerlIOBase_close(f);
+ IV code = PerlIOBase_close(aTHX_ f);
  PerlIOBase(f)->flags &= ~(PERLIO_F_RDBUF|PERLIO_F_WRBUF);
  return code;
 }
 
 IV
-PerlIOScalar_fileno(PerlIO *f)
+PerlIOScalar_fileno(pTHX_ PerlIO *f)
 {
  return -1;
 }
 
 IV
-PerlIOScalar_seek(PerlIO *f, Off_t offset, int whence)
+PerlIOScalar_seek(pTHX_ PerlIO *f, Off_t offset, int whence)
 {
  PerlIOScalar *s = PerlIOSelf(f,PerlIOScalar);
  switch(whence)
@@ -94,23 +92,21 @@ PerlIOScalar_seek(PerlIO *f, Off_t offset, int whence)
   }
  if (s->posn > SvCUR(s->var))
   {
-   dTHX;
    (void) SvGROW(s->var,s->posn);
   }
  return 0;
 }
 
 Off_t
-PerlIOScalar_tell(PerlIO *f)
+PerlIOScalar_tell(pTHX_ PerlIO *f)
 {
  PerlIOScalar *s = PerlIOSelf(f,PerlIOScalar);
  return s->posn;
 }
 
 SSize_t
-PerlIOScalar_unread(PerlIO *f, const void *vbuf, Size_t count)
+PerlIOScalar_unread(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
 {
- dTHX;
  PerlIOScalar *s = PerlIOSelf(f,PerlIOScalar);
  char *dst = SvGROW(s->var,s->posn+count);
  Move(vbuf,dst+s->posn,count,char);
@@ -121,11 +117,10 @@ PerlIOScalar_unread(PerlIO *f, const void *vbuf, Size_t count)
 }
 
 SSize_t
-PerlIOScalar_write(PerlIO *f, const void *vbuf, Size_t count)
+PerlIOScalar_write(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
 {
  if (PerlIOBase(f)->flags & PERLIO_F_CANWRITE)
   {
-   dTHX;
    Off_t offset;
    PerlIOScalar *s = PerlIOSelf(f,PerlIOScalar);
    SV *sv = s->var;
@@ -156,42 +151,41 @@ PerlIOScalar_write(PerlIO *f, const void *vbuf, Size_t count)
 }
 
 IV
-PerlIOScalar_fill(PerlIO *f)
+PerlIOScalar_fill(pTHX_ PerlIO *f)
 {
  return -1;
 }
 
 IV
-PerlIOScalar_flush(PerlIO *f)
+PerlIOScalar_flush(pTHX_ PerlIO *f)
 {
  return 0;
 }
 
 STDCHAR *
-PerlIOScalar_get_base(PerlIO *f)
+PerlIOScalar_get_base(pTHX_ PerlIO *f)
 {
  PerlIOScalar *s = PerlIOSelf(f,PerlIOScalar);
  if (PerlIOBase(f)->flags & PERLIO_F_CANREAD)
   {
-   dTHX;
    return (STDCHAR *)SvPV_nolen(s->var);
   }
  return (STDCHAR *) Nullch;
 }
 
 STDCHAR *
-PerlIOScalar_get_ptr(PerlIO *f)
+PerlIOScalar_get_ptr(pTHX_ PerlIO *f)
 {
  if (PerlIOBase(f)->flags & PERLIO_F_CANREAD)
   {
    PerlIOScalar *s = PerlIOSelf(f,PerlIOScalar);
-   return PerlIOScalar_get_base(f)+s->posn;
+   return PerlIOScalar_get_base(aTHX_ f)+s->posn;
   }
  return (STDCHAR *) Nullch;
 }
 
 SSize_t
-PerlIOScalar_get_cnt(PerlIO *f)
+PerlIOScalar_get_cnt(pTHX_ PerlIO *f)
 {
  if (PerlIOBase(f)->flags & PERLIO_F_CANREAD)
   {
@@ -205,7 +199,7 @@ PerlIOScalar_get_cnt(PerlIO *f)
 }
 
 Size_t
-PerlIOScalar_bufsiz(PerlIO *f)
+PerlIOScalar_bufsiz(pTHX_ PerlIO *f)
 {
  if (PerlIOBase(f)->flags & PERLIO_F_CANREAD)
   {
@@ -216,7 +210,7 @@ PerlIOScalar_bufsiz(PerlIO *f)
 }
 
 void
-PerlIOScalar_set_ptrcnt(PerlIO *f, STDCHAR *ptr, SSize_t cnt)
+PerlIOScalar_set_ptrcnt(pTHX_ PerlIO *f, STDCHAR *ptr, SSize_t cnt)
 {
  PerlIOScalar *s = PerlIOSelf(f,PerlIOScalar);
  s->posn = SvCUR(s->var)-cnt;
diff --git a/ext/PerlIO/Via/Via.xs b/ext/PerlIO/Via/Via.xs
index 783eb9d279..d1d4e644f0 100644
--- a/ext/PerlIO/Via/Via.xs
+++ b/ext/PerlIO/Via/Via.xs
@@ -107,12 +107,11 @@ PerlIOVia_method(pTHX_ PerlIO *f,char *method,CV **save,int flags,...)
 }
 
 IV
-PerlIOVia_pushed(PerlIO *f, const char *mode, SV *arg)
+PerlIOVia_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg)
 {
- IV code = PerlIOBase_pushed(f,mode,Nullsv);
+ IV code = PerlIOBase_pushed(aTHX_ f,mode,Nullsv);
  if (code == 0)
   {
-   dTHX;
    PerlIOVia *s = PerlIOSelf(f,PerlIOVia);
    if (!arg)
     {
@@ -211,9 +210,8 @@ PerlIOVia_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers, IV n, const char
 }
 
 IV
-PerlIOVia_popped(PerlIO *f)
+PerlIOVia_popped(pTHX_ PerlIO *f)
 {
- dTHX;
  PerlIOVia *s = PerlIOSelf(f,PerlIOVia);
  PerlIOVia_method(aTHX_ f,MYMethod(POPPED),G_VOID,Nullsv);
  if (s->var)
@@ -242,11 +240,10 @@ PerlIOVia_popped(PerlIO *f)
 }
 
 IV
-PerlIOVia_close(PerlIO *f)
+PerlIOVia_close(pTHX_ PerlIO *f)
 {
- dTHX;
  PerlIOVia *s = PerlIOSelf(f,PerlIOVia);
- IV code = PerlIOBase_close(f);
+ IV code = PerlIOBase_close(aTHX_ f);
  SV *result = PerlIOVia_method(aTHX_ f,MYMethod(CLOSE),G_SCALAR,Nullsv);
  if (result && SvIV(result) != 0)
   code = SvIV(result);
@@ -255,18 +252,16 @@ PerlIOVia_close(PerlIO *f)
 }
 
 IV
-PerlIOVia_fileno(PerlIO *f)
+PerlIOVia_fileno(pTHX_ PerlIO *f)
 {
- dTHX;
  PerlIOVia *s = PerlIOSelf(f,PerlIOVia);
  SV *result = PerlIOVia_method(aTHX_ f,MYMethod(FILENO),G_SCALAR,Nullsv);
  return (result) ? SvIV(result) : PerlIO_fileno(PerlIONext(f));
 }
 
 IV
-PerlIOVia_seek(PerlIO *f, Off_t offset, int whence)
+PerlIOVia_seek(pTHX_ PerlIO *f, Off_t offset, int whence)
 {
- dTHX;
  PerlIOVia *s = PerlIOSelf(f,PerlIOVia);
  SV *offsv  = sv_2mortal(newSViv(offset));
  SV *whsv   = sv_2mortal(newSViv(whence));
@@ -275,18 +270,16 @@ PerlIOVia_seek(PerlIO *f, Off_t offset, int whence)
 }
 
 Off_t
-PerlIOVia_tell(PerlIO *f)
+PerlIOVia_tell(pTHX_ PerlIO *f)
 {
- dTHX;
  PerlIOVia *s = PerlIOSelf(f,PerlIOVia);
  SV *result = PerlIOVia_method(aTHX_ f,MYMethod(TELL),G_SCALAR,Nullsv);
  return (result) ? (Off_t) SvIV(result) : (Off_t) -1;
 }
 
 SSize_t
-PerlIOVia_unread(PerlIO *f, const void *vbuf, Size_t count)
+PerlIOVia_unread(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
 {
- dTHX;
  PerlIOVia *s = PerlIOSelf(f,PerlIOVia);
  SV *buf    = sv_2mortal(newSVpvn((char *)vbuf,count));
  SV *result = PerlIOVia_method(aTHX_ f,MYMethod(UNREAD),G_SCALAR,buf,Nullsv);
@@ -294,23 +287,22 @@ PerlIOVia_unread(PerlIO *f, const void *vbuf, Size_t count)
   return (SSize_t) SvIV(result);
  else
   {
-   return PerlIOBase_unread(f,vbuf,count);
+   return PerlIOBase_unread(aTHX_ f,vbuf,count);
   }
 }
 
 SSize_t
-PerlIOVia_read(PerlIO *f, void *vbuf, Size_t count)
+PerlIOVia_read(pTHX_ PerlIO *f, void *vbuf, Size_t count)
 {
  SSize_t rd = 0;
  if (PerlIOBase(f)->flags & PERLIO_F_CANREAD)
   {
    if (PerlIOBase(f)->flags & PERLIO_F_FASTGETS)
     {
-     rd = PerlIOBase_read(f,vbuf,count);
+     rd = PerlIOBase_read(aTHX_ f,vbuf,count);
     }
    else
     {
-     dTHX;
      PerlIOVia *s = PerlIOSelf(f,PerlIOVia);
      SV *buf    = sv_2mortal(newSV(count));
      SV *n      = sv_2mortal(newSViv(count));
@@ -327,11 +319,10 @@ PerlIOVia_read(PerlIO *f, void *vbuf, Size_t count)
 }
 
 SSize_t
-PerlIOVia_write(PerlIO *f, const void *vbuf, Size_t count)
+PerlIOVia_write(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
 {
  if (PerlIOBase(f)->flags & PERLIO_F_CANWRITE)
   {
-   dTHX;
    PerlIOVia *s = PerlIOSelf(f,PerlIOVia);
    SV *buf    = newSVpvn((char *)vbuf,count);
    SV *result = PerlIOVia_method(aTHX_ f,MYMethod(WRITE),G_SCALAR,buf,Nullsv);
@@ -344,11 +335,10 @@ PerlIOVia_write(PerlIO *f, const void *vbuf, Size_t count)
 }
 
 IV
-PerlIOVia_fill(PerlIO *f)
+PerlIOVia_fill(pTHX_ PerlIO *f)
 {
  if (PerlIOBase(f)->flags & PERLIO_F_CANREAD)
   {
-   dTHX;
    PerlIOVia *s = PerlIOSelf(f,PerlIOVia);
    SV *result = PerlIOVia_method(aTHX_ f,MYMethod(FILL),G_SCALAR,Nullsv);
    if (s->var)
@@ -371,9 +361,8 @@ PerlIOVia_fill(PerlIO *f)
 }
 
 IV
-PerlIOVia_flush(PerlIO *f)
+PerlIOVia_flush(pTHX_ PerlIO *f)
 {
- dTHX;
  PerlIOVia *s = PerlIOSelf(f,PerlIOVia);
  SV *result = PerlIOVia_method(aTHX_ f,MYMethod(FLUSH),G_SCALAR,Nullsv);
  if (s->var && s->cnt > 0)
@@ -385,7 +374,7 @@ PerlIOVia_flush(PerlIO *f)
 }
 
 STDCHAR *
-PerlIOVia_get_base(PerlIO *f)
+PerlIOVia_get_base(pTHX_ PerlIO *f)
 {
  if (PerlIOBase(f)->flags & PERLIO_F_CANREAD)
   {
@@ -399,7 +388,7 @@ PerlIOVia_get_base(PerlIO *f)
 }
 
 STDCHAR *
-PerlIOVia_get_ptr(PerlIO *f)
+PerlIOVia_get_ptr(pTHX_ PerlIO *f)
 {
  if (PerlIOBase(f)->flags & PERLIO_F_CANREAD)
   {
@@ -414,7 +403,7 @@ PerlIOVia_get_ptr(PerlIO *f)
 }
 
 SSize_t
-PerlIOVia_get_cnt(PerlIO *f)
+PerlIOVia_get_cnt(pTHX_ PerlIO *f)
 {
  if (PerlIOBase(f)->flags & PERLIO_F_CANREAD)
   {
@@ -428,7 +417,7 @@ PerlIOVia_get_cnt(PerlIO *f)
 }
 
 Size_t
-PerlIOVia_bufsiz(PerlIO *f)
+PerlIOVia_bufsiz(pTHX_ PerlIO *f)
 {
  if (PerlIOBase(f)->flags & PERLIO_F_CANREAD)
   {
@@ -440,46 +429,42 @@ PerlIOVia_bufsiz(PerlIO *f)
 }
 
 void
-PerlIOVia_set_ptrcnt(PerlIO *f, STDCHAR *ptr, SSize_t cnt)
+PerlIOVia_set_ptrcnt(pTHX_ PerlIO *f, STDCHAR *ptr, SSize_t cnt)
 {
  PerlIOVia *s = PerlIOSelf(f,PerlIOVia);
  s->cnt = cnt;
 }
 
 void
-PerlIOVia_setlinebuf(PerlIO *f)
+PerlIOVia_setlinebuf(pTHX_ PerlIO *f)
 {
- dTHX;
  PerlIOVia *s = PerlIOSelf(f,PerlIOVia);
  PerlIOVia_method(aTHX_ f,MYMethod(SETLINEBUF),G_VOID,Nullsv);
- PerlIOBase_setlinebuf(f);
+ PerlIOBase_setlinebuf(aTHX_ f);
 }
 
 void
-PerlIOVia_clearerr(PerlIO *f)
+PerlIOVia_clearerr(pTHX_ PerlIO *f)
 {
- dTHX;
  PerlIOVia *s = PerlIOSelf(f,PerlIOVia);
  PerlIOVia_method(aTHX_ f,MYMethod(CLEARERR),G_VOID,Nullsv);
- PerlIOBase_clearerr(f);
+ PerlIOBase_clearerr(aTHX_ f);
 }
 
 IV
-PerlIOVia_error(PerlIO *f)
+PerlIOVia_error(pTHX_ PerlIO *f)
 {
- dTHX;
  PerlIOVia *s = PerlIOSelf(f,PerlIOVia);
  SV *result = PerlIOVia_method(aTHX_ f,"ERROR",&s->mERROR,G_SCALAR,Nullsv);
- return (result) ? SvIV(result) : PerlIOBase_error(f);
+ return (result) ? SvIV(result) : PerlIOBase_error(aTHX_ f);
 }
 
 IV
-PerlIOVia_eof(PerlIO *f)
+PerlIOVia_eof(pTHX_ PerlIO *f)
 {
- dTHX;
  PerlIOVia *s = PerlIOSelf(f,PerlIOVia);
  SV *result = PerlIOVia_method(aTHX_ f,"EOF",&s->mEOF,G_SCALAR,Nullsv);
- return (result) ? SvIV(result) : PerlIOBase_eof(f);
+ return (result) ? SvIV(result) : PerlIOBase_eof(aTHX_ f);
 }
 
 SV *