#ifdef USE_THREADS
PERLVAR(Ithrsv, SV *) /* holds struct perl_thread for main thread */
+ PERLVARI(Ithreadnum, U32, 0) /* incremented each thread creation */
#endif /* USE_THREADS */
+
+#ifdef PERL_OBJECT
+PERLVARI(piMem, IPerlMem*, NULL)
+PERLVARI(piENV, IPerlEnv*, NULL)
+PERLVARI(piStdIO, IPerlStdIO*, NULL)
+PERLVARI(piLIO, IPerlLIO*, NULL)
+PERLVARI(piDir, IPerlDir*, NULL)
+PERLVARI(piSock, IPerlSock*, NULL)
+PERLVARI(piProc, IPerlProc*, NULL)
+#endif
static void sv_unglob _((SV* sv));
static void sv_check_thinkfirst _((SV *sv));
+ #ifndef PURIFY
+ static void *my_safemalloc(MEM_SIZE size);
+ #endif
+
typedef void (*SVFUNC) _((SV*));
+#define VTBL *vtbl
+#define FCALL *f
+
+#endif /* PERL_OBJECT */
#ifdef PURIFY
#ifdef DEBUGGING
- #define del_SV(p) do { \
- MUTEX_LOCK(&sv_mutex); \
- if (debug & 32768) \
- del_sv(p); \
- else \
- plant_SV(p); \
- MUTEX_UNLOCK(&sv_mutex); \
+ #define del_SV(p) do { \
+ LOCK_SV_MUTEX; \
+ if (debug & 32768) \
+ del_sv(p); \
+ else \
+ plant_SV(p); \
+ UNLOCK_SV_MUTEX; \
} while (0)
-static void
+STATIC void
del_sv(SV *p)
{
if (debug & 32768) {
SvTAINT(sv);
}
+ void
+ sv_setnv_mg(register SV *sv, double num)
+ {
+ sv_setnv(sv,num);
+ SvSETMAGIC(sv);
+ }
+
-static void
+STATIC void
not_a_number(SV *sv)
{
dTHR;
SvTAINT(sv);
}
+ void
+ sv_usepvn_mg(register SV *sv, register char *ptr, register STRLEN len)
+ {
+ sv_usepvn_mg(sv,ptr,len);
+ SvSETMAGIC(sv);
+ }
+
-static void
+STATIC void
sv_check_thinkfirst(register SV *sv)
{
if (SvTHINKFIRST(sv)) {
if (defstash) { /* Still have a symbol table? */
djSP;
GV* destructor;
+ HV* stash;
- SV ref;
++ SV tmpref;
- ENTER;
- SAVEFREESV(SvSTASH(sv));
-
- destructor = gv_fetchmethod(SvSTASH(sv), "DESTROY");
- if (destructor) {
- SV tmpRef;
-
- Zero(&tmpRef, 1, SV);
- sv_upgrade(&tmpRef, SVt_RV);
- SvRV(&tmpRef) = SvREFCNT_inc(sv);
- SvROK_on(&tmpRef);
- SvREFCNT(&tmpRef) = 1; /* Fake, but otherwise
- creating+destructing a ref
- leads to disaster. */
-
- EXTEND(SP, 2);
- PUSHMARK(SP);
- PUSHs(&tmpRef);
- PUTBACK;
- perl_call_sv((SV*)GvCV(destructor),
- G_DISCARD|G_EVAL|G_KEEPERR);
- del_XRV(SvANY(&tmpRef));
- SvREFCNT(sv)--;
- }
- Zero(&ref, 1, SV);
- sv_upgrade(&ref, SVt_RV);
- SvROK_on(&ref);
- SvREADONLY_on(&ref); /* DESTROY() could be naughty */
- SvREFCNT(&ref) = 1;
++ Zero(&tmpref, 1, SV);
++ sv_upgrade(&tmpref, SVt_RV);
++ SvROK_on(&tmpref);
++ SvREADONLY_on(&tmpref); /* DESTROY() could be naughty */
++ SvREFCNT(&tmpref) = 1;
- LEAVE;
+ do {
+ stash = SvSTASH(sv);
+ destructor = gv_fetchmethod(SvSTASH(sv), "DESTROY");
+ if (destructor) {
+ ENTER;
- SvRV(&ref) = SvREFCNT_inc(sv);
++ SvRV(&tmpref) = SvREFCNT_inc(sv);
+ EXTEND(SP, 2);
+ PUSHMARK(SP);
- PUSHs(&ref);
++ PUSHs(&tmpref);
+ PUTBACK;
+ perl_call_sv((SV*)GvCV(destructor),
+ G_DISCARD|G_EVAL|G_KEEPERR);
+ SvREFCNT(sv)--;
+ LEAVE;
+ }
+ } while (SvOBJECT(sv) && SvSTASH(sv) != stash);
+
- del_XRV(SvANY(&ref));
++ del_XRV(SvANY(&tmpref));
}
- else
- SvREFCNT_dec(SvSTASH(sv));
+
if (SvOBJECT(sv)) {
+ SvREFCNT_dec(SvSTASH(sv)); /* possibly of changed persuasion */
SvOBJECT_off(sv); /* Curse the object. */
if (SvTYPE(sv) != SVt_PVIO)
--sv_objcount; /* XXX Might want something more general */
#endif
static char * filter_gets _((SV *sv, PerlIO *fp, STRLEN append));
static void restore_rsfp _((void *f));
+ static void restore_expect _((void *e));
+ static void restore_lex_expect _((void *e));
+#endif /* PERL_OBJECT */
static char ident_too_long[] = "Identifier too long";
rsfp = fp;
}
-static void
+STATIC void
+ restore_expect(e)
+ void *e;
+ {
+ /* a safe way to store a small integer in a pointer */
+ expect = (expectation)((char *)e - tokenbuf);
+ }
+
-static void
++STATIC void
+ restore_lex_expect(e)
+ void *e;
+ {
+ /* a safe way to store a small integer in a pointer */
+ lex_expect = (expectation)((char *)e - tokenbuf);
+ }
+
-static void
++STATIC void
incline(char *s)
{
dTHR;