/*
* PERL_FLEXIBLE_EXCEPTIONS
- *
+ *
* All the flexible exceptions code has been removed.
* See the following threads for details:
*
- * http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/2004-07/msg00378.html
- *
+ * Message-Id: 20040713143217.GB1424@plum.flirble.org
+ * https://www.nntp.perl.org/group/perl.perl5.porters/2004/07/msg93041.html
+ *
* Joshua's original patches (which weren't applied) and discussion:
- *
+ *
* http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/1998-02/msg01396.html
* http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/1998-02/msg01489.html
* http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/1998-02/msg01491.html
* http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/1998-02/msg01608.html
* http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/1998-02/msg02144.html
* http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/1998-02/msg02998.html
- *
+ *
* Chip's reworked patch and discussion:
- *
+ *
* http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/1999-03/msg00520.html
- *
+ *
* The flaw in these patches (which went unnoticed at the time) was
* that they moved some code that could potentially die() out of the
* region protected by the setjmp()s. This caused exceptions within
* END blocks and such to not be handled by the correct setjmp().
- *
+ *
* The original patches that introduces flexible exceptions were:
*
- * http://perl5.git.perl.org/perl.git/commit/312caa8e97f1c7ee342a9895c2f0e749625b4929
- * http://perl5.git.perl.org/perl.git/commit/14dd3ad8c9bf82cf09798a22cc89a9862dfd6d1a
- *
+ * https://github.com/Perl/perl5/commit/312caa8e97f1c7ee342a9895c2f0e749625b4929
+ * https://github.com/Perl/perl5/commit/14dd3ad8c9bf82cf09798a22cc89a9862dfd6d1a
+ *
*/
#define dJMPENV JMPENV cur_env
} STMT_END
/*
-=head1 COP Hint Hashes
+=for apidoc_section COP Hint Hashes
*/
typedef struct refcounted_he COPHH;
associated with the key, or C<&PL_sv_placeholder> if there is no value
associated with the key.
+=for apidoc Amnh||COPHH_KEY_UTF8
+
=cut
*/
Perl_refcounted_he_fetch_pvn(aTHX_ cophh, keypv, keylen, hash, flags)
/*
-=for apidoc Amx|SV *|cophh_fetch_pvs|const COPHH *cophh|"literal string" key|U32 flags
+=for apidoc Amx|SV *|cophh_fetch_pvs|const COPHH *cophh|"key"|U32 flags
Like L</cophh_fetch_pvn>, but takes a literal string instead
of a string/length pair, and no precomputed hash.
Perl_refcounted_he_new_pvn(aTHX_ cophh, keypv, keylen, hash, value, flags)
/*
-=for apidoc Amx|COPHH *|cophh_store_pvs|const COPHH *cophh|"literal string" key|SV *value|U32 flags
+=for apidoc Amx|COPHH *|cophh_store_pvs|const COPHH *cophh|"key"|SV *value|U32 flags
Like L</cophh_store_pvn>, but takes a literal string instead
of a string/length pair, and no precomputed hash.
(SV *)NULL, flags)
/*
-=for apidoc Amx|COPHH *|cophh_delete_pvs|const COPHH *cophh|"literal string" key|U32 flags
+=for apidoc Amx|COPHH *|cophh_delete_pvs|const COPHH *cophh|"key"|U32 flags
Like L</cophh_delete_pvn>, but takes a literal string instead
of a string/length pair, and no precomputed hash.
#ifdef USE_ITHREADS
PADOFFSET cop_stashoff; /* offset into PL_stashpad, for the
package the line was compiled in */
- char * cop_file; /* file name the following line # is from */
+ char * cop_file; /* name of file this command is from */
#else
HV * cop_stash; /* package line was compiled in */
- GV * cop_filegv; /* file the following line # is from */
+ GV * cop_filegv; /* name of GV file this command is from */
#endif
U32 cop_hints; /* hints bits from pragmata */
U32 cop_seq; /* parse sequence number */
/* compile time state of %^H. See the comment in op.c for how this is
used to recreate a hash to return from caller. */
COPHH * cop_hints_hash;
+ /* for now just a bitmask stored here.
+ If we get sufficient features this may become a pointer.
+ How these flags are stored is subject to change without
+ notice. Use the macros to test for features.
+ */
+ U32 cop_features;
};
#ifdef USE_ITHREADS
# define CopFILE(c) ((c)->cop_file)
# define CopFILEGV(c) (CopFILE(c) \
? gv_fetchfile(CopFILE(c)) : NULL)
-
+
# ifdef NETWARE
# define CopFILE_set(c,pv) ((c)->cop_file = savepv(pv))
# define CopFILE_setn(c,pv,l) ((c)->cop_file = savepvn((pv),(l)))
# else
# define CopFILE_free(c) (PerlMemShared_free(CopFILE(c)),(CopFILE(c) = NULL))
# endif
-#else
+#else /* Above: no threads; Below yes threads */
# define CopFILEGV(c) ((c)->cop_filegv)
# define CopFILEGV_set(c,gv) ((c)->cop_filegv = (GV*)SvREFCNT_inc(gv))
# define CopFILE_set(c,pv) CopFILEGV_set((c), gv_fetchfile(pv))
# else
# define CopFILEAVx(c) (GvAV(CopFILEGV(c)))
# endif
-# define CopFILE(c) (CopFILEGV(c) \
+# define CopFILE(c) (CopFILEGV(c) /* +2 for '_<' */ \
? GvNAME(CopFILEGV(c))+2 : NULL)
# define CopSTASH(c) ((c)->cop_stash)
# define CopSTASH_set(c,hv) ((c)->cop_stash = (hv))
#define CopHINTHASH_set(c,h) ((c)->cop_hints_hash = (h))
/*
-=head1 COP Hint Reading
-*/
-
-/*
=for apidoc Am|SV *|cop_hints_fetch_pvn|const COP *cop|const char *keypv|STRLEN keylen|U32 hash|U32 flags
Look up the hint entry in the cop C<cop> with the key specified by
cophh_fetch_pvn(CopHINTHASH_get(cop), keypv, keylen, hash, flags)
/*
-=for apidoc Am|SV *|cop_hints_fetch_pvs|const COP *cop|"literal string" key|U32 flags
+=for apidoc Am|SV *|cop_hints_fetch_pvs|const COP *cop|"key"|U32 flags
Like L</cop_hints_fetch_pvn>, but takes a literal string
instead of a string/length pair, and no precomputed hash.
#define cop_hints_2hv(cop, flags) \
cophh_2hv(CopHINTHASH_get(cop), flags)
+/*
+=for apidoc Am|const char *|CopLABEL|COP *const cop
+
+Returns the label attached to a cop.
+
+=for apidoc Am|const char *|CopLABEL_len|COP *const cop|STRLEN *len
+
+Returns the label attached to a cop, and stores its length in bytes into
+C<*len>.
+
+=for apidoc Am|const char *|CopLABEL_len_flags|COP *const cop|STRLEN *len|U32 *flags
+
+Returns the label attached to a cop, and stores its length in bytes into
+C<*len>. Upon return, C<*flags> will be set to either C<SVf_UTF8> or 0.
+
+=cut
+*/
+
#define CopLABEL(c) Perl_cop_fetch_label(aTHX_ (c), NULL, NULL)
#define CopLABEL_len(c,len) Perl_cop_fetch_label(aTHX_ (c), len, NULL)
#define CopLABEL_len_flags(c,len,flags) Perl_cop_fetch_label(aTHX_ (c), len, flags)
/* subroutine context */
struct block_sub {
OP * retop; /* op to execute on exit from sub */
+ I32 old_cxsubix; /* previous value of si_cxsubix */
/* Above here is the same for sub, format and eval. */
PAD *prevcomppad; /* the caller's PL_comppad */
CV * cv;
/* format context */
struct block_format {
OP * retop; /* op to execute on exit from sub */
+ I32 old_cxsubix; /* previous value of si_cxsubix */
/* Above here is the same for sub, format and eval. */
PAD *prevcomppad; /* the caller's PL_comppad */
CV * cv;
# define CX_POP(cx) cxstack_ix--;
#endif
-
-/* base for the next two macros. Don't use directly.
- * The context frame holds a reference to the CV so that it can't be
- * freed while we're executing it */
-
-
#define CX_PUSHSUB_GET_LVALUE_MASK(func) \
/* If the context is indeterminate, then only the lvalue */ \
/* flags that the caller also has are applicable. */ \
/* eval context */
struct block_eval {
OP * retop; /* op to execute on exit from eval */
+ I32 old_cxsubix; /* previous value of si_cxsubix */
/* Above here is the same for sub, format and eval. */
SV * old_namesv;
OP * old_eval_root;
#define CXINC (cxstack_ix < cxstack_max ? ++cxstack_ix : (cxstack_ix = cxinc()))
-/*
-=head1 "Gimme" Values
-*/
-
/*
-=for apidoc AmU||G_SCALAR
+=for apidoc AmnU||G_SCALAR
Used to indicate scalar context. See C<L</GIMME_V>>, C<L</GIMME>>, and
L<perlcall>.
-=for apidoc AmU||G_ARRAY
+=for apidoc AmnU||G_ARRAY
Used to indicate list context. See C<L</GIMME_V>>, C<L</GIMME>> and
L<perlcall>.
-=for apidoc AmU||G_VOID
+=for apidoc AmnU||G_VOID
Used to indicate void context. See C<L</GIMME_V>> and L<perlcall>.
-=for apidoc AmU||G_DISCARD
+=for apidoc AmnU||G_DISCARD
Indicates that arguments returned from a callback should be discarded. See
L<perlcall>.
-=for apidoc AmU||G_EVAL
+=for apidoc AmnU||G_EVAL
Used to force a Perl C<eval> wrapper around a callback. See
L<perlcall>.
-=for apidoc AmU||G_NOARGS
+=for apidoc AmnU||G_NOARGS
Indicates that no arguments are being sent to a callback. See
L<perlcall>.
#define G_WANT 3
/* extra flags for Perl_call_* routines */
-#define G_DISCARD 4 /* Call FREETMPS.
+#define G_DISCARD 0x4 /* Call FREETMPS.
Don't change this without consulting the
hash actions codes defined in hv.h */
-#define G_EVAL 8 /* Assume eval {} around subroutine call. */
-#define G_NOARGS 16 /* Don't construct a @_ array. */
-#define G_KEEPERR 32 /* Warn for errors, don't overwrite $@ */
-#define G_NODEBUG 64 /* Disable debugging at toplevel. */
-#define G_METHOD 128 /* Calling method. */
-#define G_FAKINGEVAL 256 /* Faking an eval context for call_sv or
+#define G_EVAL 0x8 /* Assume eval {} around subroutine call. */
+#define G_NOARGS 0x10 /* Don't construct a @_ array. */
+#define G_KEEPERR 0x20 /* Warn for errors, don't overwrite $@ */
+#define G_NODEBUG 0x40 /* Disable debugging at toplevel. */
+#define G_METHOD 0x80 /* Calling method. */
+#define G_FAKINGEVAL 0x100 /* Faking an eval context for call_sv or
fold_constants. */
-#define G_UNDEF_FILL 512 /* Fill the stack with &PL_sv_undef
+#define G_UNDEF_FILL 0x200 /* Fill the stack with &PL_sv_undef
A special case for UNSHIFT in
Perl_magic_methcall(). */
-#define G_WRITING_TO_STDERR 1024 /* Perl_write_to_stderr() is calling
+#define G_WRITING_TO_STDERR 0x400 /* Perl_write_to_stderr() is calling
Perl_magic_methcall(). */
-#define G_RE_REPARSING 0x800 /* compiling a run-time /(?{..})/ */
-#define G_METHOD_NAMED 4096 /* calling named method, eg without :: or ' */
+#define G_RE_REPARSING 0x800 /* compiling a run-time /(?{..})/ */
+#define G_METHOD_NAMED 0x1000 /* calling named method, eg without :: or ' */
+#define G_RETHROW 0x2000 /* eval_sv(): re-throw any error */
/* flag bits for PL_in_eval */
#define EVAL_NULL 0 /* not in an eval */
/* Support for switching (stack and block) contexts.
* This ensures magic doesn't invalidate local stack and cx pointers.
+ * Which one to use (or add) is mostly, but not completely arbitrary: See
+ * http://nntp.perl.org/group/perl.perl5.porters/257169
*/
#define PERLSI_UNKNOWN -1
#define PERLSI_DIEHOOK 8
#define PERLSI_REQUIRE 9
#define PERLSI_MULTICALL 10
+#define PERLSI_REGCOMP 11
struct stackinfo {
AV * si_stack; /* stack for current runlevel */
struct stackinfo * si_next;
I32 si_cxix; /* current context index */
I32 si_cxmax; /* maximum allocated index */
+ I32 si_cxsubix; /* topmost sub/eval/format */
I32 si_type; /* type of runlevel */
I32 si_markoff; /* offset where markstack begins for us.
* currently used only with DEBUGGING,
} \
next->si_type = type; \
next->si_cxix = -1; \
+ next->si_cxsubix = -1; \
PUSHSTACK_INIT_HWM(next); \
AvFILLp(next->si_stack) = 0; \
SWITCHSTACK(PL_curstack,next->si_stack); \
} \
} STMT_END
-#define IN_PERL_COMPILETIME cBOOL(PL_curcop == &PL_compiling)
-#define IN_PERL_RUNTIME cBOOL(PL_curcop != &PL_compiling)
-
+/*
+=for apidoc_section Utility Functions
+=for apidoc Amn|bool|IN_PERL_COMPILETIME
+Returns 1 if this macro is being called during the compilation phase of the
+program; otherwise 0;
+=for apidoc Amn|bool|IN_PERL_RUNTIME
+Returns 1 if this macro is being called during the execution phase of the
+program; otherwise 0;
+=cut
+*/
+#define IN_PERL_COMPILETIME cBOOL(PL_curcop == &PL_compiling)
+#define IN_PERL_RUNTIME cBOOL(PL_curcop != &PL_compiling)
/*
-=head1 Multicall Functions
+=for apidoc_section Multicall Functions
-=for apidoc Ams||dMULTICALL
+=for apidoc Amns||dMULTICALL
Declare local variables for a multicall. See L<perlcall/LIGHTWEIGHT CALLBACKS>.
-=for apidoc Ams||PUSH_MULTICALL
+=for apidoc Ams||PUSH_MULTICALL|CV* the_cv
Opening bracket for a lightweight callback.
See L<perlcall/LIGHTWEIGHT CALLBACKS>.
-=for apidoc Ams||MULTICALL
+=for apidoc Amns||MULTICALL
Make a lightweight callback. See L<perlcall/LIGHTWEIGHT CALLBACKS>.
-=for apidoc Ams||POP_MULTICALL
+=for apidoc Amns||POP_MULTICALL
Closing bracket for a lightweight callback.
See L<perlcall/LIGHTWEIGHT CALLBACKS>.
https://perl5.git.perl.org / perl5.git / blobdiff