Skip to content
GitLab
Commit 11fa7214 authored by John van Groningen's avatar John van Groningen
Browse files

time profiler for linux using I/O 0.8

parent fa9774ee
Show whitespace changes
Inline Side-by-side
ShowTimeProfile08/Help.dcl 0 → 100644
View file @ 11fa7214
definition module Help
import deltaIOSystem
from deltaEventIO import ::IOState
from StdFile import ::Files
/* General utility for handling the AboutDialog of a Clean application.
This module uses the 0.8 I/O library.
*/
MakeAboutDialog :: String String (*s -> *((IOState *s) -> (*s,IOState *s))) *Files
-> (DialogDef *s (IOState *s), *Files)
ShowHelp :: String (IOState s) -> IOState s
ShowTimeProfile08/Help.icl 0 → 100644
View file @ 11fa7214
implementation module Help
import StdString, StdInt, StdChar, StdBool, StdFile, StdArray, StdTuple, StdList
import deltaSystem, deltaEventIO, deltaIOSystem, deltaWindow, deltaPicture, deltaFont, deltaIOState
:: InfoDef :== (Int,Int,[InfoLine])
:: InfoLine :== (InfoFontDef,Int,Int,String)
:: InfoFontDef = InfoFont Font Centred
| NoFont Centred
:: Centred :== Bool
:: Fonts :== (Font,Font,Font,Font)
:: Heights :== (Int,Int)
HelpWdID :== 30000
InfoFontName1 :== "Geneva"
InfoFontName2 :== "Helvetica"
InfoFontName3 :== "Times"
NormalSize1 :== 9
NormalSize2 :== 12
LargeSize1 :== 12
LargeSize2 :== 14
NormalStyle :== []
BoldStyle :== ["Bold"]
Margin :== 8
AboutBegin :== "\\About"
AboutEnd :== "\\EndAbout"
HelpBegin :== "\\Help"
HelpEnd :== "\\EndHelp"
About :== False
Help :== True
//
// General AboutDialog construction.
//
MakeAboutDialog :: String String (*s -> *((IOState *s) -> (*s,IOState *s))) *Files
-> (DialogDef *s (IOState *s), *Files)
MakeAboutDialog appname infofile helpf files
# ((xmax,ymax,text),files) = ReadInfo About fonts AboutBegin AboutEnd infofile files
picture = DrawAboutInfo nft (xmax,ymax,text)
aboutDialog = AboutDialog appname ((0,0),(xmax,ymax)) picture (AboutHelp "Help" helpf)
= (aboutDialog,files)
where
fonts = InfoFonts
(nft,_,_,_) = fonts
InfoFonts :: Fonts
InfoFonts
= ( selectfont [(InfoFontName1,NormalSize1),(InfoFontName2,NormalSize2)] NormalStyle
, selectfont [(InfoFontName1,LargeSize1 ),(InfoFontName2,LargeSize2 )] NormalStyle
, selectfont [(InfoFontName1,NormalSize1),(InfoFontName2,NormalSize2)] BoldStyle
, selectfont [(InfoFontName1,LargeSize1 ),(InfoFontName2,LargeSize2 )] BoldStyle
)
where
selectfont :: ![(String,Int)] ![FontStyle] -> Font
selectfont [(fontname,size):preffonts] style
# (found,font) = SelectFont fontname style size
| found
= font
| otherwise
= selectfont preffonts style
selectfont _ style
= snd (SelectFont InfoFontName3 style NormalSize2)
/* Reading and pre-processing of the file containing the about- and help-info. */
ReadInfo :: Bool Fonts String String String *Files -> ((Int,Int,[InfoLine]),*Files)
ReadInfo help fonts begin end filename files
# (succes,file,files) = fopen (ApplicationPath filename) FReadText files
| not succes && help
= ((x,y,lines),files)
with
(x,y,lines) = ProcessInfoStrings fonts [errpref+++"could not be found."]
| not succes
= ((defaultx,defaulty,defaultlines),files)
# (found,info,file) = ReadInfoFile begin end file
(_,files) = fclose file files
| not found && help
= ((x,y,lines),files)
with
(x,y,lines) = ProcessInfoStrings fonts [errpref+++"does not contain help information."]
| not found
= ((defaultx,defaulty,defaultlines),files)
| otherwise
= ((x,y,lines),files)
with
(x,y,lines) = ProcessInfoStrings fonts info
where
(defaultx,defaulty,defaultlines)
= ProcessInfoStrings fonts ["\\DThis is a Clean program."]
errpref = "The help file \'"+++filename+++"\' "
ProcessInfoStrings :: Fonts [String] -> InfoDef
ProcessInfoStrings fonts=:(nft,lft,_,_) lines
= (maxx1,maxy+Margin-lat,lines2)
where
heights = (nat+ndt+nld,lat+ldt+lld)
(maxx,maxy,lines1) = AddFontToInfoLines fonts heights 0 (Margin+lat) lines
maxx1 = Margin+maxx+Margin
lines2 = map (CenterInfoLine nft maxx1) lines1
(nat,ndt,_,nld) = FontMetrics nft
(lat,ldt,_,lld) = FontMetrics lft
AddFontToInfoLines :: Fonts Heights Int Int [String] -> InfoDef
AddFontToInfoLines fonts heights maxx maxy [line:rest]
= (maxx1,maxy1,[(font,Margin,maxy,line1):rest1])
where
(font,wid,hgt,line1)= ParseInfoLine fonts heights line
(maxx1,maxy1,rest1) = AddFontToInfoLines fonts heights (max maxx wid) (maxy+hgt) rest
ParseInfoLine :: Fonts Heights String -> (InfoFontDef,Int,Int,String)
ParseInfoLine fonts=:(nft,lft,bft,dft) heights=:(nhgt,lhgt) line
| linelen<2 || line.[0]<>'\\'
= (NoFont False, FontStringWidth line nft, nhgt,line )
| otherwise
= (infofont, FontStringWidth line1 font, height,line1)
with
line1 = line%(2,linelen-1)
(infofont,font,height) = case (line.[1]) of
'L' -> (InfoFont lft False, lft, lhgt)
'b' -> (InfoFont bft False, bft, nhgt)
'B' -> (InfoFont dft False, dft, lhgt)
'c' -> (NoFont True , nft, nhgt)
'C' -> (InfoFont lft True , lft, lhgt)
'd' -> (InfoFont bft True , bft, nhgt)
'D' -> (InfoFont dft True , dft, lhgt)
_ -> (NoFont False , nft, nhgt)
where
linelen = size line
AddFontToInfoLines _ _ maxx maxy _
= (maxx,maxy,[])
CenterInfoLine :: Font Int InfoLine -> InfoLine
CenterInfoLine nft maxx info=:(inft=:NoFont centered,x,y,line)
| centered = (inft,(maxx-FontStringWidth line nft)/2,y,line)
| otherwise = info
CenterInfoLine nft maxx info=:(inft=:InfoFont font centered,x,y,line)
| centered = (inft,(maxx-FontStringWidth line font)/2,y,line)
| otherwise = info
ReadInfoFile :: String String *File -> (Bool,[String],*File)
ReadInfoFile begin end file
# (begin_found,file)= FindInfoBegin begin file
| not begin_found
= (False,[],file)
# (lines,file) = ReadInfoUntil end file
| otherwise
= (True,lines,file)
FindInfoBegin :: String *File -> (Bool,*File)
FindInfoBegin begin file
| sfend file = (False,file)
# (line,file) = freadline file
| isPrefixOf begin line
= (True,file)
| otherwise
= FindInfoBegin begin file
ReadInfoUntil :: String *File -> ([String],*File)
ReadInfoUntil end file
| sfend file
= ([],file)
# (line,file) = freadline file
| isPrefixOf end line
= ([],file)
# (lines,file) = ReadInfoUntil end file
| otherwise
= ([StripNewline line:lines],file)
/* The drawing of the about/help info. */
DrawAboutInfo :: Font InfoDef -> [DrawFunction]
DrawAboutInfo nft (xmax,ymax,lines)
= [ SetFont nft
, DrawInfo nft 0 ymax lines
]
DrawInfo :: Font Int Int [InfoLine] Picture -> Picture
DrawInfo nft top bot [(InfoFont font c,x,y,line):rest] pic
| y>bot = pic
| y<top = DrawInfo nft top bot rest pic
| otherwise = DrawInfo nft top bot rest (SetFont nft (DrawString line (SetFont font (MovePenTo (x,y) pic))))
DrawInfo nft top bot [(NoFont c,x,y,line):rest] pic
| y>bot = pic
| y<top = DrawInfo nft top bot rest pic
| otherwise = DrawInfo nft top bot rest (DrawString line (MovePenTo (x,y) pic))
DrawInfo _ _ _ _ pic
= pic
//
// The Help function.
//
ShowHelp :: String (IOState s) -> IOState s
ShowHelp infofile io
# ((xmax,ymax,text),io) = accFiles (ReadInfo Help fonts HelpBegin HelpEnd infofile) io
window = FixedWindow HelpWdID (0,0) "Help" ((0,0),(xmax,ymax)) (UpdateHelpWd nft text) []
= OpenWindows [window] io
where
fonts = InfoFonts
(nft,_,_,_) = fonts
UpdateHelpWd :: Font [InfoLine] UpdateArea *s -> (*s,[DrawFunction])
UpdateHelpWd nft lines areas s
= ( s
, [ SetFont nft
, RedrawAreas nft lines areas
]
)
where
RedrawAreas :: Font [InfoLine] UpdateArea Picture -> Picture
RedrawAreas nft lines [area=:((l,t),(r,b)):rest] pic
= RedrawAreas nft lines rest (DrawInfo nft (t-1) (b+40) lines pic)
RedrawAreas _ _ _ pic
= pic
/* Support functions for the AboutDialog construction. */
isPrefixOf :: String String -> Bool
isPrefixOf prefix string
| prefixlen>size string = False
| otherwise = prefix==string%(0,prefixlen-1)
where
prefixlen = size prefix
StripNewline :: String -> String
StripNewline string
| string=="" = string
| string.[last]<>'\n' = string
| otherwise = string%(0,last-1)
where
last = size string-1
ShowTimeProfile08/ShowTimeProfile.icl 0 → 100644
View file @ 11fa7214
module ShowTimeProfile;
import StdEnv;
import Help;
ApplicationName :== "ShowTimeProfile";
HelpFileName :== ApplicationName +++ "Help";
PCorMac pc mac :== pc;
:: Profile = {
module_name::String,
function_name::String,
n_strict_calls::Int,
n_lazy_calls::Int,
n_curried_calls::Int,
n_allocated_words::Int,
time::Real
};
:: FormattedProfile = {
f_module_name::String,
f_function_name::String,
f_n_strict_calls::Int,
f_n_lazy_calls::Int,
f_n_curried_calls::Int,
f_n_allocated_bytes::Int,
f_alloc_percentage::Real,
f_time::Real,
f_time_percentage::Real
};
format_string_r length string
# string_size=size string;
| string_size >= length
= string;
= (createArray (length-string_size) ' ')+++string;
format_real n_spaces n d m r
| r<0.0
= format_negative_real (if (n_spaces<1) 0 (dec n_spaces)) n d m (~r);
# s=toString (toInt (m*r));
l=size s;
| l<=d
= createArray n_spaces ' ' +++ createArray n '0' +++"."+++createArray (d-l) '0'+++s;
| l<=n+d
= createArray n_spaces ' ' +++ createArray (n+d-l) '0' +++insert_dot_in_string s l d;
| l<=n_spaces+n+d
= createArray (n_spaces+n+d-l) ' '+++ insert_dot_in_string s l d;
= insert_dot_in_string s l d;
format_negative_real n_spaces n d m r
# s=toString (toInt (m*r));
l=size s;
| l<=d
= createArray n_spaces ' ' +++"-"+++ createArray n '0' +++"."+++ createArray (d-l) '0' +++s;
| l<=n+d
= createArray n_spaces ' ' +++"-"+++ createArray (n+d-l) '0' +++insert_dot_in_string s l d;
| l<=n_spaces+n+d
= createArray (n_spaces+n+d-l) ' ' +++ "-"+++insert_dot_in_string s l d;
= "-"+++insert_dot_in_string s l d;
insert_dot_in_string s l d = s % (0,l-1-d) +++"."+++ s % (l-d,l-1);
format_profile total_strict_calls total_lazy_calls total_curried_calls total_allocation total_time profile_list
= ([format_profile p \\ p<-profile_list],
{
f_module_name = "All Modules",
f_function_name="Total",
f_n_strict_calls=total_strict_calls,
f_n_lazy_calls=total_lazy_calls,
f_n_curried_calls=total_curried_calls,
f_n_allocated_bytes=PCorMac total_allocation (total_allocation<<2),
f_alloc_percentage=100.0,
f_time=total_time,
f_time_percentage=100.0
});
{
format_profile {module_name,function_name,n_strict_calls,n_lazy_calls,n_curried_calls,n_allocated_words,time}
= {
f_module_name=module_name,
f_function_name=function_name,
f_time=time,
f_time_percentage=(time*100.0)/total_time,
f_n_allocated_bytes=PCorMac n_allocated_words (n_allocated_words<<2),
f_alloc_percentage=(toReal (n_allocated_words)*100.0)/toReal total_allocation,
f_n_strict_calls=n_strict_calls,
f_n_lazy_calls=n_lazy_calls,
f_n_curried_calls=n_curried_calls
};
}
sum_time_and_allocation l = foldl add_time_and_allocation (0,0,0,0,0.0) l;
{
add_time_and_allocation (s,l,c,a,t) {function_name,n_strict_calls,n_lazy_calls,n_curried_calls,n_allocated_words,time}
| n_allocated_words>=0
= (s+n_strict_calls,l+n_lazy_calls,c+n_curried_calls,a+n_allocated_words,t+time)
= (s+n_strict_calls,l+n_lazy_calls,c+n_curried_calls,a,t+time);
}
totals_per_module []
= [];
totals_per_module [f=:{module_name}:l]
# (functions,l) = split_at_next_module l;
with {
split_at_next_module []
= ([],[]);
split_at_next_module l=:[f=:{module_name=m}:t]
| m==module_name
# (functions,l) = split_at_next_module t;
= ([f:functions],l);
= ([],l);
}
# functions = [f:functions];
# (total_strict_calls,total_lazy_calls,total_curried_calls,total_allocation,total_time) = sum_time_and_allocation functions;
# new_module =
{module_name=module_name,
function_name="Module "+++module_name,
n_strict_calls=total_strict_calls,
n_lazy_calls=total_lazy_calls,
n_curried_calls=total_curried_calls,
n_allocated_words=total_allocation,
time=total_time
};
= [new_module:totals_per_module l];
read_profile file
// # (processor,processor_clock,bus_clock,file) = read_processor_information file;
# (_,clock_speed,overhead) = clock_speed_and_profile_overhead;
// # clock_speed=abort "read_profile";
// # overhead=abort "read_profile";
// = read_function_profiles (PCorMac (compute_time_x86 (clock_speed*1.0E6) overhead) (compute_time processor processor_clock bus_clock)) file;
= read_function_profiles (compute_time_x86 (clock_speed*1.0E6) overhead) file;
read_processor_information file
# (ok,processor,file)=freadi file;
| not ok
= error file;
# (ok,processor_clock,file)=freadi file;
| not ok
= error file;
# (ok,bus_clock,file)=freadi file;
| not ok
= error file;
# (ok,c,file) = freadc file;
| not ok || c<>'\n'
= error file;
= (processor,processor_clock,bus_clock,file);
{}{
error file = (0,1,1,file);
}
TwoPower32Real:==4294967296.0;
PowerPC601GestaltNumber:==257;
PowerPC750GestaltNumber:==264;
PowerPC7400GestaltNumber:==268;
PowerPC603604ProfileOverhead:==10.0;
PowerPC750ProfileOverhead:==7.0;
compute_time processor processor_clock bus_clock
| processor==PowerPC601GestaltNumber
= \ (time_hi,time_lo,n_profiler_calls)
-> toReal time_hi + (toReal time_lo / 1E+9) - (toReal n_profiler_calls*16.0/toReal processor_clock);
| processor>=PowerPC750GestaltNumber
= \ (time_hi,time_lo,n_profiler_calls)
-> ((toReal time_hi*TwoPower32Real + (if (time_lo>=0) (toReal time_lo) (TwoPower32Real+toReal time_lo)))*4.0)/toReal bus_clock
- (toReal n_profiler_calls*PowerPC750ProfileOverhead/toReal processor_clock);
= \ (time_hi,time_lo,n_profiler_calls)
-> ((toReal time_hi*TwoPower32Real + (if (time_lo>=0) (toReal time_lo) (TwoPower32Real+toReal time_lo)))*4.0)/toReal bus_clock
- (toReal n_profiler_calls*PowerPC603604ProfileOverhead/toReal processor_clock);
compute_time_x86 processor_clock profile_overhead
= \ (time_hi,time_lo,n_profiler_calls)
-> (toReal time_hi*TwoPower32Real + (if (time_lo>=0) (toReal time_lo) (TwoPower32Real+toReal time_lo)))/toReal processor_clock
- (toReal n_profiler_calls*profile_overhead/toReal processor_clock);
read_function_profiles compute_time_function file
# (ok,function_profile,file) = read_function_profile file;
| not ok
= ([],file);
# (profile,file) = read_function_profiles compute_time_function file;
= ([function_profile : profile],file);
{}{
read_function_profile file
# (ok,module_name,file) = read_function_name file;
| not ok
= error file;
# (ok,function_name,file) = read_function_name file;
| not ok
= error file;
# (ok,n_strict_calls,file)=freadi file;
| not ok
= error file;
# (ok,n_lazy_calls,file)=freadi file;
| not ok
= error file;
# (ok,n_curried_calls,file)=freadi file;
| not ok
= error file;
# (ok,n_profiler_calls,file)=freadi file;
| not ok
= error file;
# (ok,n_allocated_words,file)=freadi file;
| not ok
= error file;
# (ok,time_hi,file)=freadi file;
| not ok
= error file;
# (ok,time_lo,file)=freadi file;
| not ok
= error file;
# (ok,c,file) = freadc file;
| not ok || c<>'\n'
= error file;
# time = compute_time_function (time_hi,time_lo,n_profiler_calls);
= (True,{ module_name=module_name,
function_name=function_name,n_strict_calls=n_strict_calls,n_lazy_calls=n_lazy_calls,
n_curried_calls=n_curried_calls,n_allocated_words=n_allocated_words,time=time},file);
{}{
error file = (False,abort "error in read_function_profile",file);
}
read_function_name file
# (ok,c,file) = freadc file;
| not ok || c==' ' || c=='\n'
= (False,"",file);
# (_,s,file) = read_function_name file
= (True,toString c+++s,file);
}
ge_profile_time {f_time=time1}{f_time=time2} = time1>=time2;
import deltaEventIO,deltaPicture, deltaIOState;
from deltaWindow import DrawInActiveWindowFrame,ChangePictureDomain,DrawInWindow;
from deltaSystem import MaxFixedWindowSize;
from deltaFileSelect import SelectInputFile;
from deltaWindow import OpenWindows,CloseWindows;
from deltaMenu import EnableMenus,DisableMenus,EnableMenuItems,DisableMenuItems;
(<::) infix;
(<::) f t:== f a b; { (a,b)=t };
(AP3) infix;
(AP3) f t:== f a b c; { (a,b,c)=t };
(>:) infixl;
(>:) f g:== g f;
draw_string_at position s picture
:== picture >: MovePenTo position >: DrawString s;
monaco9_font
// # (ok,font)=SelectFont (PCorMac "Arial" "Monaco") [] 9;
# (ok,font)=SelectFont ("helvetica") [] 9;
// | ok
= font;
geneva6_font
// # (ok,font)=SelectFont (PCorMac "Arial" "Geneva") [] (PCorMac 7 6);
# (ok,font)=SelectFont ("helvetica") [] (PCorMac 7 6);
= font;
geneva8_font
// # (ok,font)=SelectFont (PCorMac "Arial" "Geneva") [] (PCorMac 9 8);
# (ok,font)=SelectFont ("helvetica") [] (PCorMac 9 8);
= font;
Pos0:==4;
Pos1:==300;
Pos2:==440;
Pos3:==540;
Pos4:==600;
Pos5:==680;
Pos6:==740;
Pos7:==800;
Pos8:==860;
WindowWidth:==940;
PPrinterPos0:==2;
PPrinterPos1:==30*5;
PPrinterPos2:==44*5;
PPrinterPos3:==54*5;
PPrinterPos4:==60*5;
PPrinterPos5:==68*5;
PPrinterPos6:==74*5;
PPrinterPos7:==80*5;
PPrinterPos8:==86*5;
PPrinterWindowWidth:==94*5;
LPrinterPos0:==3;
LPrinterPos1:==30*8;
LPrinterPos2:==44*8;
LPrinterPos3:==54*8;
LPrinterPos4:==60*8;
LPrinterPos5:==68*8;
LPrinterPos6:==74*8;
LPrinterPos7:==80*8;
LPrinterPos8:==86*8;
LPrinterWindowWidth:==94*8;
draw_table :: [FormattedProfile] [((a,.Int),(b,.Int))] {#Int} .Int .Int Font *Picture -> *Picture;
draw_table profile area column_positions window_width char_width window_font p
= p >: SetFont window_font
>: draw_table_header (2+ascent) (2+line_height) window_width
>: draw_profile_lines profile (4+ascent+line_height) line_height area;
{
line_height=ascent+descent+1;
(ascent,descent,_,_)=FontMetrics window_font;
draw_profile_lines function_profiles y line_height area picture
= draw_profile_lines function_profiles y picture;
{
in_area y [((x1,y1),(x2,y2)):areas]
= (y >= y1-line_height && y <= y2+line_height) || in_area y areas;
in_area y []
= False;
draw_profile_lines [] y picture
= picture;
draw_profile_lines [{f_module_name,f_function_name,f_time,f_time_percentage,f_n_allocated_bytes,f_alloc_percentage,f_n_strict_calls,f_n_lazy_calls,f_n_curried_calls}:function_profiles] y picture
| in_area y area