home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / CPM / LANGUAGS / PASCAL-P / PROFILER.LBR / TESTPRF.PZS / TESTPRF.PAS
Pascal/Delphi Source File  |  2000-06-30  |  2KB  |  62 lines
  1. PROGRAM testprf(input, output);
  2. (* test profiler subsystem, and demonstration *)
  3. (* of profiler incorporation in application   *)
  4.  
  5.   LABEL 1; (* available to kill and dump profile *)
  6.  
  7.   CONST
  8.     looplength = 1000;
  9.     loopcount  = 20;
  10.  
  11. (* THIS following 3 lines added for profiler operation *)
  12.     minln      = 20;
  13.     maxln      = 500;
  14.     profileit  = true; (* false suppresses all profiler code *)
  15.  
  16.   VAR
  17.     i, j       : integer;
  18.  
  19.   (* 1-------------1 *)
  20.  
  21.   PROCEDURE junkproc;
  22.   (* part of application program.  Used in demo so that *)
  23.   (* some interrupts will be at different line numbers  *)
  24.  
  25.     VAR
  26.       k   : integer;
  27.  
  28.     BEGIN (* junkproc *)
  29.     k := 2 * 3; (* wasting time here *)
  30.     END; (* junkproc *)
  31.  
  32.   (* 1-------------1 *)
  33.  
  34. (* force the include files line numbers up out of range *)
  35. 09000000(*$i'profiler.inc'*)    (* THIS inclusion is required *)
  36. 00036000(* and restore the basic source file line number sequence *)
  37.  
  38.   BEGIN (* testprf *)
  39.   (* unprofiled initialization code executed here *)
  40.  
  41. (* THIS is the added line to start profiling *) 
  42.   IF profileit THEN initprofiler(storeptr, eventcount);
  43.  
  44.   (* Now all code until "stoptimer" call is profiled *)
  45.   (* Do not "release" to any marker formed before    *)
  46.   (* the "initprofiler" call until "dumprofile" has  *)
  47.   (* been executed.                                  *)
  48.   FOR i := 1 TO loopcount DO BEGIN
  49.     writeln(i);
  50.     FOR j := 1 TO looplength DO
  51.       junkproc;
  52.       END;
  53. 1:
  54.   IF profileit THEN stoptimer; (* callable in any procedure *)
  55.   (* unprofiled termination code executed here *)
  56.  
  57. (* THIS line needed to keep the results *)
  58.   IF profileit THEN dumprofile(storeptr);
  59.  
  60.   (* More unprofiled termination code executed here *)
  61.   END. (* testprf *)
  62.