home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / oberon / jacob-v0.1 / jacob-v0 / jacob / lib / VerboseGC.ob2 < prev   
Encoding:
Text File  |  1996-04-04  |  1.0 KB  |  44 lines
  1. MODULE VerboseGC;
  2. IMPORT O:=Out,ST:=Storage;
  3.  
  4. VAR old:ST.tAllocFailHandler;
  5.  
  6. PROCEDURE Free():LONGINT; 
  7. VAR inf:ST.tHeapInfo;
  8. BEGIN (* Free *)     
  9.  ST.GetInfo(inf); 
  10.  RETURN inf.TotalFreeBytes; 
  11. END Free;
  12.  
  13. PROCEDURE GcFirstHandler(size,nofAttempts:LONGINT);
  14. VAR oFree:LONGINT; 
  15. BEGIN (* GcFirstHandler *)
  16.  IF nofAttempts=0 THEN 
  17.     O.Str('Collecting garbage... '); 
  18.     oFree:=Free(); 
  19.     ST.GC;      
  20.     O.Int((Free()-oFree) DIV 1024); O.Str('kB freed. '); 
  21.  ELSE     
  22.     O.Str('Increasing heap... '); 
  23.     IF ST.ChangeHeapSize(4*1024*1024)=0 THEN 
  24.        O.StrLn('Impossible!'); 
  25.        HALT(1); 
  26.     END; (* IF *)
  27.  END; (* IF *)
  28.  O.StrLn('Done.'); 
  29. END GcFirstHandler;
  30.  
  31. PROCEDURE IncrFirstHandler(size,nofAttempts:LONGINT);
  32. BEGIN (* IncrFirstHandler *)
  33.  O.Str('Increasing heap... '); 
  34.  IF ST.ChangeHeapSize(2*1024*1024)=0 THEN 
  35.     O.Str('Collecting garbage... '); 
  36.     ST.GC;
  37.  END; (* IF *)
  38.  O.StrLn('Done.'); 
  39. END IncrFirstHandler;
  40.  
  41. BEGIN (* VerboseGC *)
  42.  old:=ST.SetAllocFailHandler(GcFirstHandler); 
  43. END VerboseGC.
  44.