/* scope.c
*
- * Copyright (c) 1991-1997, Larry Wall
+ * Copyright (c) 1991-1999, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
#include "EXTERN.h"
#include "perl.h"
+void *
+default_protect(int *excpt, protect_body_t body, ...)
+{
+ dTHR;
+ dJMPENV;
+ va_list args;
+ int ex;
+ void *ret;
+
+ DEBUG_l(deb("Setting up local jumplevel %p, was %p\n",
+ &cur_env, PL_top_env));
+ JMPENV_PUSH(ex);
+ if (ex)
+ ret = NULL;
+ else {
+ va_start(args, body);
+ ret = CALL_FPTR(body)(args);
+ va_end(args);
+ }
+ *excpt = ex;
+ JMPENV_POP;
+ return ret;
+}
+
SV**
stack_grow(SV **sp, SV **p, int n)
{
#undef GROW
void
+tmps_grow(I32 n)
+{
+ dTHR;
+#ifndef STRESS_REALLOC
+ if (n < 128)
+ n = (PL_tmps_max < 512) ? 128 : 512;
+#endif
+ PL_tmps_max = PL_tmps_ix + n + 1;
+ Renew(PL_tmps_stack, PL_tmps_max, SV*);
+}
+
+
+void
free_tmps(void)
{
dTHR;
sv = *(SV**)ptr;
/* Can clear pad variable in place? */
if (SvREFCNT(sv) <= 1 && !SvOBJECT(sv)) {
- if (SvTHINKFIRST(sv)) {
- if (SvREADONLY(sv))
- croak("panic: leave_scope clearsv");
- if (SvROK(sv))
- sv_unref(sv);
- }
+ if (SvTHINKFIRST(sv))
+ sv_force_normal(sv);
if (SvMAGICAL(sv))
mg_free(sv);
{
#ifdef DEBUGGING
dTHR;
- PerlIO_printf(Perl_debug_log, "CX %ld = %s\n", (long)(cx - cxstack), block_type[CxTYPE(cx)]);
+ PerlIO_printf(Perl_debug_log, "CX %ld = %s\n", (long)(cx - cxstack), PL_block_type[CxTYPE(cx)]);
if (CxTYPE(cx) != CXt_SUBST) {
PerlIO_printf(Perl_debug_log, "BLK_OLDSP = %ld\n", (long)cx->blk_oldsp);
PerlIO_printf(Perl_debug_log, "BLK_OLDCOP = 0x%lx\n", (long)cx->blk_oldcop);
PerlIO_printf(Perl_debug_log, "BLK_EVAL.OLD_IN_EVAL = %ld\n",
(long)cx->blk_eval.old_in_eval);
PerlIO_printf(Perl_debug_log, "BLK_EVAL.OLD_OP_TYPE = %s (%s)\n",
- op_name[cx->blk_eval.old_op_type],
- op_desc[cx->blk_eval.old_op_type]);
+ PL_op_name[cx->blk_eval.old_op_type],
+ PL_op_desc[cx->blk_eval.old_op_type]);
PerlIO_printf(Perl_debug_log, "BLK_EVAL.OLD_NAME = %s\n",
cx->blk_eval.old_name);
PerlIO_printf(Perl_debug_log, "BLK_EVAL.OLD_EVAL_ROOT = 0x%lx\n",
(long)cx->sb_iters);
PerlIO_printf(Perl_debug_log, "SB_MAXITERS = %ld\n",
(long)cx->sb_maxiters);
- PerlIO_printf(Perl_debug_log, "SB_SAFEBASE = %ld\n",
- (long)cx->sb_safebase);
+ PerlIO_printf(Perl_debug_log, "SB_RFLAGS = %ld\n",
+ (long)cx->sb_rflags);
PerlIO_printf(Perl_debug_log, "SB_ONCE = %ld\n",
(long)cx->sb_once);
PerlIO_printf(Perl_debug_log, "SB_ORIG = %s\n",