home *** CD-ROM | disk | FTP | other *** search
/ QuickTime 2.0 Developer Kit / QuickTime 2.0 Developer Kit.iso / mac / MAC / Programming Stuff / Macintosh Debugging / Leaks / Leaks.p < prev    next >
Encoding:
Text File  |  1991-09-12  |  56.6 KB  |  1,169 lines  |  [TEXT/MPS ]
  1. { Leaks:
  2.     a dcmd to display potential memory leaks.
  3.     
  4.     Copyright © 1990-91 by Apple Computer, Inc., all rights reserved.
  5.  
  6.     by     Bo3b Johnson        10/9/90
  7.             MS 37-DS
  8.             
  9.             5/23/91: Cleaned up comments a bit.
  10.                 Changed number of blocks to watch back to 500 to use less RAM.
  11.                 Bumped it to Version 5, as a new release.
  12.                 
  13.     for best viewing, use Palatino 12.
  14. }
  15.  
  16. UNIT Leaks;
  17.  
  18. (* 
  19.         Build this dude using the Build Menu, it has a make file.
  20.  
  21.         
  22.         This dcmd is a leak detector, intended to help you find memory leaks from programs
  23.         that are orphaning handles or pointers in the heap.  It is a non-deterministic problem
  24.         to try to find leaks, so I do a funky thing:  You have to run the operation you are 
  25.         checking 3 times.  Then, this dcmd will look for 3 blocks of the same size, allocated
  26.         from the same code, and will display a stack crawl for that purported leak.  Needless
  27.         to say, this is not bulletproof.  The human running this command is expected to check
  28.         things out further to see if it is a real leak or not.  
  29.  
  30.         I do this weirdness by patching NewHandle/DisposHandle, NewPtr/DisposPtr.
  31.         I watch pointers/handles going by when they are allocated and disposed, and save their
  32.         addresses off in a b-tree inside a big-ass block in the system heap.   I use a b-tree so the
  33.         machine has no perceptible loss of speed even though I've patched several often used traps.
  34.         When a DisposX goes by, I mark the address off my list, since it was validly disposed.  
  35.         When this dcmd comes in, it looks through the b-tree for entries still in it, and 
  36.         dumps out info about each element that is still in the tree; with the constraints that the 
  37.         block size has to be the same for three or more blocks, and they have to have the same
  38.         stack crawl.
  39.         
  40.         One dangerous aspect of this code is that most of it is recursive.  The reason of course is
  41.         that I use a b-tree to track the information about each of the blocks I see go by.  The use
  42.         of a b-tree is the only way to do this because otherwise the system will slow down
  43.         radically if this code were to use something lame like a linear list.  This way, there is 
  44.         no appreciable hit on the speed of the computer, even if I am tracking several thousand
  45.         blocks.  This is hip.  The problem of course is that b-trees lend themselves really, really
  46.         nicely to recursive routines to drive the data structure.  With Macsbug having a gutless
  47.         1K stack, this is of course fairly dangerous.  I thus go out of my way to make sure that
  48.         I pass the minimum number of parameters during a recursive operation.  This is
  49.         typically a 4 byte pointer to an element.  It is not strictly a requirement that I have to
  50.         do it recursively, it just makes the code smaller and easier to understand.  
  51.         
  52.         One thing that isn't clear, is whether local strings, used for display, will burn up stack
  53.         space.  I think they don't but if they do, they could maybe be made global instead.  It is
  54.         also unclear whether globals subtract from stack space as well, or whether you get 1K
  55.         of stack, regardless of the number of globals.  I've mostly presumed that is true, that
  56.         there is a fixed stack, after globals are allocated.  With that in mind, I've minimized
  57.         all the local variables used by the routines, as well as the parameters passed in.  This
  58.         has resulted in a number of globals, but there's always a tradeoff.
  59.         
  60.         Stack operations are alleviated a little bit since the dcmd can have global variables.
  61.         This makes it possible to avoid having to pass in some parameters that are the same
  62.         each time, at the expense of being less maintainable.  This code is pretty small though,
  63.         so it's worth it.
  64.  
  65.         Since this is a dcmd, I try to avoid using the toolbox as much as possible.  This means
  66.         avoiding things like StringtoNum, and UprCase, even though I could have used some    
  67.         of these things.  Any use of the toolbox is probably bad, since I can't be sure the heap is in
  68.         a consistent shape when dumping info.  The exception to this, is that at startup I want
  69.         to allocate a big block to store the records (elements) that save info about each block seen.
  70.         After that first allocation, I avoid using the toolbox as much as possible.  In fact, as far
  71.         as I know at this point, I don't use any toolbox calls, except during the init of the dcmd,
  72.         and when the tree is being dumped I use RsrcMapEntry to determine if some handle
  73.         I've got is a resource or not.   This won't allocate memory.
  74.  
  75.         Macsbug calls the dcmd at Init time, which is when Macsbug is loaded, early in boot.  
  76.         At that point, I create and save the buffer that is used to store the b-tree records that
  77.         track each block allocated in the system.  Since I have global variables, I use one of
  78.         those to save off the address of the block created, so I can get back to it at will.  This
  79.         global is saved in the dcmd apparently, which is great, since it makes it possible to
  80.         get back to the block without having to do something sick, like patch Chain which    
  81.         is what I was doing.  A marked improvement.
  82.         
  83.         I'm using RsrcMapEntry to drive the resource map for me, trying to match an address
  84.         to a possible resource.  If the handle in question is a resource, then it cannot be a leak
  85.         since the resource manager is still using the handle.  This allows me to avoid a few
  86.         false alarms, for blocks that are the same size, and stack crawl, allocated from the 
  87.         resource manager.  This is also a danger zone in this code.  I cannot guarantee that
  88.         the routine won't get called at interrupt time, and if it is, then the rsrcmaphandle
  89.         may not be correct when this guy tries to use it.  How big a problem is this?  It is 
  90.         something to note anyway.
  91.         
  92.         Another thing it should probably do is to watch for applications going away and mark
  93.         all the blocks in their heap out of the list.  Right now if you launch an app twice in a row
  94.         with it turned on, you'll get a b-tree fried error, which is caused because a block with
  95.         the same address is being added to the tree, and this should never happen for blocks
  96.         that are actively in use.  The b-tree check routine notices that blocks got added to the
  97.         list, and will flag it.  You only get the error message when the tree status is checked,
  98.         which is any time it is invoked in Macsbug.
  99.         
  100.         The analysis routine is seriously way slow when it has a big tree to check, since it is
  101.         an N-squared problem.  It is likely that there is a more optimal way, but I wanted 
  102.         something sooner instead of later.
  103.  
  104.         Notably this is a sick thing.  This whole dcmd is a heuristic way of finding memory 
  105.         leaks, and as such it may not work properly in all cases.  I am very interested to know
  106.         of cases where it fails, either by being too strict and reporting false leaks, and also where
  107.         it might be filtering too much data, and not showing a leak when there actually is one.
  108.         If you see any of these cases, let me know, and I'll try to fix it.  The problem of course is
  109.         that the Macintosh memory management is pretty funky and it is unlikely that there
  110.         is a completely solid way of doing this type of function.  Is this why it hasn't been done
  111.         before?  Probably.  As an example of the problem, think about trying to differentiate 
  112.         between a persistent block (something allocated early on in an application, like CODE 1)
  113.         and a genuine leak.  The CODE 1 handle will be around for ever, but it is not a leak, since
  114.         it is not multiplying.  Now, how do you find a block that is allocated during an application's
  115.         init time that actually is a leak, but only happens once?  How can you tell the difference?
  116.         Notably, I can't see that case here either (but don't really care, since it loses a chunk of
  117.         memory that is wasted, but won't crash things long term).
  118.         I believe the system runs in a very heuristic fashion, so the tools must do so as well.
  119.         This tool should still be quite useful, even though it is not 100% solid.  This is the
  120.         often maligned 90% solution.   I'm betting you'll like it better than the nonexistent
  121.         100% solution.
  122.         
  123.         I implement a memory based b-tree, to watch memory manager blocks.  
  124.         This is done in pascal so as to make it easier to maintain.  
  125.         The basic idea here is that this is the code to manage the big block in low memory
  126.         as a set of records (TrackingTableEntry), where each entry is part of a b-tree.  If a 
  127.         a record is not in use, it is in a linked list of empty records, starting with pEmptyQ
  128.         as the pointer to the first one.  The pTreeTop is a pointer to the first TrackingTableEntry,
  129.         which is the head of a b-tree of these records.  Each record keeps track of a single
  130.         memory manager block in any heap in the system, via the address field.  This code
  131.         isolates the b-tree management stuff from the skanky assembly junk required to
  132.         patch the traps effectively. 
  133.         
  134.         Note that this isn't the most mondo b-tree code ever made.  It is a very simple, easy
  135.         to implement couple of routines, but I get the advantages of b-trees anyway.  In 
  136.         particular, it is not a balanced tree, and makes no effort to do so.  I presume that the
  137.         addresses that are being watched (which are the sort keys), will be fairly random, so
  138.         that the tree will not become seriously overbalanced.  This is reasonable, but in some
  139.         cases I see the tree become overbalanced, depending upon how memory is allocated.
  140.         In any case, the tree never really gets more than about 10-15 levels deep which is still
  141.         two orders of magnitude better than a linear search of the same 1000 or so blocks.  Just
  142.         don't scam this b-tree code assuming that it is rad.  It isn't, but it works for something
  143.         simple like this.  Course you could ask, why is there simple b-tree code here, in this
  144.         trivial tool, but not in the resource manager?  Well, you may well ask.  (one reason is
  145.         that the resource manager allows random sized data, but I will still ask).
  146.         
  147.         Ughh.  I added some dcmdDrawLines here, instead of DebugStr, in the rare case when
  148.         the b-tree may get blown up.  This check is done whenever it is turned on or off, just
  149.         as a consistency check and to be sure the tree is still set up properly and not giving
  150.         bogus info.  This routine will thus run at dcmd time, and if you DebugStr there, it
  151.         will blow away Macsbug giving a 'macsbug caused the exception' error.  Sick.  So I
  152.         changed it to be dcmdDrawLines instead, even though I really want to keep these
  153.         routines from having to know they are part of a dcmd.  I'll think about it.
  154.  
  155.         A couple of things are apparent after using it for awhile.  The b-tree is very unbalanced
  156.         during some use, since the memory manager does a roving up allocation, so the addresses
  157.         tend to be increasing as added, giving an unbalanced tree.  This is OK, but turns the tree
  158.         into a linear list instead.  It actually isn't too bad, so it may not be worth changing, but
  159.         it is worth noting.  If you allocate a lot of blocks, it is possible to get into a bogus tree.
  160.         This almost always happens during an application launch.  For the system heap, memory
  161.         tends to be pretty random, as I want it.  If I'm tracking several hundred blocks in an
  162.         app, it is likely the tree is not balanced, so it will be slower than desired.  Most leak
  163.         check operations are looking in the 10-50 block range, so it's no big deal.
  164.         
  165.         Something I found out about is that Macsbug Init time is before the system file has 
  166.         been used to patch the traps to fix bugs in the ROM.  That means that any trap patches
  167.         I make here are fine, including tail patches.  Tail patches are OK at this point because
  168.         the system hasn't been patched yet, so we won't disable any bug fixes.  Yeah.  
  169.         With TMon Pro loading at Init time instead, this is still a problem, so think about it.
  170.         
  171.         This also causes a fair number of stack overflows in Macsbug.  This doesn't cause any
  172.         crashes, but will trash Macsbug's copy of the screen, so you end up with smashed bits
  173.         on the screen, after leaks does it's analysis.  I need to figure out some way to minimize
  174.         the stack usage during searching, since the tiny Macsbug stack is obviously insufficient.
  175.  
  176.         The options are: Leaks [On|Off|Dump]
  177.             If you just do Leaks by itself, it will dump the potential leaks in the tree as it exists at that
  178.             point, without changing the on/off state.  This may be helpful for in between tests, but
  179.             is mainly to allow you to get info without having to type the whole thing.  This is
  180.             essentially the same as Leaks Off, but it won't change the watching state. 
  181.             Leaks On will flush the b-tree to a known empty state, and turn the watcher on.  Only
  182.             the header will be displayed to show it went back to all empties.
  183.             Leaks Off will turn the watching mechanism off, saving the tree in that known state.  It
  184.             will also do the dumping operation to display likely leaks, since that is probably what
  185.             you want when you turn it off.  
  186.             Leaks Dump will dump the entire tree (all non-empty elements) so you can see what all
  187.             blocks are being watched if that is helpful.
  188.  
  189.         
  190.         Things to do:
  191.             Is it too restrictive to force the blocks to match including the pc crawls?  If a code block
  192.                 moved around a lot, the pc wouldn't necessarily match, there still would be a leak,
  193.                 but I wouldn't show it. ...  (could do Code+offset)
  194.             Use PatchLink stuff for 7.0. (or does it matter since I patch at Macsbug load time?)
  195.                 Probably can't patch link here, since it is too early.
  196.             If you kill the app, I don't see those blocks get marked off.  
  197.                 Later, hook into heap dieing.
  198.             Setup something for the dcmd to use to allocate number of elements in heap?  Some
  199.                 way to make it selectable?
  200.             Selectable way to filter the number of blocks required for a match?  Like not just 3 or more.
  201.             Ideally, I want all the tree knowledge in a b-tree unit instead.  Right now the tree stuff
  202.                 knows a little about the dcmd side, and the dcmd side knows how to drive the tree.
  203.             One thing I sort of want to do is give the address line for every block that looks like a leak,
  204.                 so that you can see them all before the stack crawl.  I don't want more than one stack
  205.                 crawl for a leak though.  This would involve sorting by size instead.  Maybe I can sort
  206.                 of punt this by giving the option of new dump to show only matching elements.
  207.             Maybe I should watch SetHandleSize/PtrSize too, so that the display shows the current
  208.                 block size, instead.   If it is a real leak, it should be the same size later too.
  209.             Should be some way to watch for MoreMasters leaks too.
  210. *)
  211.  
  212. {$R-}
  213. {$D+}        { debug labels on. }
  214.  
  215. INTERFACE
  216.  
  217.         USES MemTypes, Resources, Traps, Memory, OSUtils, Events,
  218.                     dcmd;                                            { Macsbug interface routines. }
  219.         
  220.  
  221. CONST
  222.     kOnlyList = 1;                                                { 'Leaks' }
  223.     kTurnOn = 2;                                                { 'Leaks On' }
  224.     kTurnOffNList = 3;                                        { 'Leaks Off' }
  225.     kDumpAll = 4;                                            { 'Leaks Dump' }
  226.  
  227.     kMaxTrackingTableEntries = 500;            { Kinda hard coded, better way?  For # of blocks to watch. }
  228.  
  229.     kHexDigits = '0123456789ABCDEF';        { Digits in base 16, for hex conversion. }
  230.     
  231.     kCrawlArraySize = 8;                                    { Number of stack crawls to do. }
  232.  
  233.  
  234. TYPE
  235.     StackArray = Array [1..kCrawlArraySize] of LongInt;     { Number of stack crawls I do for a call. }
  236.     
  237.     TrackEntryPtr = ^TrackingTableEntry;
  238.     TrackingTableEntry = RECORD
  239.             address:                     LongInt;            { a handle or a pointer, If in emptyQ it is a link. }
  240.             lessThanLink:             TrackEntryPtr;    { queue link to tree whose 'address' is less than this one }
  241.             greaterThanLink:    TrackEntryPtr;    { queue link of tree with 'address' bigger than this one. }
  242.             blockSize:                     LongInt;            { Size of block being tracked. }
  243.             pcStack:                      StackArray;        { stack crawl worth of pcs. }
  244.             tickTime:                     LongInt;            { tickCount when allocated. }
  245.         END;                                                            { The size is multiplied by 500 to give the size of a block in system heap. }
  246.  
  247.     TreeInfo = RECORD                                    { This is the header for the b-trees, used for status info. }
  248.             treeTop:                        TrackEntryPtr;
  249.             treeCount:                 Integer;
  250.             emptyQ:                     TrackEntryPtr;
  251.             emptyCount:             Integer;
  252.                trackActive:                 Boolean;
  253.         END;
  254.  
  255.         { When I'm analyzing the tree for likely leaks, I save off the candidates in an array. }
  256.     TrackTableArray = RECORD
  257.             leakCount: Integer;
  258.             leakEntries: Array [1..10] of TrackingTableEntry;
  259.             leakMatchCount: Array [1..10] of Integer;
  260.         END;
  261.  
  262.         { When I pass back hex numbers on the stack, I want to use small ones. }
  263.     Str8 = String[8];
  264.  
  265. PROCEDURE CreateLeakWatcher;
  266.  
  267.             { Public declaration for dcmdGlue. Must be in every dcmd. The name cannot be changed. }
  268.         PROCEDURE CommandEntry (paramPtr: dcmdBlockPtr);
  269.  
  270.             { Routine to put another element on b-tree to watch a memory manager address. }
  271.         PROCEDURE AddNewBlock (addressToAdd, sizeToAdd: LongInt; stackToAdd: StackArray;
  272.             VAR treeTop, emptyQ: TrackEntryPtr);
  273.         
  274.             { Routine to forget about a b-tree element watching an address. }
  275.         PROCEDURE KillOldBlock (addressToKill: LongInt; VAR treeTop, emptyQ: TrackEntryPtr);
  276.  
  277.  
  278. IMPLEMENTATION
  279.  
  280.  
  281.         { These globals are used so that I can limit the stack usage during recursion.  They don't
  282.             really have to be globals, but it is a convenience.  I label them with a p, so that you can
  283.             immediately see they are private globals (to this unit), a quality MacApp convention. }
  284.     VAR    pDumpString: Str255;                    { To dump label info, from symbols in code. }
  285.                 pLeakRecord: TrackTableArray;    { Array of likely leaks, to be dumped. }
  286.                 pCountEm: Integer;                        { number of exact matches during analysis. }
  287.                 pTreeInfo: TreeInfo;                        { common tree header from Chain result. }
  288.                 pOptionToDo: Integer;                    { global decisions based on command line parameters. }
  289.                 pCheckElement: TrackEntryPtr;    { during analysis, to avoid it on stack. }
  290.                 pBuffer: Ptr;                                        { Address of buffer allocated in system heap. }
  291.                                 
  292.                 
  293. {---------------------------------------------------------------------------------------------------------------------------------}
  294.  
  295.     { Set the address of NewPtr before I patch the trap.  This is so the assembly interface can 
  296.         find this address again, when it is called as part of a NewPtr trap.  This is required because
  297.         I really need PC-relative addressing in order to be able to get this old address.   All four
  298.         of the routines I patch have the same problem, so I have an interface for each.  The
  299.         asm routine just saves off the address passed in, as a PC-Relative variable.  That way
  300.         when the patch code actually executes it can find the header of the b-tree in order to
  301.         add things to it. }
  302. PROCEDURE  SetOldNewPtr (address: LongInt);  EXTERNAL;
  303. PROCEDURE  SetOldNewHandle (address: LongInt);  EXTERNAL;
  304. PROCEDURE  SetOldDisposPtr (address: LongInt);  EXTERNAL;
  305. PROCEDURE  SetOldDisposHandle (address: LongInt);  EXTERNAL;
  306.  
  307.  
  308.     { The references to the asm routines. }
  309. PROCEDURE WatchNewPtr;    EXTERNAL;
  310. PROCEDURE WatchDisposPtr;    EXTERNAL;
  311. PROCEDURE WatchNewHandle;    EXTERNAL;
  312. PROCEDURE WatchDisposHandle;    EXTERNAL;
  313.  
  314.     
  315.     { When I want to get the TreeInfo, I must get it from the asm side of the world.  It
  316.         has saved the addresses in a PC-Relative way, since it needs them whenever the 
  317.         trap patches get called.  This is the interface to get that info. }
  318. FUNCTION GetTreeTop: TrackEntryPtr;     EXTERNAL;
  319. FUNCTION GetEmptyQ: TrackEntryPtr;     EXTERNAL;
  320. FUNCTION    TrackActive: Boolean;    EXTERNAL;
  321.  
  322.     { When I start up this leak testing universe, I have to set the variables used by the
  323.         assembly patch code.  The tree will be allocated and initialized by this dcmd code,
  324.         and then used by the patch code. }
  325. PROCEDURE SetTreeTop (address: TrackEntryPtr);        EXTERNAL;
  326. PROCEDURE SetEmptyQ (address: TrackEntryPtr);        EXTERNAL;
  327. PROCEDURE SetActive (state: Boolean);        EXTERNAL;
  328.  
  329.         
  330. {---------------------------------------------------------------------------------------------------------------------------------}
  331.     { Another handy routine stolen from MacApp to do the conversion on the dang strings.  I
  332.         only pass back Str8, since that is the maximum length, and stack space is limited in 
  333.         Macsbug, and I don't want to waste it needlessly.  
  334.         Notably, this one handles negative LongInts properly, unlike the one distributed with
  335.         the dcmd samples. }
  336. FUNCTION NumberToHex(decNumber: UNIV LongInt): Str8;
  337.  
  338. VAR    i: Integer;
  339.             hexNumber: Str8;
  340.  
  341. BEGIN
  342.     hexNumber[0] := CHR(8);
  343.     FOR i := 8 DOWNTO 1 DO
  344.         BEGIN
  345.             hexNumber[i] := kHexDigits[BAND(decNumber, 15) + 1];
  346.             decNumber := BSR(decNumber, 4);
  347.         END;
  348.     NumberToHex := hexNumber;
  349. END;
  350.  
  351.  
  352. {---------------------------------------------------------------------------------------------------------------------------------}
  353.     { Zero a TrackingTableEntry, by clearing each field in the record.  This is just a 
  354.         little utility routine.  It is used during Init, and when a block is Killed.  I clear the block
  355.         just to be robust, even though it shouldn't matter what is in the block.  If speed were
  356.         an issue (it isn't) then I would skip this clearing, and just hit the fields that really
  357.         matter, like address.  It makes it easier to see what's going on when debugging it,
  358.         and it helps to prevent inadvertent bugs from blowing it up.  Yes, this type of stuff
  359.         can mask some bugs, but it is more important that it run properly. }
  360. PROCEDURE ZeroTrackEntry (VAR theEntry: TrackEntryPtr);
  361.  
  362. VAR    I: Integer;
  363.  
  364. BEGIN
  365.     WITH theEntry^ DO BEGIN
  366.         address := 0;
  367.         lessThanLink := NIL;
  368.         greaterThanLink := NIL;
  369.         blockSize := 0;
  370.         FOR I := 1 to kCrawlArraySize DO
  371.             pcStack[I] := 0;
  372.         tickTime := 0;
  373.     END;    { With toBeEmptied^ }
  374. END;
  375.  
  376.  
  377. {---------------------------------------------------------------------------------------------------------------------------------}
  378.     { Drive the entire buffer as a series of TrackingTableEntries, clearing each field in the 
  379.         records, and setting up the empty links between records.  This is a brute force way to
  380.         clean them out, but this is a robust way to do it.  It presumes nothing about the buffer,
  381.         except that it has been allocated.  For instance, it doesn't rely on the record structure
  382.         being valid.  It could be blown up because of a bug here, but this will fix it.  This is
  383.         robustness.  Sure, sure, it should never get blown up, but why not be robust instead
  384.         of assuming things will always work properly?  Now set up all the links from one
  385.         'address' to another, to make a linked list of empty q elements.  I'm skipping the last
  386.         entry in the queue (the -1), leaving it NIL to mark the end of the list.}
  387. PROCEDURE InitQ (buffer: Ptr);
  388.  
  389. VAR    thisEntry: TrackEntryPtr;
  390.             I: Integer;
  391.             
  392. BEGIN
  393.     thisEntry := TrackEntryPtr(buffer);
  394.     FOR I := 1 to kMaxTrackingTableEntries-1 DO  BEGIN
  395.         ZeroTrackEntry (thisEntry);
  396.         thisEntry^.address := ORD(thisEntry) + SIZEOF (TrackingTableEntry);
  397.         thisEntry := TrackEntryPtr(thisEntry^.address);
  398.     END;
  399.     ZeroTrackEntry (thisEntry);                                        { zero the last entry too. }
  400. END;
  401.  
  402.  
  403. {---------------------------------------------------------------------------------------------------------------------------------}
  404.     { Check a sub tree recursively to be sure it is valid. 
  405. ;  This routine will drive the entire b-tree in memory, making sure that
  406. ;     it is consistent.  If it finds a problem there is a problem with the b-tree code, and
  407. ;    thus this will break into the debugger.
  408. ;    It will check to be sure that all of the elements in the tree are set up properly, like
  409. ;    having the less than side have an address less than the owning element, and the
  410. ;    same on the greater than side.  This will ensure the tree will not have elements
  411. ;    out of place.  It will check the empty-q to be sure that it is still valid, and that
  412. ;    all of the elements are empty.  While doing these checks it will count the 
  413. ;    number of elements in each queue, making sure that I haven't lost any
  414. ;    elements. }
  415.  
  416. PROCEDURE CheckSubTree (treeElement: TrackEntryPtr; VAR bElementCount: Integer);
  417.  
  418. BEGIN
  419.         { If I have a non-empty less than node, check it out. }
  420.     IF treeElement^.lessThanLink <> NIL THEN BEGIN
  421.     
  422.             { I have another sub-tree, check that element with respect to this one,
  423.                 and if not valid, blow into debugger. }
  424.         IF treeElement^.address <= treeElement^.lessThanLink^.address THEN
  425. (*            DebugStr ('b-tree is fried.  lessThanLink is wrong.');        *)
  426.             dcmdDrawLine (ConCat('b-tree is fried.  lessThanLink is wrong.  ', 
  427.                 NumberToHex (treeElement^.address)));
  428.         
  429.             { I have a cool link on the less than side.  Go ahead and recursively check
  430.                 the subtree on that side. }
  431.         CheckSubTree (treeElement^.lessThanLink, bElementCount);
  432.     END;
  433.     
  434.         { Check the greater than side too, to ensure it is valid. }
  435.     IF treeElement^.greaterThanLink <> NIL THEN BEGIN
  436.     
  437.             { I have another sub-tree, check that element with respect to this one,
  438.                 and if not valid, blow into debugger. }
  439.         IF treeElement^.address >= treeElement^.greaterThanLink^.address Then
  440. (*            DebugStr ('b-tree is fried.  greaterThanLink is wrong.');    *)
  441.             dcmdDrawLine (ConCat('b-tree is fried.  greaterThanLink is wrong.  ', 
  442.                 NumberToHex (treeElement^.address)));
  443.  
  444.             
  445.             { I have a cool link on the greater than side.  Go ahead and recursively check
  446.                 the subtree on that side. }
  447.         CheckSubTree (treeElement^.greaterThanLink, bElementCount);
  448.     END;
  449.     
  450.         { I've checked both sides of this element and it is valid.  Count this as
  451.             a valid element, then fall out of this level of recursion. }
  452.     bElementCount := bElementCount + 1;
  453. END;
  454.  
  455.  
  456. {---------------------------------------------------------------------------------------------------------------------------------}
  457. { The outside level to check the b-tree and empty queue for validity.  This will
  458.     call the recursive routine to check the b-trees, counting elements as it goes. 
  459.     The three queues are passed in, to simplify finding them. }
  460.  
  461. FUNCTION CheckQs (treeTop, emptyQ: TrackEntryPtr; 
  462.         maxElements: Integer; active: Boolean): TreeInfo;
  463.  
  464. VAR        bElementCount:  Integer;
  465.             qWalk: TrackEntryPtr;
  466.             tempInfo: TreeInfo;
  467.  
  468. BEGIN
  469.         { Copy the heads of the queues off, so I can return them later.   The count
  470.             of elements will be set as I count them. }
  471.     tempInfo.treeTop := treeTop;
  472.     tempInfo.emptyQ := emptyQ;
  473.     tempInfo.trackActive := active;
  474.     
  475.     bElementCount := 0;                            { Start element count at zero. }
  476.     
  477.         { Drive the b-tree queue to be sure it is valid.   Start at the top of the tree,
  478.             unless there are no elements. }
  479.     IF treeTop <> NIL  THEN  CheckSubTree (treeTop, bElementCount);
  480.     tempInfo.treeCount := bElementCount;
  481.              
  482.         { If I lived through that, both b-trees are valid.  Now check the empty
  483.             list to be sure that all the links are still valid there.   As long as the 
  484.             empty Q is not completely used up, start at the top and drive each link. }
  485.     qWalk := emptyQ;
  486.     
  487.     IF emptyQ <> NIL THEN
  488.         REPEAT
  489.             IF qWalk^.lessThanLink <> NIL  THEN
  490. (*                DebugStr ('empty queue list is fried.  lessThanLink non-NIL');        *)
  491.                 dcmdDrawLine (ConCat('empty queue list is fried.  lessThanLink non-NIL-- ', 
  492.                     NumberToHex (qWalk^.lessThanLink)));
  493.             IF qWalk^.greaterThanLink <> NIL  THEN
  494. (*                DebugStr ('empty queue list is fried.  greaterThanLink non-NIL');    *)
  495.                 dcmdDrawLine (ConCat('empty queue list is fried.  greaterThanLink non-NIL-- ', 
  496.                     NumberToHex (qWalk^.greaterThanLink)));
  497.                 
  498.             bElementCount := bElementCount + 1;
  499.             qWalk := TrackEntryPtr(qWalk^.address);
  500.         UNTIL qWalk = NIL;
  501.     
  502.         { How ever many I saw there as free needs to be passed back. }
  503.     tempInfo.emptyCount := bElementCount - tempInfo.treeCount;
  504.     
  505.     
  506.         { I've driven the entire list of queue element in the world.  Now if the
  507.             count of elements doesn't jive with what I started, then barf, assuming
  508.             some of them got lost. }
  509.     IF bElementCount < maxElements THEN
  510. (*        DebugStr ('count of elements is off.  lost some');    *)
  511.         dcmdDrawLine (ConCat('count of elements is off.  lost some-  ', 
  512.             NumberToHex (bElementCount)));
  513.     IF bElementCount > maxElements THEN
  514. (*        DebugStr ('count of elements is off.  gained some!');        *)
  515.         dcmdDrawLine (ConCat('count of elements is off.  gained some!  ', 
  516.             NumberToHex (bElementCount)));
  517.         
  518.         { Return the TreeInfo record that gives pertinent tidbits about this system. }
  519.     CheckQs := tempInfo;
  520. END;
  521.  
  522.  
  523. {---------------------------------------------------------------------------------------------------------------------------------}
  524. { ; AddNewBlock will take an address on input, and add it to the b-tree.  It does this
  525. ; by taking an element off of the empty queue list, filling in the fields for the element,
  526. ; then adding it to the b-tree list, by comparing the 'address' fields, to find where it
  527. ; fits in the hierarchy.   On entry, addressToAdd is the address of the block to track.  
  528. ; This is an address in the heap, pointing to the master pointer, or the block itself.  
  529.  
  530. The stackToAdd is an array of kCrawlArraySize elements that have the return addresses from the stack
  531. crawl if they were valid.  These were validated before coming here, and if they weren't
  532. valid, they are nil to mark them as unused.
  533.  
  534.  Both the treeTop and top of the empties list will be modified by this routine, since
  535.  it swaps an element out of the empty list into the b-tree as in use. }
  536.  
  537. PROCEDURE AddNewBlock (addressToAdd, sizeToAdd: LongInt; stackToAdd: StackArray;
  538.     VAR treeTop, emptyQ: TrackEntryPtr);
  539.  
  540. VAR    searchElement: TrackEntryPtr;            { scratch element pointer. }
  541.             ownerElement: TrackEntryPtr;            { owner of searchElement. }
  542.             freshElement: TrackEntryPtr;            { fresh from empties list. }
  543.             I: Integer;
  544.  
  545. BEGIN
  546.         { Check to see if I have used all the free elements up.  *** perhaps I should just
  547.             turn the tree off, as an assumption that they left it on accidentally?   This is one
  548.             DebugStr I don't change, since this will run at normal time, not in Macsbug. }
  549.     freshElement := emptyQ;
  550.     IF freshElement = NIL  THEN BEGIN
  551.         DebugStr ('Barf, no more empty queue elements!-LeakWatching...');
  552.         Exit (AddNewBlock);
  553.     END;
  554.         
  555.         { Pull top element off the empties list, and relink that list so that the next
  556.             element in line is up for use. }
  557.     emptyQ := TrackEntryPtr(freshElement^.address);
  558.     
  559.         { This will be a leaf node, clear the links.  Set up the address to watch. }
  560.     WITH freshElement^ DO BEGIN
  561.         lessThanLink := NIL;
  562.         greaterThanLink := NIL;
  563.         address := addressToAdd;
  564.         blockSize := sizeToAdd;
  565.         tickTime := TickCount;
  566.         
  567.         FOR I := 1 to kCrawlArraySize DO
  568.             pcStack[I] := stackToAdd[I];
  569.     END;        { With freshElement }
  570.     
  571.         { Now drive the b-tree to find the location to add the block at.  The tree may
  572.             be empty, so check that first. }
  573.     searchElement := treeTop;
  574.     IF searchElement = NIL THEN 
  575.         treeTop := freshElement                            { New top of tree. }
  576.     ELSE  BEGIN
  577.             { Loop through the b-tree to find the location that this block should be
  578.                 added at.  This will be a node which is NIL, which I can fill in
  579.                 with the freshElement. }
  580.         REPEAT
  581.             ownerElement := searchElement;            { moved to a new non-nil one. }
  582.             IF addressToAdd < searchElement^.address THEN
  583.                 searchElement := searchElement^.lessThanLink
  584.             ELSE
  585.                 searchElement := searchElement^.greaterThanLink
  586.         UNTIL searchElement = NIL;
  587.     
  588.             { Now add this fresh dude to the b-tree list. }
  589.         IF freshElement^.address < ownerElement^.address THEN
  590.             ownerElement^.lessThanLink := freshElement
  591.         ELSE
  592.             ownerElement^.greaterThanLink := freshElement
  593.     END;        { Else.  not new top of tree. }
  594. END;
  595.  
  596.  
  597. {---------------------------------------------------------------------------------------------------------------------------------}
  598. { Tree deletion.  This is the main reason to use Pascal instead of assembly.  This
  599.     routine is much easier to understand in high level. 
  600.  
  601. ; KillOldBlock is the routine to have us forget about a block that I had previously
  602. ; been watching.  When a block is disposed out of the heap, I have to forget about
  603. ; it, since I only want to keep track of things that are currently in use by the system.
  604. ; On entry to Kill, I have addressToKill as the address of the block to be removed from 
  605. ; the b-tree based list.  I will use that address to drive the tree looking for the b-tree
  606. ; element that is tracking that block in the heap.  If I cannot find it, I let it go,
  607. ; presuming it was allocated before I was watching the blocks.  
  608.  
  609. The treeTop and emptyQ are VAR so that they can be changed if necessary to 
  610. handle the emptying of either queue.
  611.  
  612. This was adapted from an algorithm in Sedgewick.  I tried to follow his code for
  613. the most part, to minimize changes that might introduce bugs.   Here is his code,
  614. copied out straight, if it helps (my comments):
  615.  
  616. ; This is relatively hairy, so just to help, here is the code from Sedgewick that 
  617. ; demonstrates the remove of an element in pascal.  t is the element to kill,
  618. ; x is the head of the tree.
  619. ;    procedure    treeDelete (t, x: Link);
  620. ;        var p, c : Link;
  621. ;        begin
  622. ;            repeat
  623. ;                p := x;
  624. ;                if t^.key < x^.key then x := x^.l else x := x^.r;
  625. ;            until x = t;
  626. ;            if t^.r = z then x := x^.l
  627. ;            else  if t^.r^.l = z then 
  628. ;                begin  x := x^.r; x^.l := t^.l;  end
  629. ;            else
  630. ;                begin
  631. ;                    c := x^.r;  while c^.l^.l <> z do c := c^.l;
  632. ;                    x := c^.l; c^.l := x^.r;
  633. ;                    x^.l := t^.l; x^.r := t^.r;
  634. ;                end;
  635. ;            if t^.key < p^.key then p^.l := x else p^.r := x;
  636. ;        end;
  637. ;
  638. ;     Thank Sedgewick for the lame variable names.
  639. }
  640.  
  641. PROCEDURE KillOldBlock (addressToKill: LongInt; VAR treeTop, emptyQ: TrackEntryPtr);
  642.  
  643. VAR        ownerElement: TrackEntryPtr;            { The owner of the element to be killed. }
  644.             searchElement:    TrackEntryPtr;            { Used as a scratch element pointer. }
  645.             toBeEmptied: TrackEntryPtr;                { when adding back to empties list. }
  646.             subTreeOwner: TrackEntryPtr;            { to move a leaf node to replace killed. }
  647.             I: Integer;
  648.             
  649. BEGIN
  650.         { Bail out of here if the tree is empty, nothing to remove. }
  651.     IF treeTop = NIL  THEN Exit(KillOldBlock);
  652.     
  653.     searchElement := treeTop;
  654.     ownerElement := NIL;
  655.     
  656.         { Find the element that is tracking the addressToKill. }
  657.     WHILE addressToKill <> searchElement^.address DO BEGIN
  658.         ownerElement := searchElement;            { New searcher, means new owner. }
  659.         IF addressToKill < searchElement^.address THEN 
  660.             searchElement := searchElement^.lessThanLink
  661.         ELSE 
  662.             searchElement := searchElement^.greaterThanLink;
  663.         
  664.             { If I didn't find it before running off the end of a leaf, bail out. }
  665.         IF searchElement = NIL THEN Exit(KillOldBlock);
  666.     END;
  667.     
  668. {
  669. ; When I have found a b-tree element that has a matching 'address' field, I have
  670. ; found the element.  Remove it from the tree and put it back into the free element
  671. ; list.  This means getting out the book to see how this works.  The basic idea is to
  672. ; look at both the lessThan and greaterThan links to see if they have they have any
  673. ; subtrees, and if not, just move them in, setting the links in the owner element.  If
  674. ; both sides have subtrees, then I want to drive the lessThan side to find the element
  675. ; that is out at the end of that subtree, then I will move it up into the current location.
  676. ; This takes a leaf node, and moves it further up in the tree, but keeps the tree sorted
  677. ; by address the way I need it.  For a complete discussion, see Sedgewick.
  678. ; When the block has been found the ownerElement will be set to the parent b-tree
  679. ; element used, and bTreeBlock will be the actual element that matches.
  680.  
  681.          Now the searchElement is the guy to be removed from the list.  The
  682.         ownerElement is the current owner of that element. }
  683.  
  684.     toBeEmptied := searchElement;
  685.  
  686.         { The first case is if the element being killed has no greaterThanLink.  If not,
  687.             I can just move the lessThanLink from the toBeEmptied into the 
  688.             ownerElement's lessThanLink.  The idea is that if one side has no
  689.             subTree, then I can just move the subtree into the old spot. }
  690.     IF toBeEmptied^.greaterThanLink = NIL THEN 
  691.         searchElement := toBeEmptied^.lessThanLink    { grab pointer to subtree. }  
  692.     ELSE 
  693.             { Second case is if the descendant of the greaterThanLink has an empty
  694.                 lessThanLink.  This means I can just move the element up one by
  695.                 modifying it's greaterThanLink as well as the ownerElement's link. }
  696.         IF toBeEmptied^.greaterThanLink^.lessThanLink = NIL THEN 
  697.             BEGIN 
  698.                 searchElement := toBeEmptied^.greaterThanLink; 
  699.                 searchElement^.lessThanLink := toBeEmptied^.lessThanLink;  
  700.             END
  701.         ELSE
  702.                 { Otherwise I have the hardest case of having both subtrees in use. 
  703.                     I need to drive down the subtree to the smallest node, and move
  704.                     that node up to the current position, to replace the toBeEmptied. }
  705.             BEGIN
  706.                 subTreeOwner := toBeEmptied^.greaterThanLink;
  707.                 WHILE  subTreeOwner^.lessThanLink^.lessThanLink <> NIL DO
  708.                     subTreeOwner := subTreeOwner^.lessThanLink;
  709.                 searchElement := subTreeOwner^.lessThanLink; 
  710.                 subTreeOwner^.lessThanLink := searchElement^.greaterThanLink;
  711.                 searchElement^.lessThanLink := toBeEmptied^.lessThanLink; 
  712.                 searchElement^.greaterThanLink := toBeEmptied^.greaterThanLink;
  713.             END;
  714.     
  715.         { If the ownerElement is NIL, I am removing the top of the tree, so I have
  716.             a new treetop. }
  717.     IF ownerElement = NIL THEN
  718.         treeTop := searchElement
  719.     ELSE
  720.             { Decide which side of the tree to add to. }    
  721.         IF toBeEmptied^.address < ownerElement^.address THEN
  722.             ownerElement^.lessThanLink := searchElement 
  723.         ELSE
  724.             ownerElement^.greaterThanLink := searchElement;
  725.             
  726.         { Now the element has been removed from the tree.  Add it back into the
  727.             empties list so it is available for use.  This resets the top of the empties list. }
  728.     ZeroTrackEntry (toBeEmptied);
  729.     
  730.     toBeEmptied^.address := ORD4(emptyQ);
  731.     emptyQ := toBeEmptied;
  732. END;
  733.  
  734.  
  735. {---------------------------------------------------------------------------------------------------------------------------------}
  736.     { This is an init routine that sets up the trap patches, and creates and inits the block in
  737.         the system heap that is used to store the records that track each block I see go by.  This
  738.         is a hard-coded tracking size, which is bad.   This part uses the toolbox, which is a bad
  739.         idea for dcmds to do.   If I can't get space for the buffer, I won't install the patches,
  740.         and I'll beep to let them know.   Just added the     dcmdSwapWorlds to make it work
  741.         with TMon Pro. }
  742. PROCEDURE CreateLeakWatcher;
  743.  
  744. VAR        bigBuff: LongInt;
  745.  
  746. BEGIN
  747.         { Before I watch anything, the tree must be empty, and turned off by default. }
  748.     SetTreeTop (NIL);
  749.     SetActive (FALSE);
  750.  
  751.         { I need to create the big buffer that holds all the elements, but they initially will
  752.             all be zeroed, and chained together into the emptyQ list.  If I can't get it, beep.  I
  753.             do this funky ord4 stuff so it is LongInt math for big buffer sizes. }
  754.     bigBuff := ORD4(kMaxTrackingTableEntries) * ORD4(SIZEOF(TrackingTableEntry));
  755.     pBuffer := NewPtrSys (bigBuff);
  756.     IF pBuffer = NIL  THEN  BEGIN
  757.         SysBeep (5);
  758.         Exit (CreateLeakWatcher);                        { Skip out, avoiding trap patches. }
  759.     END;
  760.     
  761.         { Got the dang buffer.  Clear every record in the buffer, and reset all the linked list
  762.             address pointers. The tree will thus be empty, and the emptyQ will have all the
  763.             records. }
  764.     InitQ (pBuffer);
  765.     
  766.         { The queue is set up as a linked list of empty elements.  Tell the asm side where it starts. }
  767.     SetEmptyQ (TrackEntryPtr(pBuffer));
  768.  
  769.         { Patch the traps....  These are being patched in the world, not in the debugger world. }
  770.         { Switch over to the real world, in case the debugger does world swaps.  TMon Pro.}
  771.     dcmdSwapWorlds;
  772.  
  773.         { Use NGetTrapAddress since it is always safer on current machines.  Take the result
  774.             it gives me, and save it off in asm land, for future reference.  Then, move in the
  775.             new address of the routine, my asm glue, with watching junk. }
  776.     SetOldNewPtr (NGetTrapAddress(_NewPtr, OSTrap));
  777.     NSetTrapAddress(ORD(@WatchNewPtr), _NewPtr, OSTrap);    
  778.     
  779.         { Do DisposPtr }
  780.     SetOldDisposPtr (NGetTrapAddress(_DisposPtr, OSTrap));
  781.     NSetTrapAddress(ORD(@WatchDisposPtr), _DisposPtr, OSTrap);
  782.  
  783.         { Do the obvious NewHandle dude too. }
  784.     SetOldNewHandle(NGetTrapAddress(_NewHandle, OSTrap));
  785.     NSetTrapAddress(ORD(@WatchNewHandle), _NewHandle, OSTrap);    
  786.     
  787.         { Do DisposHandle, too. }
  788.     SetOldDisposHandle (NGetTrapAddress(_DisposHandle, OSTrap));
  789.     NSetTrapAddress(ORD(@WatchDisposHandle), _DisposHandle, OSTrap);
  790.  
  791.         { Switch back to debugger world. }
  792. (*    dcmdSwapWorlds; *)
  793. END;        { CreateLeakWatcher }
  794.  
  795.  
  796. {---------------------------------------------------------------------------------------------------------------------------------}
  797.     { Just a handy place to dump out the info about an element.  This has been changed to dump using the
  798.         Macsbug call backs instead, and to use the NumberToHex routine for the numbers.  Do a stack crawl, using
  799.         the address given, trying to see if there is a symbol associated.   I dump them out from the highest to lowest
  800.         to match the StackCrawl that Macsbug uses.  Also, since some are set to Nil when the stack crawler doesn't
  801.         have a valid address, I look for that, and skip the dump if the pc address was not valid. 
  802.         I added the matchCount to give the info about the number of blocks that match this one, but have
  803.         a different address. }
  804. PROCEDURE PrintElement (element: TrackEntryPtr; matchCount: Integer);
  805.  
  806. VAR    I: Integer;
  807.  
  808. BEGIN
  809.     WITH element^ DO
  810.         BEGIN
  811.             dcmdDrawLine(ConCat('address: ', NumberToHex(address), '  size: ', NumberToHex(blockSize), 
  812.                 '   time: ', NumberToHex(tickTime), '    matches: ', NumberToHex(matchCount)));
  813.             FOR I := kCrawlArraySize DownTo 1 DO 
  814.                 IF pcStack[I] <> 0 THEN BEGIN        
  815.                     dcmdGetNameAndOffset (pcStack[I], pDumpString);
  816.                     dcmdDrawLine(ConCat('    ', NumberToHex(pcStack[I]), ':   ', pDumpString));
  817.                 END;
  818.         END;
  819. END;
  820.  
  821.  
  822. {---------------------------------------------------------------------------------------------------------------------------------}
  823.     { A more rough printout of the elements, that is used for the dump operation.  The stack crawl
  824.         during a full dump seemed a bit much, so this gives you the numbers, but without symbols.
  825.         The most interesting info is the block address, so I do that for each block, of course. }
  826. PROCEDURE PrintRaw (element: TrackEntryPtr);
  827.  
  828. BEGIN
  829.     WITH element^ DO
  830.         BEGIN
  831.             dcmdDrawLine(ConCat('address: ', NumberToHex(address), '  size: ', NumberToHex(blockSize), '   time: ', NumberToHex(tickTime)));
  832.             dcmdDrawLine(ConCat('    pc1: ', NumberToHex(pcStack[1]), '   pc2: ', NumberToHex(pcStack[2]), '   pc3: ', NumberToHex(pcStack[3]), '   pc4: ', NumberToHex(pcStack[4])));
  833.             dcmdDrawLine(ConCat('    pc5: ', NumberToHex(pcStack[5]), '   pc6: ', NumberToHex(pcStack[6]), '   pc7: ', NumberToHex(pcStack[7]), '   pc8: ', NumberToHex(pcStack[8])));
  834.         END;
  835. END;
  836.  
  837.  
  838. {---------------------------------------------------------------------------------------------------------------------------------}
  839.     { Recursively dump the tree from the lowest address on up.  Since I'm dumping the entire
  840.         tree, and not just likely leaks, I'll dump it out in a more raw format, without doing
  841.         the stack crawl via labels.  This is to take up less space visually in the scrolling area.  I 
  842.         don't really expect anyone to use this option that much, although it does give you the
  843.         addresses of all the blocks currently being tracked. }
  844. PROCEDURE DumpTree (element: TrackEntryPtr);
  845.  
  846. BEGIN
  847.     IF element^.lessThanLink <> NIL THEN
  848.         DumpTree(element^.lessThanLink);
  849.  
  850.     PrintRaw(element);                                                         { do it after driving smallest links. }
  851.  
  852.     IF element^.greaterThanLink <> NIL THEN
  853.         DumpTree(element^.greaterThanLink);
  854. END;
  855.  
  856.  
  857. {---------------------------------------------------------------------------------------------------------------------------------}
  858.     { Minor routine to see if the two elements actually match in size as well as all the stack crawl
  859.         entries in each element.  Don't care about Time, and certainly not the address. 
  860.         I do the size first, since it is most likely to not match, then backwards through the 
  861.         crawl, since the topmost number is most likely not to match.  (a minor optimization) }
  862. FUNCTION ElementMatch (el1, el2: TrackEntryPtr): Boolean;
  863.     
  864. VAR    I: Integer;
  865.  
  866. BEGIN
  867.     ElementMatch := FALSE;                                        { Assume they don't match, so I can jump out. }
  868.     
  869.     IF el1^.blockSize <> el2^.blockSize THEN Exit (ElementMatch);
  870.     FOR I := kCrawlArraySize DownTo 1 DO
  871.         IF el1^.pcStack[I] <> el2^.pcStack[I] THEN Exit (ElementMatch);
  872.         
  873.     ElementMatch := TRUE;                                        { Made it through, must match. }
  874. END;
  875.         
  876.  
  877. {---------------------------------------------------------------------------------------------------------------------------------}
  878.     { Add an element to the array of known duplicates.  If it already exists in the array,
  879.         skip it.   If I already have 10 elements in the array, skip it, since this is leak city.
  880.         Once they fix a few leaks, then try again, you'll see more.  I limit it to 10 since
  881.         Macsbug has a limited stack, and don't want to burn up too much for elements
  882.         I may never use.   All this code is recursive, so I gotta keep the stack small
  883.         as I can. 
  884.         By checking for an exact match here, I can avoid adding extra elements to the
  885.         list, and using this list I can just dump these elements, giving the stack crawl
  886.         of a single block, rather than each one that matches.  The user thus just sees
  887.         a single leaking stack crawl, with one of the blocks.  If they want to see all 
  888.         the blocks, they can do a dump array command instead. 
  889.         As part of the adding, I'm adding the pCountEm so I can dump that tidbit of info
  890.         along with the elements.  This is the number of entries in the b-tree that match
  891.         this element, which is >= 3, and the actual number may be helpful.  If you want
  892.         to see all the blocks, do a dump instead, and look for the size manually. }
  893. PROCEDURE AddToArray (elementToAdd: TrackEntryPtr);
  894.  
  895. VAR    I: Integer;
  896.  
  897. BEGIN
  898.     WITH pLeakRecord DO BEGIN
  899.         IF leakCount = 10 THEN 
  900.             Exit (AddToArray);                                                { If I'm full up, skip it. }
  901.         
  902.         FOR I := 1 TO leakCount DO
  903.             IF  ElementMatch (elementToAdd, @leakEntries[I])  THEN
  904.                 Exit (AddToArray);                                            { once it's been found, no need to scan them all. }
  905.             
  906.             { No matching element in the leakEntries array yet, so go ahead and add it.  (copy all fields over) }
  907.         leakCount := leakCount + 1;
  908.         leakEntries[leakCount] := elementToAdd^;
  909.         leakMatchCount[leakCount] := pCountEm;        { number of matching elements in tree. }
  910.     END;    { With leakRecord }
  911. END;
  912.  
  913.  
  914. {---------------------------------------------------------------------------------------------------------------------------------}
  915.     { Given an element to examine, drive the tree looking for other blocks that match. 
  916.         I drive the whole tree now, but it should be reasonable to skip out after pCountEm goes over
  917.         3, since it is likely to be a leak for the current element.  This would complicate a recursive
  918.         routine, which goes against my grain.  The pCountEm parameter is passed as a global, so
  919.         I don't have to burn up stack for it.   Since this is the second loop of a doubly nested
  920.         recursive treewalk, I use the pCheckElement as the current element being examined
  921.         from the outer loop.  It changes for each iteration of the outside loop, while I drive
  922.         the entire tree again in this loop.  This use of a global is a little sick, but allows me to
  923.         trim the amount of stuff on the stack as I scan for matching elements. 
  924.         
  925.         I've also added a sick check to see if the element^.address is a resource handle or not.
  926.         If it is, this element cannot be a leak yet, since it is being used by the resource manager.
  927.         I was seeing a number of blocks go by that were resource handles, that happened to have
  928.         the same size, and the same stack crawl.  They aren't leaks, so this change is to get rid
  929.         of those false alarms.  I check to see if the element itself is a match first, as a minor
  930.         optimization to avoid a lot of resource map driving.  The short circuit & will bail
  931.         if it's not a match.  Notably this is using the Resource Manager at interrupt time.
  932.         The user might very well have dropped into Macsbug at a strange place.  This is
  933.         probably not a big deal, since all it has to do is drive a block in the heap, looking 
  934.         through the resource map for a match.  I don't want to do that same driving, since
  935.         any code here would have the same problems as RsrcMapEntry.  If you ever see
  936.         any problems with this, I would be very interested to know. 
  937.         The RsrcMapEntry will return -1 if it doesn't find one, not zero as documented. }
  938. PROCEDURE CountMatchingSize (element: TrackEntryPtr);
  939.  
  940. BEGIN
  941.     IF ElementMatch(element, pCheckElement) & (RsrcMapEntry(Handle(element^.address)) = -1) THEN
  942.         pCountEm := pCountEm + 1;                                { Up the count before recursing. }
  943.  
  944.     IF element^.lessThanLink <> NIL THEN            { If I have a link, go there too. }
  945.         CountMatchingSize(element^.lessThanLink);
  946.     IF element^.greaterThanLink <> NIL THEN        { Recursively drive the right link too. }
  947.         CountMatchingSize(element^.greaterThanLink);
  948. END;
  949.  
  950.  
  951. {---------------------------------------------------------------------------------------------------------------------------------}
  952.     { This guy will drive the entire tree in memory, and for each element, it
  953.         will do the CountMatchingSize procedure.  If enough are found (>=3) then I'll 
  954.         print one out later.  If they aren't found, then I just go on to the next element and
  955.         see if any others in the tree match it.  This is thus a two level recursive system to
  956.         find any blocks that have the same size.   You can think of it as being two nested loops,
  957.         the outside driving each element of the tree, and the inside one driving each element
  958.         in the tree, too.   Any elements that appear multiple times (size, stack crawl match)
  959.         I'll add to the array of leaks for later display.  This guy gets passed the treetop to
  960.         start it up.  Careful of the stack usage here, I'm pushing 4 bytes for each recursive
  961.         call here, and 4 bytes for each recursive call of CountMatchingSize.  For a typical b-Tree
  962.         this won't be a problem, since it will only be 10 or so levels at the deepest.  Macsbug
  963.         has a gutless 1K stack though, so it is risky business. }
  964. PROCEDURE DriveTreeForMatch (element: TrackEntryPtr);
  965.  
  966. BEGIN
  967.     pCountEm := 0;
  968.  
  969.         { Start at the treetop again, and see how many match.  Set the global pCheckElement to
  970.             be the current element, since it won't change over the entire invocation of the
  971.             CountMatchingSize. }
  972.     pCheckElement := element;
  973.     CountMatchingSize(pTreeInfo.treeTop);
  974.  
  975.         { If this element is duplicated 3 or more times, save it off in the pLeakRecord. }
  976.     IF pCountEm >= 3 THEN  AddToArray(element);
  977.  
  978.         { Now I'm done with that element, recursively drive each element in the tree
  979.             that was passed in; and thus I'll drive any subtrees. }
  980.     IF element^.lessThanLink <> NIL THEN            { If I have a link, go there too. }
  981.         DriveTreeForMatch(element^.lessThanLink);
  982.     IF element^.greaterThanLink <> NIL THEN        { Recursively drive the right link too. }
  983.         DriveTreeForMatch(element^.greaterThanLink);
  984. END;
  985.  
  986.  
  987. {---------------------------------------------------------------------------------------------------------------------------------}
  988.     { Drive the tree trying to find the likely candidate for a leak. 
  989.         Now the tree is available, drive the tree looking for duplicate blocks.  This is rather
  990.         loose, and a duplicate is considered to be repeated 3 or more times as having the same
  991.         size and stack crawl.  The operation is presumed to have been run 3 or more times, to 
  992.         duplicate a leaked block 3 or more times.   I use the global variable pTreeInfo in order
  993.         to find the top of the b-tree for analysis.  The pLeakRecord is used to keep track of likely
  994.         leaks, and is global too.   (These are globals to avoid some stack usage, not because I
  995.         think globals are a hot idea.  With a 1K stack in Macsbug, and recursive routines, I'm
  996.         going to extremes.) }
  997. PROCEDURE  AnalyzeTree;
  998.  
  999. VAR    I: Integer;
  1000.  
  1001. BEGIN
  1002.     pLeakRecord.leakCount := 0;
  1003.     
  1004.         { If the tree is non-empty, drive every element in it, trying to find other elements
  1005.             that have the same info (blockSize, stackCrawl).  I pass treeTop from the global here,
  1006.             but it has to be stack based for the recursive use above. }
  1007.     IF pTreeInfo.treeTop <> NIL THEN DriveTreeForMatch(pTreeInfo.treeTop);
  1008.  
  1009.         { For every block in the seen list, dump it out as the cool info they need to know.  This
  1010.             list has no duplicates, so they only get one leak for each element dumped.  If there were
  1011.             no leaks, the leakCount is zero, and I don't do this loop at all. }
  1012.     FOR I := 1 TO pLeakRecord.leakCount DO
  1013.         BEGIN
  1014.             dcmdScroll;                                                            { Put in blank line. }
  1015.             PrintElement(@pLeakRecord.leakEntries[I], pLeakRecord.leakMatchCount[I]);
  1016.         END;
  1017. END;
  1018.  
  1019.  
  1020. {---------------------------------------------------------------------------------------------------------------------------------}
  1021.     { Dump out the tree info, like the number of elements in use.   This is sort of marginally useful,
  1022.         since you can see how many block are being tracked currently; but the main reason to show it
  1023.         is to give the calling human feedback that something actually happened.  In a case where there
  1024.         were no leaks, this is all you would see (which is preferable to not showing anything).  I also
  1025.         use the global pTreeInfo, to be consistent with the other routines, even though the stack
  1026.         usage isn't really a concern for this routine. }
  1027. PROCEDURE DumpHeaders;
  1028.  
  1029. BEGIN
  1030.     WITH pTreeInfo DO
  1031.         BEGIN
  1032.             IF pTreeInfo.trackActive THEN dcmdDrawLine ('ON:  ')
  1033.             ELSE dcmdDrawLine ('OFF: ');
  1034.             
  1035.                 { Write out:   ' top of tree:  00042133  with 00000500 elements.' }
  1036.             dcmdDrawString (ConCat (' top of tree:', NumberToHex (ORD(treeTop)), '  with ', NumberToHex (treeCount), ' elements.'));
  1037.  
  1038.                 { Write out:   '  empty list:  00042133  with 00000500 elements.' }
  1039.             dcmdDrawLine (ConCat ('       empty list:', NumberToHex (ORD(emptyQ)), '  with ', NumberToHex (emptyCount), ' elements.'));
  1040.         END;
  1041. END;
  1042.  
  1043.     
  1044.     { Get the TreeInfo, and check the b-tree for consistency.  *** make it pointer. }
  1045. FUNCTION GetTreeInfo: TreeInfo;
  1046. BEGIN
  1047.     GetTreeInfo := CheckQs (GetTreeTop, GetEmptyQ,  kMaxTrackingTableEntries, TrackActive);
  1048. END;
  1049.  
  1050.  
  1051. {---------------------------------------------------------------------------------------------------------------------------------}
  1052.     { The top of the dump info food chain.  This guy will dump information out, after driving
  1053.         the tree numerous times.   It will call the b-tree code via asm interface in order to get the magic
  1054.         info of the tree header, so I can drive the tree at will, looking for matching blocks, dumping
  1055.         each block to the output, and so on.  Also, the magic interface is turned on or
  1056.         off, here.  I've passed the pOptionToDo as a global here, going to extremes to avoid using
  1057.         more of the stack than needed. }
  1058. PROCEDURE     DumpLeakBlocks;
  1059.     
  1060. BEGIN
  1061.         dcmdScroll;                                                                { bump up a line in the display. }
  1062.  
  1063.             { Now decide what to do, based on the optionToDo. }
  1064.     CASE pOptionToDo OF
  1065.     
  1066.         kOnlyList:                                                                    { 'Leaks' }
  1067.             BEGIN
  1068.                 pTreeInfo := GetTreeInfo;
  1069.                 DumpHeaders;
  1070.                 AnalyzeTree;
  1071.             END;
  1072.             
  1073.         kTurnOn:                                                                    { 'Leaks On' }
  1074.             BEGIN
  1075.                 SetActive (TRUE);
  1076.                 InitQ (pBuffer);                                                { Clear the buffer, reset the tree and emptyQ. }
  1077.                 SetEmptyQ (TrackEntryPtr(pBuffer));
  1078.                 SetTreeTop (NIL);
  1079.                 pTreeInfo := GetTreeInfo;
  1080.                 DumpHeaders;
  1081.             END;
  1082.                 
  1083.         kTurnOffNList:                                                        { 'Leaks Off' }
  1084.             BEGIN
  1085.                 SetActive (FALSE);
  1086.                 pTreeInfo := GetTreeInfo;
  1087.                 DumpHeaders;
  1088.                 AnalyzeTree;
  1089.             END;
  1090.             
  1091.         kDumpAll:                                                                { 'Leaks Dump' }
  1092.             BEGIN
  1093.                 pTreeInfo := GetTreeInfo;
  1094.                 DumpHeaders;
  1095.                 IF pTreeInfo.treeTop <> NIL THEN  DumpTree(pTreeInfo.treeTop);
  1096.             END;
  1097.             
  1098.         OTHERWISE  dcmdDrawLine (' Syntax Error');
  1099.     END;        { Case pOptionToDo }
  1100.  
  1101. END;        { DumpLeakBlocks }
  1102.  
  1103.  
  1104.  
  1105. {---------------------------------------------------------------------------------------------------------------------------------}
  1106.     { Well, I stole this routine from MacApp utilities.  I want to lower case the strings so I 
  1107.         don't have case sensitivities.  This will do it, without using the toolbox. }
  1108. PROCEDURE LowerStr255(VAR s: Str255);
  1109.  
  1110. VAR    i:    INTEGER;
  1111.  
  1112. BEGIN
  1113.     FOR i := 1 TO LENGTH(s) DO
  1114.         IF (s[i] IN ['A'..'Z']) THEN
  1115.             s[i] := CHR(Ord(s[i]) + 32)
  1116. END;        { LowerStr255 }
  1117.  
  1118.  
  1119. {---------------------------------------------------------------------------------------------------------------------------------}
  1120. {---------------------------------------------------------------------------------------------------------------------------------}
  1121.  
  1122.     { This fine fellow is the main entry point for the dcmd.  It is the hook by which I get called
  1123.         by MacsBug to do my thing.  It is basically the chance to key off the command line and do
  1124.         what they request.  I'm using pDumpString here, since it's temporarily used to build a 
  1125.         pOptionToDo, and I don't want to waste stack space.  It will be pounded by any of the
  1126.         dump routines, so realize this is sick, and dangerous.  Also realize that a Str255 is
  1127.         one-fourth, countem, one-fourth of the entire Macsbug stack (1K).   I can't afford to
  1128.         waste string space, that is clear. 
  1129.         
  1130.         Change the version number in the help, whenever it is re-released.   This is the only
  1131.         version number in the program. }
  1132. PROCEDURE CommandEntry (paramPtr: DCmdBlockPtr);
  1133.  
  1134. VAR     ch:              CHAR;
  1135.                 
  1136. BEGIN
  1137.     CASE    paramPtr^.request OF
  1138.             { When I'm called to Init, do the init code of installing the trap patches, allocate data block. }
  1139.         dcmdInit: 
  1140.                 CreateLeakWatcher;
  1141.                 
  1142.             { I can get various DoIt commands, so parse out the options.   If I don't get anything,
  1143.                 do the standard dump info.  I lowercase the string so I can avoid any case sensitivity
  1144.                 on options passed in. }
  1145.         dcmdDoIt:        
  1146.             BEGIN                    
  1147.                 ch := dcmdGetNextParameter (pDumpString);
  1148.                 LowerStr255 (pDumpString);
  1149.                 IF pDumpString = '' THEN pOptionToDo := kOnlyList
  1150.                 ELSE  IF pDumpString = 'dump' THEN pOptionToDo := kDumpAll
  1151.                 ELSE  IF pDumpString = 'on' THEN pOptionToDo := kTurnOn
  1152.                 ELSE  IF pDumpString = 'off' THEN pOptionToDo := kTurnOffNList
  1153.                 ELSE    pOptionToDo := -1;
  1154.                 
  1155.                 DumpLeakBlocks;                                        { using pOptionToDo to decide. }
  1156.             END;
  1157.             
  1158.             { Give them the obvious help info. }
  1159.         dcmdHelp:                                                    
  1160.             BEGIN
  1161.                 dcmdDrawLine ('Leaks [On|Off|Dump]');
  1162.                 dcmdDrawLine ('   Stack crawl info about likely memory leaks.  (Version 5)');
  1163.             END;
  1164.     END;        { End of case paramPtr^.request. }
  1165.         
  1166. END;    { CommandEntry }
  1167.  
  1168. END.
  1169.