diff options
| -rw-r--r-- | ext/DB_File/DB_File.xs | 7 | ||||
| -rw-r--r-- | ext/DynaLoader/dl_next.xs | 6 | ||||
| -rw-r--r-- | ext/DynaLoader/dl_vms.xs | 2 | ||||
| -rw-r--r-- | ext/Opcode/Opcode.xs | 2 | ||||
| -rw-r--r-- | handy.h | 15 | ||||
| -rw-r--r-- | hv.c | 2 | ||||
| -rw-r--r-- | perl.c | 4 | ||||
| -rw-r--r-- | perly.c | 10 | ||||
| -rw-r--r-- | perly.c.diff | 13 | ||||
| -rwxr-xr-x | perly.fixer | 20 | ||||
| -rw-r--r-- | pod/perlembed.pod | 8 | ||||
| -rw-r--r-- | pod/perlguts.pod | 7 | ||||
| -rw-r--r-- | pod/perlrun.pod | 6 | ||||
| -rw-r--r-- | pod/perltoc.pod | 2 | ||||
| -rw-r--r-- | pp_hot.c | 2 | ||||
| -rw-r--r-- | sv.c | 95 | ||||
| -rw-r--r-- | toke.c | 2 | ||||
| -rw-r--r-- | util.c | 143 | ||||
| -rw-r--r-- | vms/perly_c.vms | 9 | ||||
| -rw-r--r-- | x2p/hash.c | 2 |
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); @@ -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 */ @@ -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) { @@ -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 */ @@ -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, @@ -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(); @@ -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; @@ -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 */ @@ -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; } |