Dean Roehrich <roehrich@cray.com>
Hugo van der Sanden <hv@crypt0.demon.co.uk>
Roderick Schertler <roderick@argon.org>
- Kurt D. Starsinic <kstar@chapin.edu>
+ Kurt D. Starsinic <kstar@isinet.com>
Dan Sugalski <sugalskd@osshe.edu>
Larry W. Virden <lvirden@cas.org>
Ilya Zakharevich <ilya@math.ohio-state.edu>
Dean Roehrich <roehrich@cray.com>
Hugo van der Sanden <hv@crypt0.demon.co.uk>
Roderick Schertler <roderick@argon.org>
- Kurt D. Starsinic <kstar@chapin.edu>
+ Kurt D. Starsinic <kstar@isinet.com>
Dan Sugalski <sugalskd@osshe.edu>
Larry W. Virden <lvirden@cas.org>
Ilya Zakharevich <ilya@math.ohio-state.edu>
#define save_I16 Perl_save_I16
#define save_I32 Perl_save_I32
#define save_aelem Perl_save_aelem
+#define save_alloc Perl_save_alloc
#define save_aptr Perl_save_aptr
#define save_ary Perl_save_ary
#define save_clearsv Perl_save_clearsv
save_I16
save_I32
save_aelem
+save_alloc
save_aptr
save_ary
save_clearsv
# endif
#endif
+#ifdef PERL_OBJECT
+# define VTBL this->*vtbl
+#else
+# define VTBL *vtbl
+static void restore_magic _((void *p));
+#endif
+
/*
* Use the "DESTRUCTOR" scope cleanup to reinstate magic.
*/
-#ifdef PERL_OBJECT
-
-#define VTBL this->*vtbl
-
-#else
struct magic_state {
SV* mgs_sv;
U32 mgs_flags;
+ I32 mgs_ss_ix;
};
-typedef struct magic_state MGS;
-
-static void restore_magic _((void *p));
-#define VTBL *vtbl
-
-#endif
+/* MGS is typedef'ed to struct magic_state in perl.h */
STATIC void
-save_magic(MGS *mgs, SV *sv)
+save_magic(I32 mgs_ix, SV *sv)
{
+ MGS* mgs;
assert(SvMAGICAL(sv));
+ SAVEDESTRUCTOR(restore_magic, (void*)mgs_ix);
+
+ mgs = SSPTR(mgs_ix, MGS*);
mgs->mgs_sv = sv;
mgs->mgs_flags = SvMAGICAL(sv) | SvREADONLY(sv);
- SAVEDESTRUCTOR(restore_magic, mgs);
+ mgs->mgs_ss_ix = PL_savestack_ix; /* points after the saved destructor */
SvMAGICAL_off(sv);
SvREADONLY_off(sv);
STATIC void
restore_magic(void *p)
{
- MGS* mgs = (MGS*)p;
+ MGS* mgs = SSPTR((I32)p, MGS*);
SV* sv = mgs->mgs_sv;
+ if (!sv)
+ return;
+
if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv))
{
if (mgs->mgs_flags)
if (SvGMAGICAL(sv))
SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK|SVf_POK);
}
+
+ mgs->mgs_sv = NULL; /* mark the MGS structure as restored */
+
+ /* If we're still on top of the stack, pop us off. (That condition
+ * will be satisfied if restore_magic was called explicitly, but *not*
+ * if it's being called via leave_scope.)
+ * The reason for doing this is that otherwise, things like sv_2cv()
+ * may leave alloc gunk on the savestack, and some code
+ * (e.g. sighandler) doesn't expect that...
+ */
+ if (PL_savestack_ix == mgs->mgs_ss_ix)
+ {
+ assert(SSPOPINT == SAVEt_DESTRUCTOR);
+ PL_savestack_ix -= 2;
+ assert(SSPOPINT == SAVEt_ALLOC);
+ PL_savestack_ix -= SSPOPINT;
+ }
+
}
void
int
mg_get(SV *sv)
{
- MGS mgs;
+ I32 mgs_ix;
MAGIC* mg;
MAGIC** mgp;
int mgp_valid = 0;
- ENTER;
- save_magic(&mgs, sv);
+ mgs_ix = SSNEW(sizeof(MGS));
+ save_magic(mgs_ix, sv);
mgp = &SvMAGIC(sv);
while ((mg = *mgp) != 0) {
/* Ignore this magic if it's been deleted */
if ((mg == (mgp_valid ? *mgp : SvMAGIC(sv))) &&
(mg->mg_flags & MGf_GSKIP))
- mgs.mgs_flags = 0;
+ (SSPTR(mgs_ix, MGS*))->mgs_flags = 0;
}
/* Advance to next magic (complicated by possible deletion) */
if (mg == (mgp_valid ? *mgp : SvMAGIC(sv))) {
mgp = &SvMAGIC(sv); /* Re-establish pointer after sv_upgrade */
}
- LEAVE;
+ restore_magic((void*)mgs_ix);
return 0;
}
int
mg_set(SV *sv)
{
- MGS mgs;
+ I32 mgs_ix;
MAGIC* mg;
MAGIC* nextmg;
- ENTER;
- save_magic(&mgs, sv);
+ mgs_ix = SSNEW(sizeof(MGS));
+ save_magic(mgs_ix, sv);
for (mg = SvMAGIC(sv); mg; mg = nextmg) {
MGVTBL* vtbl = mg->mg_virtual;
nextmg = mg->mg_moremagic; /* it may delete itself */
if (mg->mg_flags & MGf_GSKIP) {
mg->mg_flags &= ~MGf_GSKIP; /* setting requires another read */
- mgs.mgs_flags = 0;
+ (SSPTR(mgs_ix, MGS*))->mgs_flags = 0;
}
if (vtbl && (vtbl->svt_set != NULL))
(VTBL->svt_set)(sv, mg);
}
- LEAVE;
+ restore_magic((void*)mgs_ix);
return 0;
}
for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
MGVTBL* vtbl = mg->mg_virtual;
if (vtbl && (vtbl->svt_len != NULL)) {
- MGS mgs;
+ I32 mgs_ix;
- ENTER;
- save_magic(&mgs, sv);
+ mgs_ix = SSNEW(sizeof(MGS));
+ save_magic(mgs_ix, sv);
/* omit MGf_GSKIP -- not changed here */
len = (VTBL->svt_len)(sv, mg);
- LEAVE;
+ restore_magic((void*)mgs_ix);
return len;
}
}
for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
MGVTBL* vtbl = mg->mg_virtual;
if (vtbl && (vtbl->svt_len != NULL)) {
- MGS mgs;
- ENTER;
+ I32 mgs_ix;
+
+ mgs_ix = SSNEW(sizeof(MGS));
+ save_magic(mgs_ix, sv);
/* omit MGf_GSKIP -- not changed here */
len = (VTBL->svt_len)(sv, mg);
- LEAVE;
+ restore_magic((void*)mgs_ix);
return len;
}
}
int
mg_clear(SV *sv)
{
- MGS mgs;
+ I32 mgs_ix;
MAGIC* mg;
- ENTER;
- save_magic(&mgs, sv);
+ mgs_ix = SSNEW(sizeof(MGS));
+ save_magic(mgs_ix, sv);
for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
MGVTBL* vtbl = mg->mg_virtual;
(VTBL->svt_clear)(sv, mg);
}
- LEAVE;
+ restore_magic((void*)mgs_ix);
return 0;
}
#define savestack_grow pPerl->Perl_savestack_grow
#undef save_aelem
#define save_aelem pPerl->Perl_save_aelem
+#undef save_alloc
+#define save_alloc pPerl->Perl_save_alloc
#undef save_aptr
#define save_aptr pPerl->Perl_save_aptr
#undef save_ary
#define savestack_grow CPerlObj::Perl_savestack_grow
#undef save_aelem
#define save_aelem CPerlObj::Perl_save_aelem
+#undef save_alloc
+#define save_alloc CPerlObj::Perl_save_alloc
#undef save_aptr
#define save_aptr CPerlObj::Perl_save_aptr
#undef save_ary
OP *sub_op; /* "lex_op" to use */
};
-#ifdef PERL_OBJECT
-struct magic_state {
- SV* mgs_sv;
- U32 mgs_flags;
-};
-typedef struct magic_state MGS;
+typedef struct magic_state MGS; /* struct magic_state defined in mg.c */
+#ifdef PERL_OBJECT
typedef struct {
I32 len_min;
I32 len_delta;
VIRTUAL char* savepvn _((char* sv, I32 len));
VIRTUAL void savestack_grow _((void));
VIRTUAL void save_aelem _((AV* av, I32 idx, SV **sptr));
+VIRTUAL I32 save_alloc _((I32 size, I32 pad));
VIRTUAL void save_aptr _((AV** aptr));
VIRTUAL AV* save_ary _((GV* gv));
VIRTUAL void save_clearsv _((SV** svp));
SSPUSHINT(SAVEt_OP);
}
+I32
+save_alloc(I32 size, I32 pad)
+{
+ dTHR;
+ register I32 start = pad + ((char*)&PL_savestack[PL_savestack_ix]
+ - (char*)PL_savestack);
+ register I32 elems = 1 + ((size + pad - 1) / sizeof(*PL_savestack));
+
+ /* SSCHECK may not be good enough */
+ while (PL_savestack_ix + elems + 2 > PL_savestack_max)
+ savestack_grow();
+
+ PL_savestack_ix += elems;
+ SSPUSHINT(elems);
+ SSPUSHINT(SAVEt_ALLOC);
+ return start;
+}
+
void
leave_scope(I32 base)
{
(CALLDESTRUCTOR)(ptr);
break;
case SAVEt_REGCONTEXT:
+ case SAVEt_ALLOC:
i = SSPOPINT;
PL_savestack_ix -= i; /* regexp must have croaked */
break;
#define SAVEt_HELEM 25
#define SAVEt_OP 26
#define SAVEt_HINTS 27
+#define SAVEt_ALLOC 28
#define SSCHECK(need) if (PL_savestack_ix + need > PL_savestack_max) savestack_grow()
#define SSPUSHINT(i) (PL_savestack[PL_savestack_ix++].any_i32 = (I32)(i))
} \
} STMT_END
+/* SSNEW() temporarily allocates a specified number of bytes of data on the
+ * savestack. It returns an integer index into the savestack, because a
+ * pointer would get broken if the savestack is moved on reallocation.
+ * SSNEWa() works like SSNEW(), but also aligns the data to the specified
+ * number of bytes. MEM_ALIGNBYTES is perhaps the most useful. The
+ * alignment will be preserved therough savestack reallocation *only* if
+ * realloc returns data aligned to a size divisible by `align'!
+ *
+ * SSPTR() converts the index returned by SSNEW/SSNEWa() into a pointer.
+ */
+
+#define SSNEW(size) save_alloc(size, 0)
+#define SSNEWa(size,align) save_alloc(size, \
+ (align - ((int)((caddr_t)&PL_savestack[PL_savestack_ix]) % align)) % align)
+
+#define SSPTR(off,type) ((type) ((char*)PL_savestack + off))
+
/* A jmpenv packages the state required to perform a proper non-local jump.
* Note that there is a start_env initialized when perl starts, and top_env
* points to this initially, so top_env should always be non-null.
#!./perl
-# $RCSfile: tell.t,v $$Revision: 4.1 $$Date: 92/08/07 18:27:33 $
+# $RCSfile: tell.t,v $$Revision$$Date$
-print "1..13\n";
+print "1..21\n";
$TST = 'tst';
if ($lastpos == tell) { print "ok 12\n"; } else { print "not ok 12\n"; }
unless (eof) { print "not ok 13\n"; } else { print "ok 13\n"; }
+
+if ($. == 0) { print "not ok 14\n"; } else { print "ok 14\n"; }
+
+$curline = $.;
+open(other, '../Configure') || (die "Can't open ../Configure");
+binmode other if $^O eq 'MSWin32';
+
+{
+ local($.);
+
+ if ($. == 0) { print "not ok 15\n"; } else { print "ok 15\n"; }
+
+ tell other;
+ if ($. == 0) { print "ok 16\n"; } else { print "not ok 16\n"; }
+
+ $. = 5;
+ scalar <other>;
+ if ($. == 6) { print "ok 17\n"; } else { print "not ok 17\n"; }
+}
+
+if ($. == $curline) { print "ok 18\n"; } else { print "not ok 18\n"; }
+
+{
+ local($.);
+
+ scalar <other>;
+ if ($. == 7) { print "ok 19\n"; } else { print "not ok 19\n"; }
+}
+
+if ($. == $curline) { print "ok 20\n"; } else { print "not ok 20\n"; }
+
+{
+ local($.);
+
+ tell other;
+ if ($. == 7) { print "ok 21\n"; } else { print "not ok 21\n"; }
+}
projects / p5sagit/p5-mst-13.2.git / commitdiff