Carousel Volume 2 #1/carousel.iso/mactosh/fonts/fontshow.sit/MemHandler.Pas

Pascal/Delphi Source File | 1988-09-09 | 8KB | 143 lines

UNIT MemHandler(3);
(* This unit contains memory management routines for the FontShow program *)
(* Version 1.0 by Richard Clark, September 1988 *)
{$U-}
{$D+}

INTERFACE

  {$U Globals}
  {$U Windows}

  USES
    MemTypes, QuickDraw, OSIntf, ToolIntf, PackIntf,
    Globals, Windows;

  PROCEDURE InitMemoryHandler;                      (* Set up our "watchdog" routine *)
     PROCEDURE PreAllocate;                            (* Allocate a new window record at the BOTTOM of the heap *)
     PROCEDURE MemStatus;                              (* Report if we've reached a low memory condition *)
  PROCEDURE UpdateUsage;                            (* Check the free space left, and update the "About" window *)
                                                    (* if the value changes *)

  FUNCTION MyGrowZoneProc (cbNeeded: Size):LONGINT; (* This routine scavenges up some memory when we are running low *)

IMPLEMENTATION

     CONST
          aLowMemory = 128;                               (* Alert for the low memory condition *)

     VAR
          ErrLevel : INTEGER;                             (* Flag which shows if we've had a memory error *)


     PROCEDURE MemStatus;
  (* This procedure reports if the application has detected a low memory condition. It should be called at the START *)
  (* of the main loop, after the other handlers have been unloaded. That way, if we're really low on memory, calling *)
  (* this won't put us over the edge.                                                                                *)
     VAR
    itemHit :  INTEGER;

  BEGIN
          IF (ErrLevel > 0) THEN                          (* If the low memory flag is set, put up an alert *)
            itemHit := CautionAlert(ErrLevel, NIL);
          ErrLevel := 0;                                  (* Reset the flag *)
     END; (* MemStatus *)


     PROCEDURE PreAllocate;
  (* This procedure allocates a spare window record on the bottom of the heap.  It should be called *)
  (* from within the main loop AFTER all of the other segments have been unloaded.  In this way,    *)
  (* windows will be allocated from the bottom of the heap upwards, while code segments are loaded  *)
  (* from the top downwards.  This helps avoid fragmenting the heap.                                *)
  (*                                                                                                *)
  (* The global variable WindowReserve contains a pointer to the currently reserved block.  To get  *)
  (* a new block, just set this to NIL, and PreAllocate will allocate a replacement.                *)
     BEGIN
          IF (windowReserve = NIL) THEN
                  WindowReserve := NewPtr(sizeof(WindowRecord));
     END; (* PreAllocate *)


     PROCEDURE LowMemory;
  (* This procedure sets a flag if we are running out of memory.  Several of these procedures  *)
  (* could be set up to signal varying levels of memory problems, but we'll only use one level *)
  (* of reporting here.                                                                        *)
     BEGIN
          IF ErrLevel < aLowMemory THEN                   (* If the flag's not set, then set it *)
               ErrLevel := aLowMemory;
     END; (* LowMemory *)


     PROCEDURE UpdateUsage;
  (* This procedure checks the amount of memory left, and updates the value in the About window *)
  (* if the free memory value changes.                                                          *)
        VAR
              oldFreeMem : LONGINT;

     BEGIN
          oldFreeMem := currFreeMem;                      (* Save the old value *)
          currFreeMem := FreeMem;                         (* get the new value *)
          IF (currFreeMem <> oldFreeMem) THEN             (* and update the display if the value changes *)
              UpdateAboutWindow;
     END; (* UpdateUsage *)


     FUNCTION MyGrowZoneProc;
  (* This function is called by the system if we've requested a block of memory and the system cannot *)
  (* find an empty block that's large enough.  (The system has already purged out as many resources   *)
  (* as it can at this point. It calls us in the hope that we can supply some memory.)  Normally, if  *)
  (* we didn't supply this procedure, System Error 25 ("Out of Memory") would result, which is pretty *)
  (* unfriendly.  So, since we could do without the "Automatic Update" pictures on our windows, (it's *)
  (* not too hard to update them normally, it's just a shade slower than using the automatic updates) *)
  (* we'll try getting rid of window pictures until we either run out of windows or until the system  *)
  (* is satisfied.                                                                                    *)
  (*                                                                                                  *)
  (* We're expected to return 0 if no memory could be found (forcing a System Error 25), or any other *)
  (* number if some memory could be found.  The system will call us again if it needs more help.      *)
  (*                                                                                                  *)
  (* This procedure needs to be in memory ALL of the time, so it's in the same segment as our main    *)
  (* loop.                                                                                            *)
        VAR
             testWindow  : WindowPeek;                       (* One of the windows in the list *)
             MemReleased : Boolean;                          (* Were we able to free up some memory *)

  BEGIN
       MemReleased := FALSE;

          testWindow := WindowPeek(FrontWindow);
          REPEAT                                          (* Scan down the window list, looking for the *)
                                                    (* first font window with an attached picture.*)
               IF (testWindow <> NIL) THEN
                    IF (testWindow^.windowKind < 0) OR (testWindow^.refCon <> wFont) THEN
                         testWindow := testWindow^.nextWindow      (* If it's a DA or not a font window, skip it *)
                    ELSE IF (testWindow^.windowPic <> NIL) THEN (* If there's a picture, get rid of it *)
                       BEGIN
                            DisposHandle(Handle(testWindow^.windowPic));
                            testWindow^.windowPic := NIL;
                            testWindow := NIL;                        (* Mark this window as having no picture *)
                            MemReleased := TRUE;                      (* Set the flag to show that we released some memory *)
                      END ELSE
                         testWindow := testWindow^.nextWindow;     (* This Font window has no picture, so try the next one *)
          UNTIL (testWindow = NIL);

          IF (MemReleased) THEN                           (* Okay, we scavenged some memory. *)
             BEGIN
                  LowMemory;                                    (* Warn the user *)
                  MyGrowZoneProc := 1;                          (* Ask the system to try again *)
             END ELSE                                        (* We gave everything -- there's nothing left *)
             MyGrowZoneProc := 0;                            (* Force a System Error 25 *)
     END; (* MyGrowZoneProc *)


  PROCEDURE InitMemoryHandler;
  (* This procedure sets up our special "Low Memory" watchdog procedure *)
     BEGIN
          currFreeMem := 0;
          ErrLevel := 0;                                  (* No low memory errors yet *)
          MaxApplZone;                                    (* Expand the Application Heap to full size, *)
                                                    (* so we get more accurate free memory reports *)
                                                    (* (and possibly less fragmentation).        *)
    SetGrowZone(@MyGrowZoneProc);                   (* Install the watchdog procedure *)
     END; (* InitMemoryHandler *)

END.