home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a016 / 1.ddi / CLP / PROFILER.PRG < prev    next >
Encoding:
Text File  |  1992-03-15  |  9.3 KB  |  255 lines

  1. *******************************************************************************
  2. *
  3. *        91.08.11    PROFILER.PRG
  4. *
  5. * BLINKER Profiling routines written by Frederick W. Stangl, President of
  6. * Dynamic Performance Inc. Fred is a Clipper developer and lecturer in the
  7. * Philadelphia area. He may be reached at (215) 579-9884. This code is provided
  8. * to BLINKER users free of charge. If you like what you see, call Fred - ask
  9. * him about StanglWare...
  10. *
  11. * Add the following code stub at the top of your main routine:
  12. *
  13. *   external ovl_stat
  14. *   parameter startup_param              && Use command line switch to activate
  15. *   if type ("startup_param") <> "U"     && Check for existence
  16. *
  17. *      if upper(startup_param) = "/P"    && Not case sensitive
  18. *
  19. *                                        && Make arrays big enough to cover
  20. *                                        && All your procedures & functions
  21. *          public bl_himem, bl_lomem, bl_count, ;
  22. *                 bl_proc[500], bl_size[500], bl_call[500], bl_disk[500]
  23. *
  24. *          bl_himem = memory(0)          && Initialize hi & lo memory counters
  25. *          bl_lomem = bl_himem
  26. *          bl_count = 0                  && Initialize array element counter
  27. *
  28. *          set key 281 to ovl_stat       && Use Alt-P for hot-key
  29. *          bliprfmod(.T.)                && Turn profiling mode on
  30. *
  31. *      endif
  32. *   endif
  33. *
  34. *
  35. *   NOTE: if bliprfmod() is .T., profiling is turned on, and every call to
  36. *         an overlaid function or procedure is accompanied by a call to
  37. *         blprfprg(). This profiler collects statistics for later display
  38. *         via the hot key call to ovl_stat().
  39. *
  40. *         To activate the profiling functions, add these linker commands
  41. *         above your BEGINAREA statements in the link script file:
  42. *
  43. *             FI profiler          && This program
  44. *             DEBUG                && This is a linker command, not a file
  45. *
  46. *
  47. *******************************************************************************
  48.  
  49. *** Profiling function for gathering operating statistics ***
  50.  
  51. function blprfprg                            && Called on every overlay call
  52. private call, pointer, free
  53.  
  54. call = blicurnme()                           && Get name of called routine
  55.  
  56. pointer = ascan(bl_proc,call)                && See if we already have it
  57.  
  58. if pointer = 0                               && If not, stuff it into arrays
  59.     ains(bl_proc,1)
  60.     ains(bl_size,1)
  61.     ains(bl_call,1)
  62.     ains(bl_disk,1)
  63.     pointer = 1
  64.     bl_count = bl_count + 1                  && Increment array element counter
  65.     bl_proc[pointer] = call                  && Store statistics for later
  66.     bl_size[pointer] = blicursiz()           && Viewing via hot-key pop-up
  67. endif
  68.  
  69. bl_call[pointer] = blicurcal()
  70. bl_disk[pointer] = blicurdsk()
  71.  
  72. free = blitotcal ()
  73. if free = int (free / 10) * 10               && Every tenth call
  74.    free=memory(0)
  75.    if free>bl_himem                          && Record highest & lowest
  76.       bl_himem=free                          && Memory excursions
  77.    elseif free<bl_lomem
  78.       bl_lomem=free
  79.    endif
  80. endif
  81.  
  82. return(.T.)
  83.  
  84.  
  85. *** Display function for viewing statistics via hot-key ***
  86.  
  87. function ovl_stat
  88.  
  89. private spot, choice, free, oldrow, oldcol, oldmod
  90. private prfmemhig,prfmemzer,prfmemlow,prfmempak,prfovlops,prfovlsiz
  91. private prftotsiz,prftotlod,prftotact,prftotcal,prftotdsk,prftotper
  92.  
  93. oldmod = bliprfmod(.F.)                      && Turn profiling mode off
  94.  
  95. oldrow = row ()
  96. oldcol = col ()
  97. spot=savescreen(04,17,21,64)                 && Save screen area to be used
  98.  
  99. free=memory(0)
  100.  
  101. if free>bl_himem                             && Record highest & lowest
  102.    bl_himem=free                             && memory excursions
  103. elseif free<bl_lomem
  104.    bl_lomem=free
  105. endif
  106.  
  107. prfmemhig = tran(bl_himem*1024,"###,###")    && Set up counts for display
  108. prfmemzer = tran(memory(0)*1024,"###,###")
  109. prfmemlow = tran(bl_lomem*1024,"###,###")
  110. prfmempak = tran(blimempak(),"###,###")
  111. prfovlops = tran(bliovlops(),"###,###")
  112. prfovlsiz = tran(bliovlsiz(),"###,###")
  113. prftotsiz = tran(blitotsiz(),"###,###")
  114. prftotlod = tran(blitotlod(),"###,###")
  115. prftotact = tran(blitotact(),"###,###")
  116. prftotcal = tran(blitotcal(),"###,###")
  117. prftotdsk = tran(blitotdsk(),"###,###")
  118. prftotper = tran(iif(blitotcal()=0,0,100*(1-blitotdsk()/blitotcal()))," ###.#%")
  119.  
  120. do while .T.
  121.                                              && Paint screen
  122.    @ 04,17,21,64 box "┌─┐│┘─└│ "
  123.    @ 05,22 say "      RUNTIME OVERLAY ANALYSIS"
  124.    @ 06,22 say "──────────────────────────────────────"
  125.    @ 07,22 say "Highest Free Pool Memory:      " + prfmemhig
  126.    @ 08,22 say "Current Free Pool Memory:      " + prfmemzer
  127.    @ 09,22 say "Lowest Free Pool Memory:       " + prfmemlow
  128.    @ 10,22 say "Blinker Memory Pack Frequency: " + prfmempak
  129.    @ 11,22 say "Blinker Overlay Pool OpSize:   " + prfovlops
  130.    @ 12,22 say "Current Overlay Pool Size:     " + prfovlsiz
  131.    @ 13,22 say "Total Proc Size Since Startup: " + prftotsiz
  132.    @ 14,22 say "Procedures Currently Loaded    " + prftotlod
  133.    @ 15,22 say "Procedures Currently Active:   " + prftotact
  134.    @ 16,22 say "Total Calls Since Startup:     " + prftotcal
  135.    @ 17,22 say "Total Disk Loads Since Startup:" + prftotdsk
  136.    @ 18,22 say "% Serviced from Overlay Pool:  " + prftotper
  137.  
  138.    @ 20,22 say "F2 Detail                 F3 Bar Chart"
  139.  
  140.    choice=inkey(0)                        && Wait for keypress
  141.  
  142.    do case
  143.  
  144.    case choice = -1              && use ACHOICE to display a scrolling window
  145.                                  && of statistics by called procedures
  146.  
  147.       private count, spot2, bl_stats[bl_count + 5]
  148.  
  149.                                           && Build array for display
  150.       for count = 1 to bl_count
  151.         bl_stats[count] = left(bl_proc[count]+space(10),10) + ;
  152.                           tran(bl_size[count],"   ###,###") + ;
  153.                           tran(bl_call[count],"   ###,###") + ;
  154.                           tran(bl_disk[count],"   ###,###") + ;
  155.                           tran(iif(bl_call[count]=0, 0, ;
  156.                           100*(1-bl_disk[count]/bl_call[count])),"#######.#%")
  157.       next
  158.  
  159.                                           && Display array of statistics
  160.       spot2 = savescreen(02,10,22,64)
  161.       @ 02,10,22,64 box "┌─┐│┘─└│ "
  162.       @ 03,12 say "Procedure       Size     Calls     Loads   Service"
  163.       @ 04,12 say "──────────────────────────────────────────────────"
  164.       choice=achoice(05,12,21,62,bl_stats)
  165.       restscreen(02,10,22,64,spot2)
  166.  
  167.     case choice = -2                      && Display bar chart
  168.  
  169.       private tmpsavscr
  170.       save screen to tmpsavscr
  171.       clear
  172.  
  173.       private bl_bar1[bl_count+5], bl_bar2[bl_count+5]
  174.  
  175.       private count, max_calls, bar, sorted
  176.  
  177.       max_calls=0                         && Get max number of calls
  178.       for count = 1 to bl_count
  179.           max_calls=max(max_calls,bl_call[count])
  180.       next
  181.  
  182.                                           && Build array for display
  183.  
  184.       bar=177                             && ASCII code for bar symbol
  185.       for count = 1 to bl_count
  186.  
  187.         bar = iif(bar=176,177,176)        && Alternate bars
  188.  
  189.         bl_bar1[count] = left(bl_proc[count]+space(11),11) + ;
  190.                        replicate(chr(bar),int(1+64*bl_call[count]/max_calls)) ;
  191.                        + str(bl_call[count],4)
  192.  
  193.                                           && Make copy for sorting - note
  194.                                           && inverse key for descending sort
  195.  
  196.         bl_bar2[count] = str(10000-bl_call[count],4)+bl_bar1[count]
  197.  
  198.       next
  199.  
  200.       asort(bl_bar2)                      && Sort by calls in descending order
  201.  
  202.  
  203.                                           && Trim sort key from string
  204.       for count = 1 to bl_count
  205.           bl_bar2[count] = substr(bl_bar2[count],5,len(bl_bar2[count])-4)
  206.       next
  207.  
  208.       set key -2 to bl_toggle             && Stuff achoice toggle sequence
  209.       sorted = .F.
  210.  
  211.       @ 00,00 say "Procedure  Number of Calls"
  212.       @ 01,00 say replicate(chr(196),80)
  213.  
  214.       do while .T.                        && Display window
  215.  
  216.         if sorted                         && Display appropriate array
  217.           @ 00,54 say "Press F3 for Natural Order"
  218.           achoice(02,00,23,79,bl_bar2)
  219.         else
  220.           @ 00,54 say " Press F3 for Sorted Order"
  221.           achoice(02,00,23,79,bl_bar1)
  222.         endif
  223.  
  224.         if inkey(.1) = 84                 && Toggle between sorted/natural
  225.           sorted = ! sorted               && Note: use inkey() to pop extra
  226.         endif                             && character stuffed by F3, wait
  227.                                           && 1/10 second if no extra key,
  228.         if lastkey() = 27                 && and exit if ESC was pressed
  229.           exit
  230.         endif
  231.  
  232.       enddo
  233.  
  234.       set key -2 to                       && Clear F3 setting
  235.       restore screen from tmpsavscr
  236.  
  237.     otherwise                             && Any other key exits profile
  238.       exit
  239.  
  240.    endcase
  241.  
  242. enddo
  243.  
  244. restscreen(04,17,21,64,spot)
  245. @ oldrow,oldcol say ""
  246.  
  247. bliprfmod(oldmod)                         && Restore profiling mode
  248.  
  249. return(.T.)
  250.  
  251. procedure bl_toggle                       && Esc from achoice, stuff "T"
  252. keyboard chr(27)+"T"                      && to toggle display of arrays
  253. return
  254.  
  255.