#define any_dup(a,b) Perl_any_dup(aTHX_ a,b)
#define he_dup(a,b,c) Perl_he_dup(aTHX_ a,b,c)
#define re_dup(a,b) Perl_re_dup(aTHX_ a,b)
-#define fp_dup(a,b) Perl_fp_dup(aTHX_ a,b)
+#define fp_dup(a,b,c) Perl_fp_dup(aTHX_ a,b,c)
#define dirp_dup(a) Perl_dirp_dup(aTHX_ a)
#define gp_dup(a,b) Perl_gp_dup(aTHX_ a,b)
#define mg_dup(a,b) Perl_mg_dup(aTHX_ a,b)
p |OP * |my_attrs |OP *o|OP *attrs
p |void |boot_core_xsutils
#if defined(USE_ITHREADS)
-Ap |PERL_CONTEXT*|cx_dup |PERL_CONTEXT* cx|I32 ix|I32 max|clone_params* param
-Ap |PERL_SI*|si_dup |PERL_SI* si|clone_params* param
-Ap |ANY* |ss_dup |PerlInterpreter* proto_perl|clone_params* param
+Ap |PERL_CONTEXT*|cx_dup |PERL_CONTEXT* cx|I32 ix|I32 max|CLONE_PARAMS* param
+Ap |PERL_SI*|si_dup |PERL_SI* si|CLONE_PARAMS* param
+Ap |ANY* |ss_dup |PerlInterpreter* proto_perl|CLONE_PARAMS* param
Ap |void* |any_dup |void* v|PerlInterpreter* proto_perl
-Ap |HE* |he_dup |HE* e|bool shared|clone_params* param
-Ap |REGEXP*|re_dup |REGEXP* r|clone_params* param
-Ap |PerlIO*|fp_dup |PerlIO* fp|char type
+Ap |HE* |he_dup |HE* e|bool shared|CLONE_PARAMS* param
+Ap |REGEXP*|re_dup |REGEXP* r|CLONE_PARAMS* param
+Ap |PerlIO*|fp_dup |PerlIO* fp|char type|CLONE_PARAMS* param
Ap |DIR* |dirp_dup |DIR* dp
-Ap |GP* |gp_dup |GP* gp|clone_params* param
-Ap |MAGIC* |mg_dup |MAGIC* mg|clone_params* param
-Ap |SV* |sv_dup |SV* sstr|clone_params* param
+Ap |GP* |gp_dup |GP* gp|CLONE_PARAMS* param
+Ap |MAGIC* |mg_dup |MAGIC* mg|CLONE_PARAMS* param
+Ap |SV* |sv_dup |SV* sstr|CLONE_PARAMS* param
#if defined(HAVE_INTERP_INTERN)
Ap |void |sys_intern_dup |struct interp_intern* src \
|struct interp_intern* dst
return b->posn;
}
+PerlIO *
+PerlIOEncode_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *params)
+{
+ /* FIXME - Almost certainly needs more work */
+ return PerlIOBase_dup(aTHX_ f, o, params);
+}
+
PerlIO_funcs PerlIO_encode = {
"encoding",
sizeof(PerlIOEncode),
PerlIOBuf_open,
PerlIOEncode_getarg,
PerlIOBase_fileno,
+ PerlIOEncode_dup,
PerlIOBuf_read,
PerlIOBuf_unread,
PerlIOBuf_write,
return NULL;
}
+PerlIO *
+PerlIOScalar_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param)
+{
+ /* FIXME - Needs more work */
+ return PerlIOBase_dup(aTHX_ f, o, param);
+}
PerlIO_funcs PerlIO_scalar = {
"Scalar",
PerlIOScalar_open,
NULL,
PerlIOScalar_fileno,
+ PerlIOScalar_dup,
PerlIOBase_read,
PerlIOScalar_unread,
PerlIOScalar_write,
{
return *save = (CV *) -1;
}
-
}
SV *
return (result) ? SvIV(result) : PerlIOBase_eof(f);
}
+PerlIO *
+PerlIOVia_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param)
+{
+ /* FIXME - Needs more work */
+ return PerlIOBase_dup(aTHX_ f, o, param);
+}
+
PerlIO_funcs PerlIO_object = {
"Via",
sizeof(PerlIOVia),
NULL, /* PerlIOVia_open, */
PerlIOVia_getarg,
PerlIOVia_fileno,
+ PerlIOVia_dup,
PerlIOVia_read,
PerlIOVia_unread,
PerlIOVia_write,
typedef union any ANY;
typedef struct ptr_tbl_ent PTR_TBL_ENT_t;
typedef struct ptr_tbl PTR_TBL_t;
+typedef struct clone_params CLONE_PARAMS;
+
#include "handy.h"
#undef PerlIO_fdupopen
PerlIO *
-PerlIO_fdupopen(pTHX_ PerlIO *f)
+PerlIO_fdupopen(pTHX_ PerlIO *f, CLONE_PARAMS *param)
{
if (f && *f) {
- char buf[8];
- int fd = PerlLIO_dup(PerlIO_fileno(f));
- PerlIO *new = PerlIO_fdopen(fd, PerlIO_modestr(f, buf));
- if (new) {
- Off_t posn = PerlIO_tell(f);
- PerlIO_seek(new, posn, SEEK_SET);
- }
+ PerlIO_funcs *tab = PerlIOBase(f)->tab;
+ PerlIO *new = (*tab->Dup)(aTHX_ PerlIO_allocate(aTHX),f,param);
return new;
}
else {
}
}
-PerlIO *
-PerlIOBase_dup(pTHX_ PerlIO *f, PerlIO *o, clone_params *param)
+SV *
+PerlIO_sv_dup(pTHX_ SV *arg, CLONE_PARAMS *param)
{
- PerlIO_funcs *self = PerlIOBase(o)->tab;
- SV *arg = Nullsv;
- char buf[8];
- if (self->Getarg) {
- arg = (*self->Getarg)(o);
+ if (!arg)
+ return Nullsv;
#ifdef sv_dup
- if (arg) {
- arg = sv_dup(arg, param);
- }
+ if (param) {
+ return sv_dup(arg, param);
+ }
+ else {
+ return newSVsv(arg);
+ }
+#else
+ return newSVsv(arg);
#endif
+}
+
+PerlIO *
+PerlIOBase_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param)
+{
+ PerlIO *nexto = PerlIONext(o);
+ if (*nexto) {
+ PerlIO_funcs *tab = PerlIOBase(nexto)->tab;
+ f = (*tab->Dup)(aTHX_ f, nexto, param);
}
- if (!f) {
- f = PerlIO_allocate(aTHX);
+ if (f) {
+ PerlIO_funcs *self = PerlIOBase(o)->tab;
+ SV *arg = Nullsv;
+ char buf[8];
+ if (self->Getarg) {
+ arg = (*self->Getarg)(o);
+ if (arg) {
+ arg = PerlIO_sv_dup(aTHX_ arg, param);
+ }
+ }
+ f = PerlIO_push(aTHX_ f, self, PerlIO_modestr(o,buf), arg);
+ if (!f && arg) {
+ SvREFCNT_dec(arg);
+ }
}
- f = PerlIO_push(aTHX_ f, self, PerlIO_modestr(o,buf), arg);
return f;
}
PerlIO *
-PerlIOUnix_dup(pTHX_ PerlIO *f, PerlIO *o, clone_params *param)
+PerlIOUnix_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param)
{
PerlIOUnix *os = PerlIOSelf(o, PerlIOUnix);
int fd = PerlLIO_dup(os->fd);
#endif
PerlIO *
-PerlIOStdio_dup(pTHX_ PerlIO *f, PerlIO *o, clone_params *param)
+PerlIOStdio_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param)
{
return NULL;
}
}
PerlIO *
-PerlIOBuf_dup(pTHX_ PerlIO *f, PerlIO *o, clone_params *param)
+PerlIOBuf_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param)
{
return NULL;
}
}
PerlIO *
-PerlIOMmap_dup(pTHX_ PerlIO *f, PerlIO *o, clone_params *param)
+PerlIOMmap_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param)
{
return NULL;
}
extern int PerlIO_setpos(PerlIO *, SV *);
#endif
#ifndef PerlIO_fdupopen
-extern PerlIO *PerlIO_fdupopen(pTHX_ PerlIO *);
+extern PerlIO *PerlIO_fdupopen(pTHX_ PerlIO *, CLONE_PARAMS *);
#endif
#if !defined(PerlIO_modestr) && !defined(PERLIO_IS_STDIO)
extern char *PerlIO_modestr(PerlIO *, char *buf);
PerlIO *old, int narg, SV **args);
SV *(*Getarg) (PerlIO *f);
IV (*Fileno) (PerlIO *f);
- PerlIO *(*Dup) (pTHX_ PerlIO *f, PerlIO *o, clone_params *param);
+ PerlIO *(*Dup) (pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param);
/* Unix-like functions - cf sfio line disciplines */
SSize_t(*Read) (PerlIO *f, void *vbuf, Size_t count);
SSize_t(*Unread) (PerlIO *f, const void *vbuf, Size_t count);
/* Generic, or stub layer functions */
extern IV PerlIOBase_fileno(PerlIO *f);
-extern PerlIO *PerlIOBase_dup(pTHX_ PerlIO *f, PerlIO *o, clone_params *param);
+extern PerlIO *PerlIOBase_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param);
extern IV PerlIOBase_pushed(PerlIO *f, const char *mode, SV *arg);
extern IV PerlIOBase_popped(PerlIO *f);
extern SSize_t PerlIOBase_read(PerlIO *f, void *vbuf, Size_t count);
IV oneword; /* Emergency buffer */
} PerlIOBuf;
+extern SV *PerlIO_sv_dup(pTHX_ SV *arg, CLONE_PARAMS *param);
extern PerlIO *PerlIOBuf_open(pTHX_ PerlIO_funcs *self,
PerlIO_list_t *layers, IV n,
const char *mode, int fd, int imode,
Expands the character buffer in the SV so that it has room for the
indicated number of bytes (remember to reserve space for an extra trailing
-NUL character). Calls C<sv_grow> to perform the expansion if necessary.
+NUL character). Calls C<sv_grow> to perform the expansion if necessary.
Returns a pointer to the character buffer.
char * SvGROW(SV* sv, STRLEN len)
=for hackers
Found in file sv.h
-=item SvNVX
+=item SvNVx
-Returns the raw value in the SV's NV slot, without checks or conversions.
-Only use when you are sure SvNOK is true. See also C<SvNV()>.
+Coerces the given SV to a double and returns it. Guarantees to evaluate
+sv only once. Use the more efficent C<SvNV> otherwise.
- NV SvNVX(SV* sv)
+ NV SvNVx(SV* sv)
=for hackers
Found in file sv.h
-=item SvNVx
+=item SvNVX
-Coerces the given SV to a double and returns it. Guarantees to evaluate
-sv only once. Use the more efficent C<SvNV> otherwise.
+Returns the raw value in the SV's NV slot, without checks or conversions.
+Only use when you are sure SvNOK is true. See also C<SvNV()>.
- NV SvNVx(SV* sv)
+ NV SvNVX(SV* sv)
=for hackers
Found in file sv.h
=for hackers
Found in file sv.h
-=item SvPVx
+=item SvPVX
-A version of C<SvPV> which guarantees to evaluate sv only once.
+Returns a pointer to the physical string in the SV. The SV must contain a
+string.
- char* SvPVx(SV* sv, STRLEN len)
+ char* SvPVX(SV* sv)
=for hackers
Found in file sv.h
-=item SvPVX
+=item SvPVx
-Returns a pointer to the physical string in the SV. The SV must contain a
-string.
+A version of C<SvPV> which guarantees to evaluate sv only once.
- char* SvPVX(SV* sv)
+ char* SvPVx(SV* sv, STRLEN len)
=for hackers
Found in file sv.h
=for hackers
Found in file sv.h
-=item SvTYPE
-
-Returns the type of the SV. See C<svtype>.
+=item svtype
- svtype SvTYPE(SV* sv)
+An enum of flags for Perl types. These are found in the file B<sv.h>
+in the C<svtype> enum. Test these flags with the C<SvTYPE> macro.
=for hackers
Found in file sv.h
-=item svtype
+=item SvTYPE
-An enum of flags for Perl types. These are found in the file B<sv.h>
-in the C<svtype> enum. Test these flags with the C<SvTYPE> macro.
+Returns the type of the SV. See C<svtype>.
+
+ svtype SvTYPE(SV* sv)
=for hackers
Found in file sv.h
=item sv_2bool
This function is only called on magical items, and is only used by
-sv_true() or its macro equivalent.
+sv_true() or its macro equivalent.
bool sv_2bool(SV* sv)
PERL_CALLCONV OP * Perl_my_attrs(pTHX_ OP *o, OP *attrs);
PERL_CALLCONV void Perl_boot_core_xsutils(pTHX);
#if defined(USE_ITHREADS)
-PERL_CALLCONV PERL_CONTEXT* Perl_cx_dup(pTHX_ PERL_CONTEXT* cx, I32 ix, I32 max, clone_params* param);
-PERL_CALLCONV PERL_SI* Perl_si_dup(pTHX_ PERL_SI* si, clone_params* param);
-PERL_CALLCONV ANY* Perl_ss_dup(pTHX_ PerlInterpreter* proto_perl, clone_params* param);
+PERL_CALLCONV PERL_CONTEXT* Perl_cx_dup(pTHX_ PERL_CONTEXT* cx, I32 ix, I32 max, CLONE_PARAMS* param);
+PERL_CALLCONV PERL_SI* Perl_si_dup(pTHX_ PERL_SI* si, CLONE_PARAMS* param);
+PERL_CALLCONV ANY* Perl_ss_dup(pTHX_ PerlInterpreter* proto_perl, CLONE_PARAMS* param);
PERL_CALLCONV void* Perl_any_dup(pTHX_ void* v, PerlInterpreter* proto_perl);
-PERL_CALLCONV HE* Perl_he_dup(pTHX_ HE* e, bool shared, clone_params* param);
-PERL_CALLCONV REGEXP* Perl_re_dup(pTHX_ REGEXP* r, clone_params* param);
-PERL_CALLCONV PerlIO* Perl_fp_dup(pTHX_ PerlIO* fp, char type);
+PERL_CALLCONV HE* Perl_he_dup(pTHX_ HE* e, bool shared, CLONE_PARAMS* param);
+PERL_CALLCONV REGEXP* Perl_re_dup(pTHX_ REGEXP* r, CLONE_PARAMS* param);
+PERL_CALLCONV PerlIO* Perl_fp_dup(pTHX_ PerlIO* fp, char type, CLONE_PARAMS* param);
PERL_CALLCONV DIR* Perl_dirp_dup(pTHX_ DIR* dp);
-PERL_CALLCONV GP* Perl_gp_dup(pTHX_ GP* gp, clone_params* param);
-PERL_CALLCONV MAGIC* Perl_mg_dup(pTHX_ MAGIC* mg, clone_params* param);
-PERL_CALLCONV SV* Perl_sv_dup(pTHX_ SV* sstr, clone_params* param);
+PERL_CALLCONV GP* Perl_gp_dup(pTHX_ GP* gp, CLONE_PARAMS* param);
+PERL_CALLCONV MAGIC* Perl_mg_dup(pTHX_ MAGIC* mg, CLONE_PARAMS* param);
+PERL_CALLCONV SV* Perl_sv_dup(pTHX_ SV* sstr, CLONE_PARAMS* param);
#if defined(HAVE_INTERP_INTERN)
PERL_CALLCONV void Perl_sys_intern_dup(pTHX_ struct interp_intern* src, struct interp_intern* dst);
#endif
Public API:
- sv_report_used(), sv_clean_objs(), sv_clean_all(), sv_free_arenas()
+ sv_report_used(), sv_clean_objs(), sv_clean_all(), sv_free_arenas()
=cut
=for apidoc sv_2bool
This function is only called on magical items, and is only used by
-sv_true() or its macro equivalent.
+sv_true() or its macro equivalent.
=cut
*/
if ((spv = SvPV(ssv, slen))) {
/* sutf8 and dutf8 were type bool, but under USE_ITHREADS,
gcc version 2.95.2 20000220 (Debian GNU/Linux) for
- Linux xxx 2.2.17 on sparc64 with gcc -O2, we erroneously
- get dutf8 = 0x20000000, (i.e. SVf_UTF8) even though
+ Linux xxx 2.2.17 on sparc64 with gcc -O2, we erroneously
+ get dutf8 = 0x20000000, (i.e. SVf_UTF8) even though
dsv->sv_flags doesn't have that bit set.
Andy Dougherty 12 Oct 2001
*/
#define gv_dup_inc(s,t) (GV*)SvREFCNT_inc(sv_dup((SV*)s,t))
#define SAVEPV(p) (p ? savepv(p) : Nullch)
#define SAVEPVN(p,n) (p ? savepvn(p,n) : Nullch)
-
+
/* Duplicate a regexp. Required reading: pregcomp() and pregfree() in
regcomp.c. AMS 20010712 */
/* duplicate a file handle */
PerlIO *
-Perl_fp_dup(pTHX_ PerlIO *fp, char type)
+Perl_fp_dup(pTHX_ PerlIO *fp, char type,clone_params *param)
{
PerlIO *ret;
if (!fp)
return ret;
/* create anew and remember what it is */
- ret = PerlIO_fdupopen(aTHX_ fp);
+ ret = PerlIO_fdupopen(aTHX_ fp, param);
ptr_table_store(PL_ptr_table, fp, ret);
return ret;
}
for(i = 1; i <= len; i++) {
if(SvREPADTMP(regexen[i])) {
av_push(PL_regex_padav, sv_dup_inc(regexen[i], param));
- } else {
+ } else {
av_push(PL_regex_padav,
SvREFCNT_inc(
- newSViv(PTR2IV(re_dup(INT2PTR(REGEXP *,
+ newSViv(PTR2IV(re_dup(INT2PTR(REGEXP *,
SvIVX(regexen[i])), param)))
));
}
ptr_table_free(PL_ptr_table);
PL_ptr_table = NULL;
}
-
+
/* Call the ->CLONE method, if it exists, for each of the stashes
identified by sv_dup() above.
*/
/*
=for apidoc AmU||svtype
-An enum of flags for Perl types. These are found in the file B<sv.h>
+An enum of flags for Perl types. These are found in the file B<sv.h>
in the C<svtype> enum. Test these flags with the C<SvTYPE> macro.
=for apidoc AmU||SVt_PV
#define SvAMAGIC_on(sv) (SvFLAGS(sv) |= SVf_AMAGIC)
#define SvAMAGIC_off(sv) (SvFLAGS(sv) &= ~SVf_AMAGIC)
-#define SvGAMAGIC(sv) (SvFLAGS(sv) & (SVs_GMG|SVf_AMAGIC))
+#define SvGAMAGIC(sv) (SvFLAGS(sv) & (SVs_GMG|SVf_AMAGIC))
/*
#define Gv_AMG(stash) \
=for apidoc Am|char *|SvGROW|SV* sv|STRLEN len
Expands the character buffer in the SV so that it has room for the
indicated number of bytes (remember to reserve space for an extra trailing
-NUL character). Calls C<sv_grow> to perform the expansion if necessary.
+NUL character). Calls C<sv_grow> to perform the expansion if necessary.
Returns a pointer to the character buffer.
=cut
#define CLONEf_KEEP_PTR_TABLE 2
#define CLONEf_CLONE_HOST 4
-typedef struct {
+struct clone_params {
AV* stashes;
UV flags;
-} clone_params;
+};
s->h = h;
s->fd = fd;
s->refcnt = 1;
- if (fd >= 0)
+ if (fd >= 0)
{
- fdtable[fd] = s;
+ fdtable[fd] = s;
if (fd > max_open_fd)
max_open_fd = fd;
- }
+ }
return f;
}
if (f)
return 0;
}
+PerlIO *
+PerlIOWin32_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *params)
+{
+ /* Almost certainly needs more work */
+ return PerlIOBase_dup(aTHX_ f, o, params);
+}
+
PerlIO_funcs PerlIO_win32 = {
"win32",
sizeof(PerlIOWin32),
PerlIOWin32_open,
NULL, /* getarg */
PerlIOWin32_fileno,
+ PerlIOWin32_dup,
PerlIOWin32_read,
PerlIOBase_unread,
PerlIOWin32_write,
projects / p5sagit/p5-mst-13.2.git / commitdiff