Willicious

Well, this is very strange. I went to try madExcept again today, and now the Level Select can't even be accessed: With madExcept disabled, the program runs fine and the memory leak is gone. Not sure what's happening here...

OK, so Anders' solution gets rid of the built-in resource leak dialog👍, but madExcept still gives us this:

Ah yes, I get it now. "Clear;" is called from Clone (as JonRobertson has also pointed out). But, it isn't in the call stack (not directly, anyway). So, (and this is possibly one of those noobish questions), without prior knowledge of where "Clear" is being called, how can the call stack be used to trace this by itself? If the answer is that it can't, that's of course fine - at least we know what we're looking for, so we can search for it initially and obtain the prior knowledge needed to interpret the call stack usefully. Got it. Thanks to you both for all the explanations of what's going on, it's made everything much clearer. I'll go ahead and implement Anders' suggested change and report back what happens.

Good shout. Here's the call stack up to the breakpoint: It's still not 100% clear how we got to the "Free" call, though... I've highlighted the most recent thing that isn't in System.Generics

OK... this is a bit of a can of worms. fPrimaryAnimation doesn't get freed, and PrimaryAnimation (property referring to fPrimaryAnimation) doesn't get freed. NewInstance and NewAnim also don't get freed. I honestly don't know where to start. The joys of working on someone else's code 🤨

Should it? Bear in mind I'm very new to fixing memory leaks: nothing is obvious to me. NewAnim doesn't appear to be freed anywhere. However, my attempts to free it have so far only led to program crashes, or the memory leak persisting. Here's TGadgetAnimation's destructor: destructor TGadgetAnimation.Destroy; begin Dec(fTempBitmapUsageCount); if (fTempBitmapUsageCount = 0) then fTempBitmap.Free; fTriggers.Free; fSourceImage.Free; fSourceImageMasked.Free; inherited; end; If I shift-click "inherited" here, we get this empty procedure, in System. So, I assume that either Delphi just somehow 'knows' what to do here, or it does nothing: destructor TObject.Destroy; begin end; TGadgetMetaAccessor doesn't have a destructor, but TGadgetMetaInfo does. Maybe (i.e. I very much don't know for sure) "Animations.Free" is responsible for dispensing with all created TGadgetAnimations: destructor TGadgetMetaInfo.Destroy; var i: Integer; begin for i := 0 to ALIGNMENT_COUNT-1 do begin fVariableInfo[i].Animations.Free; fInterfaces[i].Free; end; inherited; end; Shift-clicking "inherited" there leads to the same empty procedure in System. So yes, I'm as baffled as you are.

Here's the last 2 items in the call stack (I assume that only the most recent lines in the call stack are relevant?): procedure TGadgetAnimations.AddPrimary(aAnimation: TGadgetAnimation); begin Add(aAnimation); if fPrimaryAnimation <> nil then fPrimaryAnimation.fPrimary := false; <---------------------------------------- this is line 935 fPrimaryAnimation := aAnimation; aAnimation.fPrimary := true; end; procedure TGadgetAnimations.Clone(aSrc: TGadgetAnimations); var i: Integer; NewAnim: TGadgetAnimation; begin Clear; NewAnim := TGadgetAnimation.Create(aSrc.PrimaryAnimation.fMainObjectWidth, aSrc.PrimaryAnimation.fMainObjectHeight); NewAnim.Clone(aSrc.PrimaryAnimation); AddPrimary(NewAnim); <------------------------------------------------- this is line 949 for i := 0 to aSrc.Count-1 do begin if aSrc.Items[i].Primary then Continue; NewAnim := TGadgetAnimation.Create(aSrc.Items[i].fMainObjectWidth, aSrc.Items[i].fMainObjectHeight); NewAnim.Clone(aSrc.Items[i]); Add(NewAnim); end; SortByZIndex; end; This points to fPrimaryAnimation being the problem. Maybe this has already been freed and then not re-created for use here (best guess from what you've said)? Question is, which is the best action to take: 1) Free fPrimaryAnimation later 2) Re-create and re-free fPrimaryAnimation 3) Something else?

Thanks, I've given this a try. It crashed on attempting to load a level with Pickup skill objects. Here's the call stack: Does this give us any more clues as to what to target? Should I FreeAndNil everything in TGadgetAnimations just to be sure?

Here's the regular memory leak dialog:

Struggling to make sense of this one. I've found a resource which isn't being freed ("NewAnim", a TGadgetAnimation instance), but all attempts to free it result in either the program not running at all, or the resource leak persisting anyway: procedure TGadgetAnimation.Load(aCollection, aPiece: String; aSegment: TParserSection; aTheme: TNeoTheme); var BaseTrigger: TGadgetAnimationTrigger; LoadPath: String; S: String; NeedUpscale: Boolean; Bitmaps: TBitmaps; i: Integer; Info: TUpscaleInfo; begin Clear; fFrameCount := aSegment.LineNumeric['frames']; fName := UpperCase(aSegment.LineTrimString['name']); fColor := UpperCase(aSegment.LineTrimString['color']); if LeftStr(fName, 1) <> '*' then begin if GameParams.HighResolution then LoadPath := AppPath + SFStyles + aCollection + SFPiecesObjectsHighRes + aPiece else LoadPath := AppPath + SFStyles + aCollection + SFPiecesObjects + aPiece; if fName <> '' then LoadPath := LoadPath + '_' + fName; // For backwards-compatible or simply unnamed primaries LoadPath := LoadPath + '.png'; if GameParams.HighResolution and not FileExists(LoadPath) then begin LoadPath := AppPath + SFStyles + aCollection + SFPiecesObjects + aPiece; if fName <> '' then LoadPath := LoadPath + '_' + fName; // For backwards-compatible or simply unnamed primaries LoadPath := LoadPath + '.png'; NeedUpscale := true; end else NeedUpscale := false; fHorizontalStrip := aSegment.Line['horizontal_strip'] <> nil; TPngInterface.LoadPngFile(LoadPath, fSourceImage); if fHorizontalStrip then begin fWidth := fSourceImage.Width div fFrameCount; fHeight := fSourceImage.Height; end else begin fWidth := fSourceImage.Width; fHeight := fSourceImage.Height div fFrameCount; end; if NeedUpscale then begin Bitmaps := MakeFrameBitmaps(true); Info := PieceManager.GetUpscaleInfo(aCollection + ':' + aPiece, rkGadget); for i := 0 to Bitmaps.Count-1 do Upscale(Bitmaps[i], Info.Settings); CombineBitmaps(Bitmaps); end else if GameParams.HighResolution then begin fWidth := fWidth div 2; fHeight := fHeight div 2; end; end else begin fHorizontalStrip := false; if Lowercase(fName) = '*blank' then begin fWidth := aSegment.LineNumeric['WIDTH']; fHeight := aSegment.LineNumeric['HEIGHT']; // Preserve previously-loaded frame count. fSourceImage.SetSize(fWidth * ResMod, fHeight * ResMod * fFrameCount); fSourceImage.Clear(0); end else begin // Fallback behaviour. Could mean it's unrecognized, or handled elsewhere (eg. "*PICKUP"). fSourceImage.SetSize(ResMod, ResMod); fSourceImage.Clear(0); fFrameCount := 1; fWidth := 1; fHeight := 1; end; end; // Only set fPrimary by TGadgetAnimations if fPrimary and (aSegment.Line['z_index'] = nil) then fZIndex := 1 else fZIndex := aSegment.LineNumeric['z_index']; if Uppercase(aSegment.LineTrimString['initial_frame']) = 'RANDOM' then fStartFrameIndex := -1 else fStartFrameIndex := aSegment.LineNumeric['initial_frame']; if fPrimary then begin fMainObjectWidth := fWidth; fMainObjectHeight := fHeight; end; fOffsetX := aSegment.LineNumeric['offset_x']; fOffsetY := aSegment.LineNumeric['offset_y']; fCutTop := aSegment.LineNumeric['nine_slice_top']; fCutRight := aSegment.LineNumeric['nine_slice_right']; fCutBottom := aSegment.LineNumeric['nine_slice_bottom']; fCutLeft := aSegment.LineNumeric['nine_slice_left']; BaseTrigger := TGadgetAnimationTrigger.Create; S := Lowercase(aSegment.LineTrimString['state']); if (S = 'pause') then BaseTrigger.fState := gasPause else if (S = 'stop') then BaseTrigger.fState := gasStop else if (S = 'looptozero') then BaseTrigger.fState := gasLoopToZero else if (S = 'matchphysics') then BaseTrigger.fState := gasMatchPrimary else if (aSegment.Line['hide'] <> nil) then BaseTrigger.fState := gasPause else BaseTrigger.fState := gasPlay; if (aSegment.Line['hide'] = nil) then BaseTrigger.fVisible := true else BaseTrigger.fVisible := false; fTriggers.Add(BaseTrigger); if fPrimary then begin // Some properties are overridden/hardcoded for primary BaseTrigger.fState := gasPause; // Physics control the current frame BaseTrigger.fVisible := true; // Never hide the primary - if it's needed as an effect, make the graphic blank end else begin // If NOT primary - load triggers aSegment.DoForEachSection('trigger', procedure(aSec: TParserSection; const aCount: Integer) var NewTrigger: TGadgetAnimationTrigger; begin NewTrigger := TGadgetAnimationTrigger.Create; NewTrigger.Load(aSec); fTriggers.Add(NewTrigger); end ); end; fNeedRemask := true; fMaskColor := $FFFFFFFF; end; procedure TGadgetMetaInfo.Load(aCollection,aPiece: String; aTheme: TNeoTheme); var Parser: TParser; Sec: TParserSection; GadgetAccessor: TGadgetMetaAccessor; NewAnim: TGadgetAnimation; PrimaryWidth: Integer; begin fGS := Lowercase(aCollection); fPiece := Lowercase(aPiece); GadgetAccessor := GetInterface(false, false, false); Parser := TParser.Create; try ClearImages; if not DirectoryExists(AppPath + SFStyles + aCollection + SFPiecesObjects) then raise Exception.Create('TMetaObject.Load: Collection "' + aCollection + '" does not exist or does not have objects. (' + aPiece + ')'); SetCurrentDir(AppPath + SFStyles + aCollection + SFPiecesObjects); Parser.LoadFromFile(aPiece + '.nxmo'); Sec := Parser.MainSection; // Trigger effects if Lowercase(Sec.LineTrimString['effect']) = 'exit' then fTriggerEffect := DOM_EXIT; if Lowercase(Sec.LineTrimString['effect']) = 'forceleft' then fTriggerEffect := DOM_FORCELEFT; if Lowercase(Sec.LineTrimString['effect']) = 'forceright' then fTriggerEffect := DOM_FORCERIGHT; if Lowercase(Sec.LineTrimString['effect']) = 'trap' then fTriggerEffect := DOM_TRAP; if Lowercase(Sec.LineTrimString['effect']) = 'water' then fTriggerEffect := DOM_WATER; if Lowercase(Sec.LineTrimString['effect']) = 'fire' then fTriggerEffect := DOM_FIRE; if Lowercase(Sec.LineTrimString['effect']) = 'onewayleft' then fTriggerEffect := DOM_ONEWAYLEFT; if Lowercase(Sec.LineTrimString['effect']) = 'onewayright' then fTriggerEffect := DOM_ONEWAYRIGHT; if Lowercase(Sec.LineTrimString['effect']) = 'teleporter' then fTriggerEffect := DOM_TELEPORT; if Lowercase(Sec.LineTrimString['effect']) = 'receiver' then fTriggerEffect := DOM_RECEIVER; if Lowercase(Sec.LineTrimString['effect']) = 'pickupskill' then fTriggerEffect := DOM_PICKUP; if Lowercase(Sec.LineTrimString['effect']) = 'lockedexit' then fTriggerEffect := DOM_LOCKEXIT; if Lowercase(Sec.LineTrimString['effect']) = 'unlockbutton' then fTriggerEffect := DOM_BUTTON; if Lowercase(Sec.LineTrimString['effect']) = 'collectible' then fTriggerEffect := DOM_COLLECTIBLE; if Lowercase(Sec.LineTrimString['effect']) = 'onewaydown' then fTriggerEffect := DOM_ONEWAYDOWN; if Lowercase(Sec.LineTrimString['effect']) = 'updraft' then fTriggerEffect := DOM_UPDRAFT; if Lowercase(Sec.LineTrimString['effect']) = 'splitter' then fTriggerEffect := DOM_SPLITTER; if Lowercase(Sec.LineTrimString['effect']) = 'entrance' then fTriggerEffect := DOM_WINDOW; if Lowercase(Sec.LineTrimString['effect']) = 'antisplatpad' then fTriggerEffect := DOM_NOSPLAT; if Lowercase(Sec.LineTrimString['effect']) = 'splatpad' then fTriggerEffect := DOM_SPLAT; if Lowercase(Sec.LineTrimString['effect']) = 'decoration' then fTriggerEffect := DOM_DECORATION; if Lowercase(Sec.LineTrimString['effect']) = 'traponce' then fTriggerEffect := DOM_TRAPONCE; if Lowercase(Sec.LineTrimString['effect']) = 'onewayup' then fTriggerEffect := DOM_ONEWAYUP; if Lowercase(Sec.LineTrimString['effect']) = 'animation' then fTriggerEffect := DOM_ANIMATION; if Lowercase(Sec.LineTrimString['effect']) = 'animationonce' then fTriggerEffect := DOM_ANIMONCE; if Lowercase(Sec.LineTrimString['effect']) = 'blasticine' then fTriggerEffect := DOM_BLASTICINE; if Lowercase(Sec.LineTrimString['effect']) = 'vinewater' then fTriggerEffect := DOM_VINEWATER; if Lowercase(Sec.LineTrimString['effect']) = 'poison' then fTriggerEffect := DOM_POISON; if Lowercase(Sec.LineTrimString['effect']) = 'lava' then fTriggerEffect := DOM_LAVA; if Lowercase(Sec.LineTrimString['effect']) = 'radiation' then fTriggerEffect := DOM_RADIATION; if Lowercase(Sec.LineTrimString['effect']) = 'slowfreeze' then fTriggerEffect := DOM_SLOWFREEZE; if (Lowercase(Sec.LineTrimString['effect']) = 'decoration') or (Lowercase(Sec.LineTrimString['effect']) = 'paint') then fTriggerEffect := DOM_DECORATION; if Sec.Section['PRIMARY_ANIMATION'] = nil then begin if LastWarningStyle <> fGS then begin ShowMessage('Gadget ' + fGS + ':' + fPiece + ' is in pre-12.7 format. Please update your copy of this style, or if up to date, ask the style creator to fix.'); LastWarningStyle := fGS; end; raise Exception.Create('Gadget ' + fGS + ':' + fPiece + ' is in pre-12.7 format. Please update your copy of this style, or if up to date, ask the style creator to fix.'); end; NewAnim := TGadgetAnimation.Create(0, 0); GadgetAccessor.Animations.AddPrimary(NewAnim); NewAnim.Load(aCollection, aPiece, Sec.Section['PRIMARY_ANIMATION'], aTheme); fFrameCount := NewAnim.FrameCount; PrimaryWidth := NewAnim.Width; // Used later Sec.DoForEachSection('ANIMATION', procedure (aSection: TParserSection; const aIteration: Integer) begin NewAnim := TGadgetAnimation.Create(GadgetAccessor.Animations.PrimaryAnimation.Width, GadgetAccessor.Animations.PrimaryAnimation.Height); GadgetAccessor.Animations.Add(NewAnim); NewAnim.Load(aCollection, aPiece, aSection, aTheme); end ); GadgetAccessor.Animations.SortByZIndex; GadgetAccessor.TriggerLeft := Sec.LineNumeric['trigger_x']; GadgetAccessor.TriggerTop := Sec.LineNumeric['trigger_y']; GadgetAccessor.TriggerWidth := Sec.LineNumeric['trigger_width']; GadgetAccessor.TriggerHeight := Sec.LineNumeric['trigger_height']; GadgetAccessor.DefaultWidth := Sec.LineNumeric['default_width']; GadgetAccessor.DefaultHeight := Sec.LineNumeric['default_height']; GadgetAccessor.DigitX := Sec.LineNumericDefault['digit_x', PrimaryWidth div 2]; GadgetAccessor.DigitY := Sec.LineNumericDefault['digit_y', -6]; GadgetAccessor.ExitMarkerX := Sec.LineNumeric['exit_marker_x']; GadgetAccessor.ExitMarkerY := Sec.LineNumeric['exit_marker_y']; if LeftStr(Lowercase(Sec.LineTrimString['digit_alignment']), 1) = 'l' then GadgetAccessor.DigitAlign := -1 else if LeftStr(Lowercase(Sec.LineTrimString['digit_alignment']), 1) = 'r' then GadgetAccessor.DigitAlign := 1 else GadgetAccessor.DigitAlign := 0; fDigitMinLength := Sec.LineNumericDefault['digit_length', 1]; if Sec.Line['sound_activate'] = nil then fSoundActivate := Sec.LineTrimString['sound'] else fSoundActivate := Sec.LineTrimString['sound_activate']; fSoundExhaust := Sec.LineTrimString['sound_exhaust']; fKeyFrame := Sec.LineNumeric['key_frame']; // This is almost purely a physics property, so should not go under animations if Sec.Line['resize_both'] <> nil then begin GadgetAccessor.CanResizeHorizontal := true; GadgetAccessor.CanResizeVertical := true; end else begin GadgetAccessor.CanResizeHorizontal := Sec.Line['resize_horizontal'] <> nil; GadgetAccessor.CanResizeVertical := Sec.Line['resize_vertical'] <> nil; end; if fTriggerEffect in [DOM_NONE, DOM_DECORATION] then // No trigger area begin GadgetAccessor.TriggerWidth := 0; GadgetAccessor.TriggerHeight := 0; end; if fTriggerEffect in [DOM_RECEIVER, DOM_WINDOW] then // Trigger point only begin GadgetAccessor.TriggerWidth := 1; GadgetAccessor.TriggerHeight := 1; end; finally Parser.Free; end; end;

Thanks for this. I'll give it a try - should come in handy for future memory leaks. Can it also be used for overflow/range checking as well?

@Anders Melander Thanks for the advice, I installed madExcept again and it generated the following leak report: The problem was in TRenderer.DrawProjectileShadow (shown in the call stack), in which an instance of TProjectile was being created and not freed. I've now fixed this. madExcept is super useful then, no doubt. I did however uninstall it again after use because I noticed significant lag when running SLX with it enabled, and it also caused some access violation error dialogs to popup. I wonder whether this may be because I installed a newer version of madExcept which is intended to work with Delphi 12 and I'm still on Delphi 10.4 - It might be worth trying a previous version next time; the dev leaves all versions up on the site, helpfully.

Got one more memory leak that's showed up and I'd like to have a go at fixing it myself. It's narrowed down to being a problem with TProjectile, which doesn't have a destructor. However, I implemented a destructor and this doesn't fix the memory leak, so... more investigation needed. I'm having some problems getting FastMM set up. Managed all but one step: I tried running the program anyway and as far as I can tell, nothing happens. Does it open a dialog or spit out a text file? Or something else?

Thanks 🙂

Replying again because I forgot to notify