richter 01/11/13 12:26:06
Modified: . Tag: Embperl2c ep.h epcomp.c epmain.c eputil.c
Log:
Embperl 2 - memory debugging
Revision Changes Path
No revision
No revision
1.27.4.29 +22 -16 embperl/ep.h
Index: ep.h
===================================================================
RCS file: /home/cvs/embperl/ep.h,v
retrieving revision 1.27.4.28
retrieving revision 1.27.4.29
diff -u -r1.27.4.28 -r1.27.4.29
--- ep.h 2001/11/13 07:35:16 1.27.4.28
+++ ep.h 2001/11/13 20:26:05 1.27.4.29
@@ -656,42 +656,48 @@
/*in*/ char * sFile,
/*in*/ int nLine) ;
-SV * RemoveDMallocMagic (/*in*/ SV * pSV,
- /*in*/ char * sFile,
- /*in*/ int nLine) ;
-#undef SvREFCNT_dec
-#define SvREFCNT_dec(sv) sv_free(RemoveDMallocMagic((SV*)(sv), __FILE__, __LINE__))
-
#undef newSV
-#define newSV(len) AddDMallocMagic(Perl_newSV((len)), "newSV", __FILE__, __LINE__)
+#define newSV(len) AddDMallocMagic(Perl_newSV((len)), "newSV ", __FILE__,
__LINE__)
#undef newSViv
-#define newSViv(i) AddDMallocMagic(Perl_newSViv((i)), "newSViv", __FILE__,
__LINE__)
+#define newSViv(i) AddDMallocMagic(Perl_newSViv((i)), "newSViv ", __FILE__,
__LINE__)
#undef newSVnv
-#define newSVnv(n) AddDMallocMagic(Perl_newSVnv((n)), "newSVnv", __FILE__,
__LINE__)
+#define newSVnv(n) AddDMallocMagic(Perl_newSVnv((n)), "newSVnv ", __FILE__,
__LINE__)
#undef newSVpv
-#define newSVpv(s,len) AddDMallocMagic(Perl_newSVpv((s),(len)), "newSVpv",
__FILE__, __LINE__)
+#define newSVpv(s,len) AddDMallocMagic(Perl_newSVpv((s),(len)), "newSVpv ",
__FILE__, __LINE__)
#undef newSVpvn
-#define newSVpvn(s,len) AddDMallocMagic(Perl_newSVpvn((s),(len)), "newSVpvn",
__FILE__, __LINE__)
+#define newSVpvn(s,len) AddDMallocMagic(Perl_newSVpvn((s),(len)), "newSVpvn ",
__FILE__, __LINE__)
#undef newSVrv
-#define newSVrv(rv,c) AddDMallocMagic(Perl_newSVrv((rv),(c)), "newSVrv", __FILE__,
__LINE__)
+#define newSVrv(rv,c) AddDMallocMagic(Perl_newSVrv((rv),(c)), "newSVrv ",
__FILE__, __LINE__)
#undef newSVsv
-#define newSVsv(sv) AddDMallocMagic(Perl_newSVsv((sv)), "newSVsv", __FILE__,
__LINE__)
+#define newSVsv(sv) AddDMallocMagic(Perl_newSVsv((sv)), "newSVsv ", __FILE__,
__LINE__)
#undef newSVpvf2
-#define newSVpvf2(sv) AddDMallocMagic((sv), "newSVsvf", __FILE__, __LINE__)
+#define newSVpvf2(sv) AddDMallocMagic((sv), "newSVsvf ", __FILE__, __LINE__)
+
+#undef perl_get_sv
+#define perl_get_sv(name,create) AddDMallocMagic(perl_get_sv(name,create),
"perl_get_sv ", __FILE__, __LINE__)
+
+#undef perl_get_cv
+#define perl_get_cv(name,create) (CV *)AddDMallocMagic((SV
*)perl_get_cv(name,create), "perl_get_cv ", __FILE__, __LINE__)
+
+#undef perl_get_hv
+#define perl_get_hv(name,create) (HV *)AddDMallocMagic((SV
*)perl_get_hv(name,create), "perl_get_hv ", __FILE__, __LINE__)
+
+#undef perl_get_av
+#define perl_get_av(name,create) (AV *)AddDMallocMagic((SV
*)perl_get_av(name,create), "perl_get_av ", __FILE__, __LINE__)
#undef newHV
-#define newHV() (HV *)AddDMallocMagic((SV *)Perl_newHV(), "newHV", __FILE__,
__LINE__)
+#define newHV() (HV *)AddDMallocMagic((SV *)Perl_newHV(), "newHV ", __FILE__,
__LINE__)
#undef newAV
-#define newAV() (AV *)AddDMallocMagic((SV *)Perl_newAV(), "newAV", __FILE__,
__LINE__)
+#define newAV() (AV *)AddDMallocMagic((SV *)Perl_newAV(), "newAV ", __FILE__,
__LINE__)
#else
1.4.2.76 +3 -3 embperl/Attic/epcomp.c
Index: epcomp.c
===================================================================
RCS file: /home/cvs/embperl/Attic/epcomp.c,v
retrieving revision 1.4.2.75
retrieving revision 1.4.2.76
diff -u -r1.4.2.75 -r1.4.2.76
--- epcomp.c 2001/11/13 07:35:16 1.4.2.75
+++ epcomp.c 2001/11/13 20:26:06 1.4.2.76
@@ -9,7 +9,7 @@
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
-# $Id: epcomp.c,v 1.4.2.75 2001/11/13 07:35:16 richter Exp $
+# $Id: epcomp.c,v 1.4.2.76 2001/11/13 20:26:06 richter Exp $
#
###################################################################################*/
@@ -1736,9 +1736,9 @@
SV * args[2] ;
STRLEN l ;
SV * sDomTreeSV = newSVpvf ("%s::%s", r -> Buf.sEvalPackage,
"_ep_DomTree") ;
- newSVpvf2(sDomTreeSV) ;
SV * pDomTreeSV = perl_get_sv (SvPV (sDomTreeSV, l), TRUE) ;
IV xOldDomTree = 0 ;
+ newSVpvf2(sDomTreeSV) ;
if (SvIOK (pDomTreeSV))
xOldDomTree = SvIVX (pDomTreeSV) ;
@@ -2332,9 +2332,9 @@
SV * args[2] ;
STRLEN l ;
SV * sDomTreeSV = newSVpvf ("%s::%s", r -> Buf.sEvalPackage,
"_ep_DomTree") ;
- newSVpvf2(sDomTreeSV) ;
SV * pDomTreeSV = perl_get_sv (SvPV (sDomTreeSV, l), TRUE) ;
IV xOldDomTree = 0 ;
+ newSVpvf2(sDomTreeSV) ;
if (SvIOK (pDomTreeSV))
xOldDomTree = SvIVX (pDomTreeSV) ;
1.75.4.65 +3 -1 embperl/epmain.c
Index: epmain.c
===================================================================
RCS file: /home/cvs/embperl/epmain.c,v
retrieving revision 1.75.4.64
retrieving revision 1.75.4.65
diff -u -r1.75.4.64 -r1.75.4.65
--- epmain.c 2001/11/13 07:35:17 1.75.4.64
+++ epmain.c 2001/11/13 20:26:06 1.75.4.65
@@ -10,7 +10,7 @@
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
-# $Id: epmain.c,v 1.75.4.64 2001/11/13 07:35:17 richter Exp $
+# $Id: epmain.c,v 1.75.4.65 2001/11/13 20:26:06 richter Exp $
#
###################################################################################*/
@@ -253,6 +253,8 @@
r -> nLastErrFill = AvFILL(r -> pErrArray) ;
r -> bLastErrState = r -> bError ;
}
+ else
+ SvREFCNT_dec (pSV) ;
r -> errdat1[0] = '\0' ;
r -> errdat2[0] = '\0' ;
1.15.4.26 +23 -21 embperl/eputil.c
Index: eputil.c
===================================================================
RCS file: /home/cvs/embperl/eputil.c,v
retrieving revision 1.15.4.25
retrieving revision 1.15.4.26
diff -u -r1.15.4.25 -r1.15.4.26
--- eputil.c 2001/11/13 07:35:17 1.15.4.25
+++ eputil.c 2001/11/13 20:26:06 1.15.4.26
@@ -10,7 +10,7 @@
# IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
# WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
-# $Id: eputil.c,v 1.15.4.25 2001/11/13 07:35:17 richter Exp $
+# $Id: eputil.c,v 1.15.4.26 2001/11/13 20:26:06 richter Exp $
#
###################################################################################*/
@@ -1480,41 +1480,43 @@
#ifdef DMALLOC
+static int RemoveDMallocMagic (pTHX_ SV * pSV, MAGIC * mg)
-SV * AddDMallocMagic (/*in*/ SV * pSV,
- /*in*/ char * sText,
- /*in*/ char * sFile,
- /*in*/ int nLine)
-
{
- char * s = _strdup_leap(sFile, nLine, sText) ;
-
- sv_unmagic ((SV *)pSV, '?') ;
- sv_magic ((SV *)pSV, NULL, '?', (char *)&s, sizeof (s)) ;
-
- return pSV ;
+ char * s = *((char * *)(mg -> mg_ptr)) ;
+ _free_leap(__FILE__, __LINE__, s) ;
+ return ok ;
}
-SV * RemoveDMallocMagic (/*in*/ SV * pSV,
+static MGVTBL DMalloc_mvtTab = { NULL, NULL, NULL, NULL, RemoveDMallocMagic } ;
+
+SV * AddDMallocMagic (/*in*/ SV * pSV,
+ /*in*/ char * sText,
/*in*/ char * sFile,
/*in*/ int nLine)
{
- if (pSV -> sv_refcnt == 1)
+ if (pSV)
{
- MAGIC * mg ;
-
+ char * s = _strdup_leap(sFile, nLine, sText) ;
+ struct magic * pMagic ;
+
+ /* we use magic type 'x', hopefully this doesn't get any collisions ... */
+ sv_unmagic ((SV *)pSV, 'x') ;
+ sv_magic ((SV *)pSV, NULL, 'x', (char *)&s, sizeof (s)) ;
+ pMagic = mg_find (pSV, 'x') ;
- if (mg = mg_find (SvRV(pSV), '~'))
+ if (pMagic)
+ pMagic -> mg_virtual = &DMalloc_mvtTab ;
+ else
{
- char * s = ((char *)(mg -> mg_ptr)) ;
- _free_leap(sFile, nLine, s) ;
+ LogError (pCurrReq, rcMagicError) ;
}
-
- sv_unmagic ((SV *)pSV, '?') ;
}
+
return pSV ;
}
+
#endif
---------------------------------------------------------------------
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
