#define ck_concat Perl_ck_concat
#define ck_defined Perl_ck_defined
#define ck_delete Perl_ck_delete
+#define ck_die Perl_ck_die
#define ck_eof Perl_ck_eof
#define ck_eval Perl_ck_eval
#define ck_exec Perl_ck_exec
#define ck_concat(a) Perl_ck_concat(aTHX_ a)
#define ck_defined(a) Perl_ck_defined(aTHX_ a)
#define ck_delete(a) Perl_ck_delete(aTHX_ a)
+#define ck_die(a) Perl_ck_die(aTHX_ a)
#define ck_eof(a) Perl_ck_eof(aTHX_ a)
#define ck_eval(a) Perl_ck_eval(aTHX_ a)
#define ck_exec(a) Perl_ck_exec(aTHX_ a)
#define PL_pending_ident (PERL_GET_INTERP->Ipending_ident)
#define PL_perl_destruct_level (PERL_GET_INTERP->Iperl_destruct_level)
#define PL_perldb (PERL_GET_INTERP->Iperldb)
+#define PL_perlio (PERL_GET_INTERP->Iperlio)
#define PL_pidstatus (PERL_GET_INTERP->Ipidstatus)
#define PL_preambleav (PERL_GET_INTERP->Ipreambleav)
#define PL_preambled (PERL_GET_INTERP->Ipreambled)
#define PL_pending_ident (vTHX->Ipending_ident)
#define PL_perl_destruct_level (vTHX->Iperl_destruct_level)
#define PL_perldb (vTHX->Iperldb)
+#define PL_perlio (vTHX->Iperlio)
#define PL_pidstatus (vTHX->Ipidstatus)
#define PL_preambleav (vTHX->Ipreambleav)
#define PL_preambled (vTHX->Ipreambled)
#define PL_Ipending_ident PL_pending_ident
#define PL_Iperl_destruct_level PL_perl_destruct_level
#define PL_Iperldb PL_perldb
+#define PL_Iperlio PL_perlio
#define PL_Ipidstatus PL_pidstatus
#define PL_Ipreambleav PL_preambleav
#define PL_Ipreambled PL_preambled
#define PL_do_undump (PL_Vars.Gdo_undump)
#define PL_hexdigit (PL_Vars.Ghexdigit)
#define PL_malloc_mutex (PL_Vars.Gmalloc_mutex)
-#define PL_my_inv_rand_max (PL_Vars.Gmy_inv_rand_max)
#define PL_op_mutex (PL_Vars.Gop_mutex)
#define PL_patleave (PL_Vars.Gpatleave)
#define PL_sharedsv_space (PL_Vars.Gsharedsv_space)
#define PL_Gdo_undump PL_do_undump
#define PL_Ghexdigit PL_hexdigit
#define PL_Gmalloc_mutex PL_malloc_mutex
-#define PL_Gmy_inv_rand_max PL_my_inv_rand_max
#define PL_Gop_mutex PL_op_mutex
#define PL_Gpatleave PL_patleave
#define PL_Gsharedsv_space PL_sharedsv_space
PERLVAR(Icustom_op_names, HV*) /* Names of user defined ops */
PERLVAR(Icustom_op_descs, HV*) /* Descriptions of user defined ops */
+#ifdef PERLIO_LAYERS
+PERLVARI(Iperlio, PerlIO *,NULL)
+#endif
+
/* New variables must be added to the very end for binary compatibility.
* XSUB.h provides wrapper functions via perlapi.h that make this
* irrelevant, but not all code may be expected to #include XSUB.h. */
+
+
#define PL_perl_destruct_level (*Perl_Iperl_destruct_level_ptr(aTHX))
#undef PL_perldb
#define PL_perldb (*Perl_Iperldb_ptr(aTHX))
+#undef PL_perlio
+#define PL_perlio (*Perl_Iperlio_ptr(aTHX))
#undef PL_pidstatus
#define PL_pidstatus (*Perl_Ipidstatus_ptr(aTHX))
#undef PL_preambleav
#define PL_hexdigit (*Perl_Ghexdigit_ptr(NULL))
#undef PL_malloc_mutex
#define PL_malloc_mutex (*Perl_Gmalloc_mutex_ptr(NULL))
-#undef PL_my_inv_rand_max
-#define PL_my_inv_rand_max (*Perl_Gmy_inv_rand_max_ptr(NULL))
#undef PL_op_mutex
#define PL_op_mutex (*Perl_Gop_mutex_ptr(NULL))
#undef PL_patleave
/*
* Table of pointers to the PerlIO structs (malloc'ed)
*/
-PerlIO *_perlio = NULL;
#define PERLIO_TABLE_SIZE 64
-
-
PerlIO *
PerlIO_allocate(pTHX)
{
*/
PerlIO **last;
PerlIO *f;
- last = &_perlio;
+ last = &PL_perlio;
while ((f = *last)) {
int i;
last = (PerlIO **) (f);
return f + 1;
}
+#undef PerlIO_fdupopen
+PerlIO *
+PerlIO_fdupopen(pTHX_ PerlIO *f, CLONE_PARAMS *param)
+{
+ if (f && *f) {
+ PerlIO_funcs *tab = PerlIOBase(f)->tab;
+ PerlIO *new;
+ PerlIO_debug("fdupopen f=%p param=%p\n",f,param);
+ new = (*tab->Dup)(aTHX_ PerlIO_allocate(aTHX),f,param);
+ return new;
+ }
+ else {
+ SETERRNO(EBADF, SS$_IVCHAN);
+ return NULL;
+ }
+}
+
+void
+PerlIO_clone(pTHX_ PerlIO *proto, CLONE_PARAMS *param)
+{
+ PerlIO **table = &proto;
+ PerlIO *f;
+ PL_perlio = NULL;
+ PerlIO_allocate(aTHX); /* root slot is never used */
+ while ((f = *table)) {
+ int i;
+ table = (PerlIO **) (f++);
+ for (i = 1; i < PERLIO_TABLE_SIZE; i++) {
+ if (*f) {
+ PerlIO_fdupopen(aTHX_ f, param);
+ }
+ f++;
+ }
+ }
+}
+
void
PerlIO_cleantable(pTHX_ PerlIO **tablep)
{
PerlIO_cleanup()
{
dTHX;
- PerlIO_cleantable(aTHX_ & _perlio);
+ PerlIO_cleantable(aTHX_ &PL_perlio);
}
void
PerlIO_destruct(pTHX)
{
- PerlIO **table = &_perlio;
+ PerlIO **table = &PL_perlio;
PerlIO *f;
while ((f = *table)) {
int i;
void
PerlIO_stdstreams(pTHX)
{
- if (!_perlio) {
+ if (!PL_perlio) {
PerlIO_allocate(aTHX);
PerlIO_fdopen(0, "Ir" PERLIO_STDTEXT);
PerlIO_fdopen(1, "Iw" PERLIO_STDTEXT);
}
}
-#undef PerlIO_fdupopen
-PerlIO *
-PerlIO_fdupopen(pTHX_ PerlIO *f, CLONE_PARAMS *param)
-{
- if (f && *f) {
- PerlIO_funcs *tab = PerlIOBase(f)->tab;
- PerlIO *new;
- PerlIO_debug("fdupopen f=%p param=%p\n",f,param);
- new = (*tab->Dup)(aTHX_ PerlIO_allocate(aTHX),f,param);
- return new;
- }
- else {
- SETERRNO(EBADF, SS$_IVCHAN);
- return NULL;
- }
-}
-
#undef PerlIO_close
int
PerlIO_close(PerlIO *f)
{
PerlIO_list_t *def = PerlIO_default_layers(aTHX);
int incdef = 1;
- if (!_perlio)
+ if (!PL_perlio)
PerlIO_stdstreams(aTHX);
if (narg) {
SV *arg = *args;
* things on fflush(NULL), but should we be bound by their design
* decisions? --jhi
*/
- PerlIO **table = &_perlio;
+ dTHX;
+ PerlIO **table = &PL_perlio;
int code = 0;
while ((f = *table)) {
int i;
void
PerlIOBase_flush_linebuf()
{
- PerlIO **table = &_perlio;
+ dTHX;
+ PerlIO **table = &PL_perlio;
PerlIO *f;
while ((f = *table)) {
int i;
if (!b->buf) {
if (!b->bufsiz)
b->bufsiz = 4096;
- b->buf =
+ b->buf =
Newz('B',b->buf,b->bufsiz, STDCHAR);
if (!b->buf) {
b->buf = (STDCHAR *) & b->oneword;
#ifndef WIN32
call_atexit(PerlIO_cleanup_layers, NULL);
#endif
- if (!_perlio) {
+ if (!PL_perlio) {
#ifndef WIN32
atexit(&PerlIO_cleanup);
#endif
PerlIO *
PerlIO_stdin(void)
{
- if (!_perlio) {
- dTHX;
+ dTHX;
+ if (!PL_perlio) {
PerlIO_stdstreams(aTHX);
}
- return &_perlio[1];
+ return &PL_perlio[1];
}
#undef PerlIO_stdout
PerlIO *
PerlIO_stdout(void)
{
- if (!_perlio) {
- dTHX;
+ dTHX;
+ if (!PL_perlio) {
PerlIO_stdstreams(aTHX);
}
- return &_perlio[2];
+ return &PL_perlio[2];
}
#undef PerlIO_stderr
PerlIO *
PerlIO_stderr(void)
{
- if (!_perlio) {
- dTHX;
+ dTHX;
+ if (!PL_perlio) {
PerlIO_stdstreams(aTHX);
}
- return &_perlio[3];
+ return &PL_perlio[3];
}
/*--------------------------------------------------------------------------------------*/
extern PerlIO *PerlIO_push(pTHX_ PerlIO *f, PerlIO_funcs *tab,
const char *mode, SV *arg);
extern void PerlIO_pop(pTHX_ PerlIO *f);
+extern void PerlIO_clone(pTHX_ PerlIO *proto, CLONE_PARAMS *param);
#endif /* PerlIO */
SV* cv_const_sv(CV* cv)
=for hackers
-Found in file opmini.c
+Found in file op.c
=item dAX
void load_module(U32 flags, SV* name, SV* ver, ...)
=for hackers
-Found in file opmini.c
+Found in file op.c
=item looks_like_number
CV* newCONSTSUB(HV* stash, char* name, SV* sv)
=for hackers
-Found in file opmini.c
+Found in file op.c
=item newHV
Used by C<xsubpp> to hook up XSUBs as Perl subs.
=for hackers
-Found in file opmini.c
+Found in file op.c
=item newXSproto
=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
-=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
=for hackers
Found in file sv.h
-=item SvUVX
+=item SvUVx
-Returns the raw value in the SV's UV slot, without checks or conversions.
-Only use when you are sure SvIOK is true. See also C<SvUV()>.
+Coerces the given SV to an unsigned integer and returns it. Guarantees to
+evaluate sv only once. Use the more efficent C<SvUV> otherwise.
- UV SvUVX(SV* sv)
+ UV SvUVx(SV* sv)
=for hackers
Found in file sv.h
-=item SvUVx
+=item SvUVX
-Coerces the given SV to an unsigned integer and returns it. Guarantees to
-evaluate sv only once. Use the more efficent C<SvUV> otherwise.
+Returns the raw value in the SV's UV slot, without checks or conversions.
+Only use when you are sure SvIOK is true. See also C<SvUV()>.
- UV SvUVx(SV* sv)
+ UV SvUVX(SV* sv)
=for hackers
Found in file sv.h
PL_origargv[i] = SAVEPV(proto_perl->Iorigargv[i]);
}
-
param->stashes = newAV(); /* Setup array of objects to call clone on */
+#ifdef PERLIO_LAYERS
+ /* Clone PerlIO table as soon as we can handle general xx_dup() */
+ PerlIO_clone(aTHX_ proto_perl->Iperlio, param);
+#endif
PL_envgv = gv_dup(proto_perl->Ienvgv, param);
PL_incgv = gv_dup(proto_perl->Iincgv, param);