summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorIlya Zakharevich <ilya@math.berkeley.edu>1998-01-09 12:55:09 -0500
committerMalcolm Beattie <mbeattie@sable.ox.ac.uk>1998-02-06 15:53:53 +0000
commit8c52afecd5252bed5ed8df3a63a6cd9affde4ab4 (patch)
treebf76561b68d175b89a738902a9cce82ceb3cb23c
parentcdaebead333273a920fe10cbcb2213a9fbefa241 (diff)
downloadperl-8c52afecd5252bed5ed8df3a63a6cd9affde4ab4.tar.gz
Newer -DLEAKTEST patch
p4raw-id: //depot/perl@466
-rw-r--r--ext/DB_File/DB_File.xs7
-rw-r--r--ext/DynaLoader/dl_next.xs6
-rw-r--r--ext/DynaLoader/dl_vms.xs2
-rw-r--r--ext/Opcode/Opcode.xs2
-rw-r--r--handy.h15
-rw-r--r--hv.c2
-rw-r--r--perl.c4
-rw-r--r--perly.c10
-rw-r--r--perly.c.diff13
-rwxr-xr-xperly.fixer20
-rw-r--r--pod/perlembed.pod8
-rw-r--r--pod/perlguts.pod7
-rw-r--r--pod/perlrun.pod6
-rw-r--r--pod/perltoc.pod2
-rw-r--r--pp_hot.c2
-rw-r--r--sv.c95
-rw-r--r--toke.c2
-rw-r--r--util.c143
-rw-r--r--vms/perly_c.vms9
-rw-r--r--x2p/hash.c2
20 files changed, 239 insertions, 118 deletions
diff --git a/ext/DB_File/DB_File.xs b/ext/DB_File/DB_File.xs
index f77757caa4..8f2eda10b0 100644
--- a/ext/DB_File/DB_File.xs
+++ b/ext/DB_File/DB_File.xs
@@ -560,12 +560,13 @@ SV * sv ;
{
SV ** svp;
HV * action ;
- DB_File RETVAL = (DB_File)safemalloc(sizeof(DB_File_type)) ;
+ DB_File RETVAL;
void * openinfo = NULL ;
- INFO * info = &RETVAL->info ;
+ INFO * info;
/* printf("In ParseOpenInfo name=[%s] flags=[%d] mode = [%d]\n", name, flags, mode) ; */
- Zero(RETVAL, 1, DB_File_type) ;
+ Newz(777, RETVAL, 1, DB_File_type) ;
+ info = &RETVAL->info ;
/* Default to HASH */
RETVAL->hash = RETVAL->compare = RETVAL->prefix = NULL ;
diff --git a/ext/DynaLoader/dl_next.xs b/ext/DynaLoader/dl_next.xs
index 92d14bc81c..e35c251c55 100644
--- a/ext/DynaLoader/dl_next.xs
+++ b/ext/DynaLoader/dl_next.xs
@@ -100,7 +100,7 @@ static void TranslateError
path, number, type);
break;
}
- safefree(dl_last_error);
+ Safefree(dl_last_error);
dl_last_error = savepv(error);
}
@@ -151,10 +151,10 @@ static void TransferError(NXStream *s)
int len, maxlen;
if ( dl_last_error ) {
- safefree(dl_last_error);
+ Safefree(dl_last_error);
}
NXGetMemoryBuffer(s, &buffer, &len, &maxlen);
- dl_last_error = safemalloc(len);
+ New(1097, dl_last_error, len, char);
strcpy(dl_last_error, buffer);
}
diff --git a/ext/DynaLoader/dl_vms.xs b/ext/DynaLoader/dl_vms.xs
index 0329ebd9cb..2ed718dfd7 100644
--- a/ext/DynaLoader/dl_vms.xs
+++ b/ext/DynaLoader/dl_vms.xs
@@ -263,7 +263,7 @@ dl_load_file(filespec, flags)
dlptr->name.dsc$w_length = namlst[0].len;
dlptr->name.dsc$a_pointer = savepvn(namlst[0].string,namlst[0].len);
dlptr->defspec.dsc$w_length = specdsc.dsc$w_length - namlst[0].len;
- dlptr->defspec.dsc$a_pointer = safemalloc(dlptr->defspec.dsc$w_length + 1);
+ New(1097, dlptr->defspec.dsc$a_pointer, dlptr->defspec.dsc$w_length + 1, char);
deflen = namlst[0].string - specdsc.dsc$a_pointer;
memcpy(dlptr->defspec.dsc$a_pointer,specdsc.dsc$a_pointer,deflen);
memcpy(dlptr->defspec.dsc$a_pointer + deflen,
diff --git a/ext/Opcode/Opcode.xs b/ext/Opcode/Opcode.xs
index 31e734a26c..cf5c859395 100644
--- a/ext/Opcode/Opcode.xs
+++ b/ext/Opcode/Opcode.xs
@@ -111,7 +111,7 @@ new_opset(SV *old_opset)
opset = newSVsv(old_opset);
}
else {
- opset = newSV(opset_len);
+ opset = NEWSV(1156, opset_len);
Zero(SvPVX(opset), opset_len + 1, char);
SvCUR_set(opset, opset_len);
(void)SvPOK_only(opset);
diff --git a/handy.h b/handy.h
index de3028f121..51824f3180 100644
--- a/handy.h
+++ b/handy.h
@@ -244,7 +244,10 @@ typedef U16 line_t;
#define NOLINE ((line_t) 65535)
#endif
-/* XXX LEAKTEST doesn't really work in perl5. There are direct calls to
+
+/* This looks obsolete (IZ):
+
+ XXX LEAKTEST doesn't really work in perl5. There are direct calls to
safemalloc() in the source, so LEAKTEST won't pick them up.
Further, if you try LEAKTEST, you'll also end up calling
Safefree, which might call safexfree() on some things that weren't
@@ -278,12 +281,16 @@ typedef U16 line_t;
(v = (t*)safexrealloc((Malloc_t)(v),(MEM_SIZE)((n)*sizeof(t))))
#define Renewc(v,n,t,c) \
(v = (c*)safexrealloc((Malloc_t)(v),(MEM_SIZE)((n)*sizeof(t))))
-#define Safefree(d) safexfree((Malloc_t)d)
+#define Safefree(d) safexfree((Malloc_t)(d))
#define NEWSV(x,len) newSV(x,len)
#define MAXXCOUNT 1400
-long xcount[MAXXCOUNT];
-long lastxcount[MAXXCOUNT];
+#define MAXY_SIZE 80
+#define MAXYCOUNT 16 /* (MAXY_SIZE/4 + 1) */
+extern long xcount[MAXXCOUNT];
+extern long lastxcount[MAXXCOUNT];
+extern long xycount[MAXXCOUNT][MAXYCOUNT];
+extern long lastxycount[MAXXCOUNT][MAXYCOUNT];
#endif /* LEAKTEST */
diff --git a/hv.c b/hv.c
index 25f14220fb..cd410eb1af 100644
--- a/hv.c
+++ b/hv.c
@@ -43,7 +43,7 @@ more_he(void)
{
register HE* he;
register HE* heend;
- he_root = (HE*)safemalloc(1008);
+ New(54, he_root, 1008/sizeof(HE), HE);
he = he_root;
heend = &he[1008 / sizeof(HE) - 1];
while (he < heend) {
diff --git a/perl.c b/perl.c
index 1fa23195df..fd25ebb03e 100644
--- a/perl.c
+++ b/perl.c
@@ -2699,7 +2699,7 @@ incpush(char *p, int addsubdirs)
return;
if (addsubdirs) {
- subdir = newSV(0);
+ subdir = NEWSV(55,0);
if (!archpat_auto) {
STRLEN len = (sizeof(ARCHNAME) + strlen(patchlevel)
+ sizeof("//auto"));
@@ -2715,7 +2715,7 @@ incpush(char *p, int addsubdirs)
/* Break at all separators */
while (p && *p) {
- SV *libdir = newSV(0);
+ SV *libdir = NEWSV(55,0);
char *s;
/* skip any consecutive separators */
diff --git a/perly.c b/perly.c
index bd6bf8424a..063515ee03 100644
--- a/perly.c
+++ b/perly.c
@@ -1334,7 +1334,9 @@ yyparse(void)
#endif
#endif
- struct ysv *ysave = (struct ysv*)safemalloc(sizeof(struct ysv));
+ struct ysv *ysave;
+
+ New(73, ysave, 1, struct ysv);
SAVEDESTRUCTOR(yydestruct, ysave);
ysave->oldyydebug = yydebug;
ysave->oldyynerrs = yynerrs;
@@ -1359,8 +1361,10 @@ yyparse(void)
/*
** Initialize private stacks (yyparse may be called from an action)
*/
- ysave->yyss = yyss = (short*)safemalloc(yystacksize*sizeof(short));
- ysave->yyvs = yyvs = (YYSTYPE*)safemalloc(yystacksize*sizeof(YYSTYPE));
+ New(73, yyss, yystacksize, short);
+ New(73, yyvs, yystacksize, YYSTYPE);
+ ysave->yyss = yyss;
+ ysave->yyvs = yyvs;
if (!yyvs || !yyss)
goto yyoverflow;
diff --git a/perly.c.diff b/perly.c.diff
index e13b04bd8c..69555cf2e0 100644
--- a/perly.c.diff
+++ b/perly.c.diff
@@ -105,7 +105,7 @@ Index: perly.c
if (yys = getenv("YYDEBUG"))
{
---- 1291,1348 ----
+--- 1291,1349 ----
#define YYACCEPT goto yyaccept
#define YYERROR goto yyerrlab
+
@@ -152,7 +152,8 @@ Index: perly.c
+ #endif
+ #endif
+
-+ struct ysv *ysave = (struct ysv*)safemalloc(sizeof(struct ysv));
++ struct ysv *ysave;
++ New(73, ysave, 1, struct ysv);
+ SAVEDESTRUCTOR(yydestruct, ysave);
+ ysave->oldyydebug = yydebug;
+ ysave->oldyynerrs = yynerrs;
@@ -166,14 +167,16 @@ Index: perly.c
{
***************
*** 1381,1384 ****
---- 1357,1368 ----
+--- 1357,1370 ----
yychar = (-1);
+ /*
+ ** Initialize private stacks (yyparse may be called from an action)
+ */
-+ ysave->yyss = yyss = (short*)safemalloc(yystacksize*sizeof(short));
-+ ysave->yyvs = yyvs = (YYSTYPE*)safemalloc(yystacksize*sizeof(YYSTYPE));
++ New(73, yyss, yystacksize, short);
++ New(73, yyvs, yystacksize, YYSTYPE);
++ ysave->yyss = yyss;
++ ysave->yyvs = yyvs;
+ if (!yyvs || !yyss)
+ goto yyoverflow;
+
diff --git a/perly.fixer b/perly.fixer
index 156881657f..951da0078f 100755
--- a/perly.fixer
+++ b/perly.fixer
@@ -105,8 +105,8 @@ short *maxyyps;
/yypv *= *&yyv\[ *-1 *\];/c\
\ if (!yyv) {\
-\ yyv = (YYSTYPE*) safemalloc(yymaxdepth * sizeof(YYSTYPE));\
-\ yys = (short*) safemalloc(yymaxdepth * sizeof(short));\
+\ New(73, yyv, yymaxdepth, YYSTYPE);\
+\ New(73, yys, yymaxdepth, short);\
\ if ( !yyv || !yys ) {\
\ yyerror( "out of memory" );\
\ return(1);\
@@ -123,10 +123,8 @@ short *maxyyps;
\ int ts = yyps - yys;\
\
\ yymaxdepth *= 2;\
-\ yyv = (YYSTYPE*)realloc((char*)yyv,\
-\ yymaxdepth*sizeof(YYSTYPE));\
-\ yys = (short*)realloc((char*)yys,\
-\ yymaxdepth*sizeof(short));\
+\ Renew(yyv, yymaxdepth, YYSTYPE);\
+\ Renew(yys, yymaxdepth, short);\
\ if ( !yyv || !yys ) {\
\ yyerror( "yacc stack overflow" );\
\ return(1);\
@@ -170,8 +168,8 @@ int *maxyyps;
/yypv *= *&yyv\[ *-1 *\];/c\
\ if (!yyv) {\
-\ yyv = (YYSTYPE*) safemalloc(yymaxdepth * sizeof(YYSTYPE));\
-\ yys = (int*) safemalloc(yymaxdepth * sizeof(int));\
+\ New(73, yyv, yymaxdepth, YYSTYPE);\
+\ New(73, yys, yymaxdepth, int);\
\ maxyyps = &yys[yymaxdepth];\
\ }\
\ yyps = &yys[-1];\
@@ -183,10 +181,8 @@ int *maxyyps;
\ int ts = yy_ps - yys;\
\
\ yymaxdepth *= 2;\
-\ yyv = (YYSTYPE*)realloc((char*)yyv,\
-\ yymaxdepth*sizeof(YYSTYPE));\
-\ yys = (int*)realloc((char*)yys,\
-\ yymaxdepth*sizeof(int));\
+\ Renew(yyv, yymaxdepth, YYSTYPE);\
+\ Renew(yys, yymaxdepth, int);\
\ yy_ps = yyps = yys + ts;\
\ yy_pv = yypv = yyv + tv;\
\ maxyyps = &yys[yymaxdepth];\
diff --git a/pod/perlembed.pod b/pod/perlembed.pod
index c43ed556aa..e7164b58f9 100644
--- a/pod/perlembed.pod
+++ b/pod/perlembed.pod
@@ -392,7 +392,7 @@ been wrapped here):
I32 match(SV *string, char *pattern)
{
- SV *command = newSV(0), *retval;
+ SV *command = NEWSV(1099, 0), *retval;
sv_setpvf(command, "my $string = '%s'; $string =~ %s",
SvPV(string,na), pattern);
@@ -413,7 +413,7 @@ been wrapped here):
I32 substitute(SV **string, char *pattern)
{
- SV *command = newSV(0), *retval;
+ SV *command = NEWSV(1099, 0), *retval;
sv_setpvf(command, "$string = '%s'; ($string =~ %s)",
SvPV(*string,na), pattern);
@@ -435,7 +435,7 @@ been wrapped here):
I32 matches(SV *string, char *pattern, AV **match_list)
{
- SV *command = newSV(0);
+ SV *command = NEWSV(1099, 0);
I32 num_matches;
sv_setpvf(command, "my $string = '%s'; @array = ($string =~ %s)",
@@ -456,7 +456,7 @@ been wrapped here):
char *embedding[] = { "", "-e", "0" };
AV *match_list;
I32 num_matches, i;
- SV *text = newSV(0);
+ SV *text = NEWSV(1099,0);
perl_construct(my_perl);
perl_parse(my_perl, NULL, 3, embedding, NULL);
diff --git a/pod/perlguts.pod b/pod/perlguts.pod
index 1db8249d24..4806815de4 100644
--- a/pod/perlguts.pod
+++ b/pod/perlguts.pod
@@ -2123,13 +2123,14 @@ SV is B<not> incremented.
SV* newRV_noinc _((SV* ref));
-=item newSV
+=item NEWSV
Creates a new SV. The C<len> parameter indicates the number of bytes of
preallocated string space the SV should have. The reference count for the
-new SV is set to 1.
+new SV is set to 1. C<id> is an integer id between 0 and 1299 (used to
+identify leaks).
- SV* newSV _((STRLEN len));
+ SV* NEWSV _((int id, STRLEN len));
=item newSViv
diff --git a/pod/perlrun.pod b/pod/perlrun.pod
index eccb5e00b7..01ad16783d 100644
--- a/pod/perlrun.pod
+++ b/pod/perlrun.pod
@@ -252,11 +252,15 @@ equivalent to B<-Dtls>):
512 r Regular expression parsing and execution
1024 x Syntax tree dump
2048 u Tainting checks
- 4096 L Memory leaks (not supported anymore)
+ 4096 L Memory leaks (needs C<-DLEAKTEST> when compiling Perl)
8192 H Hash dump -- usurps values()
16384 X Scratchpad allocation
32768 D Cleaning up
+All these flags require C<-DDEBUGGING> when you compile the Perl
+executable. This flag is automatically set if you include C<-g>
+option when C<Configure> asks you about optimizer/debugger flags.
+
=item B<-e> I<commandline>
may be used to enter one line of script.
diff --git a/pod/perltoc.pod b/pod/perltoc.pod
index 74b0029d73..91de608d6c 100644
--- a/pod/perltoc.pod
+++ b/pod/perltoc.pod
@@ -2420,7 +2420,7 @@ hv_iternext, hv_iternextsv, hv_iterval, hv_magic, HvNAME, hv_store,
hv_store_ent, hv_undef, isALNUM, isALPHA, isDIGIT, isLOWER, isSPACE,
isUPPER, items, ix, LEAVE, MARK, mg_clear, mg_copy, mg_find, mg_free,
mg_get, mg_len, mg_magical, mg_set, Move, na, New, Newc, Newz, newAV,
-newHV, newRV_inc, newRV_noinc, newSV, newSViv, newSVnv, newSVpv, newSVrv,
+newHV, newRV_inc, newRV_noinc, NEWSV, newSViv, newSVnv, newSVpv, newSVrv,
newSVsv, newXS, newXSproto, Nullav, Nullch, Nullcv, Nullhv, Nullsv,
ORIGMARK, perl_alloc, perl_call_argv, perl_call_method, perl_call_pv,
perl_call_sv, perl_construct, perl_destruct, perl_eval_sv, perl_eval_pv,
diff --git a/pp_hot.c b/pp_hot.c
index 6400d5f6eb..1815b66eb5 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -2288,7 +2288,7 @@ vivify_ref(SV *sv, U32 to_what)
}
switch (to_what) {
case OPpDEREF_SV:
- SvRV(sv) = newSV(0);
+ SvRV(sv) = NEWSV(355,0);
break;
case OPpDEREF_AV:
SvRV(sv) = (SV*)newAV();
diff --git a/sv.c b/sv.c
index 473d17ac15..c6041de8bd 100644
--- a/sv.c
+++ b/sv.c
@@ -111,8 +111,7 @@ SV* sv;
I32 oldsize = regsize;
regsize = regsize ? ((regsize << 2) + 1) : 2037;
- registry = (SV**)safemalloc(regsize * sizeof(SV*));
- memzero(registry, regsize * sizeof(SV*));
+ Newz(707, registry, regsize, SV*);
if (oldreg) {
I32 i;
@@ -416,7 +415,8 @@ more_xiv(void)
{
register IV** xiv;
register IV** xivend;
- XPV* ptr = (XPV*)safemalloc(1008);
+ XPV* ptr;
+ New(705, ptr, 1008/sizeof(XPV), XPV);
ptr->xpv_pv = (char*)xiv_arenaroot; /* linked list of xiv arenas */
xiv_arenaroot = ptr; /* to keep Purify happy */
@@ -457,7 +457,7 @@ more_xnv(void)
{
register double* xnv;
register double* xnvend;
- xnv = (double*)safemalloc(1008);
+ New(711, xnv, 1008/sizeof(double), double);
xnvend = &xnv[1008 / sizeof(double) - 1];
xnv += (sizeof(XPVIV) - 1) / sizeof(double) + 1; /* fudge by sizeof XPVIV */
xnv_root = xnv;
@@ -493,7 +493,7 @@ more_xrv(void)
{
register XRV* xrv;
register XRV* xrvend;
- xrv_root = (XRV*)safemalloc(1008);
+ New(712, xrv_root, 1008/sizeof(XRV), XRV);
xrv = xrv_root;
xrvend = &xrv[1008 / sizeof(XRV) - 1];
while (xrv < xrvend) {
@@ -528,7 +528,7 @@ more_xpv(void)
{
register XPV* xpv;
register XPV* xpvend;
- xpv_root = (XPV*)safemalloc(1008);
+ New(713, xpv_root, 1008/sizeof(XPV), XPV);
xpv = xpv_root;
xpvend = &xpv[1008 / sizeof(XPV) - 1];
while (xpv < xpvend) {
@@ -571,38 +571,53 @@ more_xpv(void)
#define del_XPV(p) del_xpv((XPV *)p)
#endif
-#define new_XPVIV() (void*)safemalloc(sizeof(XPVIV))
-#define del_XPVIV(p) Safefree((char*)p)
-
-#define new_XPVNV() (void*)safemalloc(sizeof(XPVNV))
-#define del_XPVNV(p) Safefree((char*)p)
-
-#define new_XPVMG() (void*)safemalloc(sizeof(XPVMG))
-#define del_XPVMG(p) Safefree((char*)p)
-
-#define new_XPVLV() (void*)safemalloc(sizeof(XPVLV))
-#define del_XPVLV(p) Safefree((char*)p)
-
-#define new_XPVAV() (void*)safemalloc(sizeof(XPVAV))
-#define del_XPVAV(p) Safefree((char*)p)
-
-#define new_XPVHV() (void*)safemalloc(sizeof(XPVHV))
-#define del_XPVHV(p) Safefree((char*)p)
-
-#define new_XPVCV() (void*)safemalloc(sizeof(XPVCV))
-#define del_XPVCV(p) Safefree((char*)p)
-
-#define new_XPVGV() (void*)safemalloc(sizeof(XPVGV))
-#define del_XPVGV(p) Safefree((char*)p)
-
-#define new_XPVBM() (void*)safemalloc(sizeof(XPVBM))
-#define del_XPVBM(p) Safefree((char*)p)
-
-#define new_XPVFM() (void*)safemalloc(sizeof(XPVFM))
-#define del_XPVFM(p) Safefree((char*)p)
-
-#define new_XPVIO() (void*)safemalloc(sizeof(XPVIO))
-#define del_XPVIO(p) Safefree((char*)p)
+#ifdef PURIFY
+# define my_safemalloc(s) safemalloc(s)
+# define my_safefree(s) free(s)
+#else
+static void*
+my_safemalloc(size)
+ MEM_SIZE size;
+{
+ char *p;
+ New(717, p, size, char);
+ return (void*)p;
+}
+# define my_safefree(s) Safefree(s)
+#endif
+
+#define new_XPVIV() (void*)my_safemalloc(sizeof(XPVIV))
+#define del_XPVIV(p) my_safefree((char*)p)
+
+#define new_XPVNV() (void*)my_safemalloc(sizeof(XPVNV))
+#define del_XPVNV(p) my_safefree((char*)p)
+
+#define new_XPVMG() (void*)my_safemalloc(sizeof(XPVMG))
+#define del_XPVMG(p) my_safefree((char*)p)
+
+#define new_XPVLV() (void*)my_safemalloc(sizeof(XPVLV))
+#define del_XPVLV(p) my_safefree((char*)p)
+
+#define new_XPVAV() (void*)my_safemalloc(sizeof(XPVAV))
+#define del_XPVAV(p) my_safefree((char*)p)
+
+#define new_XPVHV() (void*)my_safemalloc(sizeof(XPVHV))
+#define del_XPVHV(p) my_safefree((char*)p)
+
+#define new_XPVCV() (void*)my_safemalloc(sizeof(XPVCV))
+#define del_XPVCV(p) my_safefree((char*)p)
+
+#define new_XPVGV() (void*)my_safemalloc(sizeof(XPVGV))
+#define del_XPVGV(p) my_safefree((char*)p)
+
+#define new_XPVBM() (void*)my_safemalloc(sizeof(XPVBM))
+#define del_XPVBM(p) my_safefree((char*)p)
+
+#define new_XPVFM() (void*)my_safemalloc(sizeof(XPVFM))
+#define del_XPVFM(p) my_safefree((char*)p)
+
+#define new_XPVIO() (void*)my_safemalloc(sizeof(XPVIO))
+#define del_XPVIO(p) my_safefree((char*)p)
bool
sv_upgrade(register SV *sv, U32 mt)
@@ -2308,12 +2323,10 @@ sv_catpv(register SV *sv, register char *ptr)
SV *
#ifdef LEAKTEST
-newSV(x,len)
-I32 x;
+newSV(I32 x, STRLEN len)
#else
newSV(STRLEN len)
#endif
-
{
register SV *sv;
diff --git a/toke.c b/toke.c
index 589393aec8..f2a60e1c98 100644
--- a/toke.c
+++ b/toke.c
@@ -1121,7 +1121,7 @@ filter_add(filter_t funcp, SV *datasv)
if (!rsfp_filters)
rsfp_filters = newAV();
if (!datasv)
- datasv = newSV(0);
+ datasv = NEWSV(255,0);
if (!SvUPGRADE(datasv, SVt_PVIO))
die("Can't upgrade filter_add data to SVt_PVIO");
IoDIRP(datasv) = (DIR*)funcp; /* stash funcp into spare field */
diff --git a/util.c b/util.c
index dc0f4405d5..8d77adefe1 100644
--- a/util.c
+++ b/util.c
@@ -54,7 +54,13 @@
#define FLUSH
#ifdef LEAKTEST
-static void xstat _((void));
+
+static void xstat _((int));
+long xcount[MAXXCOUNT];
+long lastxcount[MAXXCOUNT];
+long xycount[MAXXCOUNT][MAXYCOUNT];
+long lastxycount[MAXXCOUNT][MAXYCOUNT];
+
#endif
#ifndef MYMALLOC
@@ -207,63 +213,141 @@ safecalloc(MEM_SIZE count, MEM_SIZE size)
#ifdef LEAKTEST
-#define ALIGN sizeof(long)
+struct mem_test_strut {
+ union {
+ long type;
+ char c[2];
+ } u;
+ long size;
+};
+
+# define ALIGN sizeof(struct mem_test_strut)
+
+# define sizeof_chunk(ch) (((struct mem_test_strut*) (ch))->size)
+# define typeof_chunk(ch) \
+ (((struct mem_test_strut*) (ch))->u.c[0] + ((struct mem_test_strut*) (ch))->u.c[1]*100)
+# define set_typeof_chunk(ch,t) \
+ (((struct mem_test_strut*) (ch))->u.c[0] = t % 100, ((struct mem_test_strut*) (ch))->u.c[1] = t / 100)
+#define SIZE_TO_Y(size) ( (size) > MAXY_SIZE \
+ ? MAXYCOUNT - 1 \
+ : ( (size) > 40 \
+ ? ((size) - 1)/8 + 5 \
+ : ((size) - 1)/4))
Malloc_t
safexmalloc(I32 x, MEM_SIZE size)
{
- register Malloc_t where;
+ register char* where = (char*)safemalloc(size + ALIGN);
- where = safemalloc(size + ALIGN);
- xcount[x]++;
- where[0] = x % 100;
- where[1] = x / 100;
- return where + ALIGN;
+ xcount[x] += size;
+ xycount[x][SIZE_TO_Y(size)]++;
+ set_typeof_chunk(where, x);
+ sizeof_chunk(where) = size;
+ return (Malloc_t)(where + ALIGN);
}
Malloc_t
-safexrealloc(Malloc_t where, MEM_SIZE size)
+safexrealloc(Malloc_t wh, MEM_SIZE size)
{
- register Malloc_t new = saferealloc(where - ALIGN, size + ALIGN);
- return new + ALIGN;
+ char *where = (char*)wh;
+
+ if (!wh)
+ return safexmalloc(0,size);
+
+ {
+ MEM_SIZE old = sizeof_chunk(where - ALIGN);
+ int t = typeof_chunk(where - ALIGN);
+ register char* new = (char*)saferealloc(where - ALIGN, size + ALIGN);
+
+ xycount[t][SIZE_TO_Y(old)]--;
+ xycount[t][SIZE_TO_Y(size)]++;
+ xcount[t] += size - old;
+ sizeof_chunk(new) = size;
+ return (Malloc_t)(new + ALIGN);
+ }
}
void
-safexfree(Malloc_t where)
+safexfree(Malloc_t wh)
{
I32 x;
-
+ char *where = (char*)wh;
+ MEM_SIZE size;
+
if (!where)
return;
where -= ALIGN;
+ size = sizeof_chunk(where);
x = where[0] + 100 * where[1];
- xcount[x]--;
+ xcount[x] -= size;
+ xycount[x][SIZE_TO_Y(size)]--;
safefree(where);
}
Malloc_t
safexcalloc(I32 x,MEM_SIZE count, MEM_SIZE size)
{
- register Malloc_t where;
-
- where = safexmalloc(x, size * count + ALIGN);
- xcount[x]++;
- memset((void*)where + ALIGN, 0, size * count);
- where[0] = x % 100;
- where[1] = x / 100;
- return where + ALIGN;
+ register char * where = (char*)safexmalloc(x, size * count + ALIGN);
+ xcount[x] += size;
+ xycount[x][SIZE_TO_Y(size)]++;
+ memset((void*)(where + ALIGN), 0, size * count);
+ set_typeof_chunk(where, x);
+ sizeof_chunk(where) = size;
+ return (Malloc_t)(where + ALIGN);
}
static void
-xstat(void)
+xstat(int flag)
{
- register I32 i;
+ register I32 i, j, total = 0;
+ I32 subtot[MAXYCOUNT];
+ for (j = 0; j < MAXYCOUNT; j++) {
+ subtot[j] = 0;
+ }
+
+ PerlIO_printf(PerlIO_stderr(), " Id subtot 4 8 12 16 20 24 28 32 36 40 48 56 64 72 80 80+\n", total);
for (i = 0; i < MAXXCOUNT; i++) {
- if (xcount[i] > lastxcount[i]) {
- PerlIO_printf(PerlIO_stderr(),"%2d %2d\t%ld\n", i / 100, i % 100, xcount[i]);
+ total += xcount[i];
+ for (j = 0; j < MAXYCOUNT; j++) {
+ subtot[j] += xycount[i][j];
+ }
+ if (flag == 0
+ ? xcount[i] /* Have something */
+ : (flag == 2
+ ? xcount[i] != lastxcount[i] /* Changed */
+ : xcount[i] > lastxcount[i])) { /* Growed */
+ PerlIO_printf(PerlIO_stderr(),"%2d %02d %7ld ", i / 100, i % 100,
+ flag == 2 ? xcount[i] - lastxcount[i] : xcount[i]);
lastxcount[i] = xcount[i];
+ for (j = 0; j < MAXYCOUNT; j++) {
+ if ( flag == 0
+ ? xycount[i][j] /* Have something */
+ : (flag == 2
+ ? xycount[i][j] != lastxycount[i][j] /* Changed */
+ : xycount[i][j] > lastxycount[i][j])) { /* Growed */
+ PerlIO_printf(PerlIO_stderr(),"%3ld ",
+ flag == 2
+ ? xycount[i][j] - lastxycount[i][j]
+ : xycount[i][j]);
+ lastxycount[i][j] = xycount[i][j];
+ } else {
+ PerlIO_printf(PerlIO_stderr(), " . ", xycount[i][j]);
+ }
+ }
+ PerlIO_printf(PerlIO_stderr(), "\n");
+ }
+ }
+ if (flag != 2) {
+ PerlIO_printf(PerlIO_stderr(), "Total %7ld ", total);
+ for (j = 0; j < MAXYCOUNT; j++) {
+ if (subtot[j]) {
+ PerlIO_printf(PerlIO_stderr(), "%3ld ", subtot[j]);
+ } else {
+ PerlIO_printf(PerlIO_stderr(), " . ");
+ }
}
+ PerlIO_printf(PerlIO_stderr(), "\n");
}
}
@@ -1362,7 +1446,12 @@ warn(pat,va_alist)
}
PerlIO_puts(PerlIO_stderr(),message);
#ifdef LEAKTEST
- DEBUG_L(xstat());
+ DEBUG_L(*message == '!'
+ ? (xstat(message[1]=='!'
+ ? (message[2]=='!' ? 2 : 1)
+ : 0)
+ , 0)
+ : 0);
#endif
(void)PerlIO_flush(PerlIO_stderr());
}
diff --git a/vms/perly_c.vms b/vms/perly_c.vms
index 958fcd9371..80b1d08c32 100644
--- a/vms/perly_c.vms
+++ b/vms/perly_c.vms
@@ -1337,7 +1337,8 @@ yyparse(void)
#endif
#endif
- struct ysv *ysave = (struct ysv*)safemalloc(sizeof(struct ysv));
+ struct ysv *ysave;
+ New(73, ysave, 1, struct ysv);
SAVEDESTRUCTOR(yydestruct, ysave);
ysave->oldyydebug = yydebug;
ysave->oldyynerrs = yynerrs;
@@ -1363,8 +1364,10 @@ yyparse(void)
/*
** Initialize private stacks (yyparse may be called from an action)
*/
- ysave->yyss = yyss = (short*)safemalloc(yystacksize*sizeof(short));
- ysave->yyvs = yyvs = (YYSTYPE*)safemalloc(yystacksize*sizeof(YYSTYPE));
+ New(73, yyss, yystacksize, short);
+ New(73, yyvs, yystacksize, YYSTYPE);
+ ysave->yyss = yyss;
+ ysave->yyvs = yyvs;
if (!yyvs || !yyss)
goto yyoverflow;
diff --git a/x2p/hash.c b/x2p/hash.c
index 9f6bbe9015..f11f7dfc55 100644
--- a/x2p/hash.c
+++ b/x2p/hash.c
@@ -65,7 +65,7 @@ hstore(register HASH *tb, char *key, STR *val)
if (strNE(entry->hent_key,key)) /* is this it? */
continue;
/*NOSTRICT*/
- Safefree(entry->hent_val);
+ safefree(entry->hent_val);
entry->hent_val = val;
return TRUE;
}