From: Ilya Zakharevich Date: Fri, 9 Jan 1998 17:55:09 +0000 (-0500) Subject: Newer -DLEAKTEST patch X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=8c52afecd5252bed5ed8df3a63a6cd9affde4ab4;p=p5sagit%2Fp5-mst-13.2.git Newer -DLEAKTEST patch p4raw-id: //depot/perl@466 --- diff --git a/ext/DB_File/DB_File.xs b/ext/DB_File/DB_File.xs index f77757c..8f2eda1 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 92d14bc..e35c251 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 0329ebd..2ed718d 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 31e734a..cf5c859 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 de3028f..51824f3 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 25f1422..cd410eb 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 1fa2319..fd25ebb 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 bd6bf84..063515e 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 e13b04b..69555cf 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 1568816..951da00 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 c43ed55..e7164b5 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 1db8249..4806815 100644 --- a/pod/perlguts.pod +++ b/pod/perlguts.pod @@ -2123,13 +2123,14 @@ SV is B incremented. SV* newRV_noinc _((SV* ref)); -=item newSV +=item NEWSV Creates a new SV. The C 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 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 eccb5e0..01ad167 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 asks you about optimizer/debugger flags. + =item B<-e> I may be used to enter one line of script. diff --git a/pod/perltoc.pod b/pod/perltoc.pod index 74b0029..91de608 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 6400d5f..1815b66 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 473d17a..c6041de 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 589393a..f2a60e1 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 dc0f440..8d77ade 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 958fcd9..80b1d08 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 9f6bbe9..f11f7df 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; }