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
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
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
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
.global has_time_stamp_counter
has_time_stamp_counter:
push %ebx
push %ecx
push %edx
pushfl
mov $0x200000,%eax
pop %ebx
xor %ebx,%eax
push %eax
popfl
pushfl
pop %eax
xor %ebx,%eax
jz no_cpuid_instruction
mov $1,%eax
.byte 0x0f,0xa2 # cpuid
shr $4,%edx
mov $1,%eax
and %edx,%eax
no_cpuid_instruction:
pop %edx
pop %ecx
pop %ebx
ret
.global read_time_stamp_counter
read_time_stamp_counter:
push %ecx
push %edx
movl 12(%esp),%ecx
.byte 0x0f,0x31 # rdtsc
movl %eax,0(%ecx)
movl %edx,4(%ecx)
pop %edx
pop %ecx
ret
.global compute_profile_overhead
compute_profile_overhead:
jmp compute_profile_overhead_
profile_:
push %eax
push %edx
.byte 0x0f,0x31 # rdtsc
sub g_time_lo,%eax
sbb g_time_hi,%edx
add %eax,p_time_lo
adc %edx,p_time_hi
.byte 0x0f,0x31 # rdtsc
mov %edx,g_time_hi
pop %edx
mov %eax,g_time_lo
pop %eax
ret
compute_profile_overhead_:
mov 4(%esp),%eax
push %ebx
push %ecx
push %edx
push %ebp
xor %ecx,%ecx
xor %edx,%edx
mov $100000,%ebx
call profile_
mov %ecx,p_time_lo
mov %edx,p_time_hi
compute_profile_overhead_lp1:
lea p_time_lo,%ebp
call profile_
add %ecx,%ecx
add %edx,%edx
sub $1,%ebx
jne compute_profile_overhead_lp1
mov p_time_lo,%ecx
mov p_time_hi,%edx
mov %ecx,0(%eax)
mov %edx,4(%eax)
xor %ecx,%ecx
xor %edx,%edx
mov $100000,%ebx
call profile_
mov %ecx,p_time_lo
mov %edx,p_time_hi
compute_profile_overhead_lp2:
add %ecx,%ecx
add %edx,%edx
sub $1,%ebx
jne compute_profile_overhead_lp2
call profile_
mov p_time_lo,%ecx
mov p_time_hi,%edx
mov %ecx,8(%eax)
mov %edx,12(%eax)
pop %ebp
pop %edx
pop %ecx
pop %ebx
ret
This diff is collapsed.
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment