Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
clean-and-itasks
clean-ide
Commits
20f15543
Commit
20f15543
authored
Feb 21, 2003
by
Diederik van Arkel
Browse files
TimeProfiler platform dependencies
parent
5bba00ad
Changes
3
Hide whitespace changes
Inline
Side-by-side
TimeProfile/ShowProfile.dcl
View file @
20f15543
...
...
@@ -7,7 +7,7 @@ import StdIOCommon, StdPicture, StdPSt, StdPrint
open_profile
::
{#.
Char
}
!*
a
->
*((.
Bool
,[.
Profile
]),!*
a
)
|
FileSystem
a
;
sum_time_and_allocation
::
![.
Profile
]
->
.(
Int
,
Int
,
Int
,
Int
,
Real
);
totals_per_module
::
![.
Profile
]
->
!
[.
Profile
]
totals_per_module
::
![.
Profile
]
->
[.
Profile
]
format_profile
::
.
Int
.
Int
.
Int
.
Int
.
Real
[.
Profile
]
->
([.
FormattedProfile
],.
FormattedProfile
);
le_module_name
::
!.
Profile
!.
Profile
->
Bool
;
...
...
TimeProfile/ShowProfile.icl
View file @
20f15543
...
...
@@ -228,7 +228,7 @@ where
=
(
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
::
![.
Profile
]
->
!
[.
Profile
]
totals_per_module
::
![.
Profile
]
->
[.
Profile
]
totals_per_module
[]
=
[]
totals_per_module
[
f
=:{
module_name
}:
l
]
...
...
@@ -355,7 +355,7 @@ where
where
error
file
=
(
False
,
abort
"error in read_function_profile"
,
file
)
read_function_name
::
!*
File
->
!
(!
Bool
,!
String
,!*
File
)
read_function_name
::
!*
File
->
(!
Bool
,!
String
,!*
File
)
read_function_name
file
#
(
ok
,
c
,
file
)
=
freadc
file
|
not
ok
||
c
==
' '
||
c
==
'\n'
...
...
TimeProfile/timeprofiler.icl
View file @
20f15543
...
...
@@ -4,10 +4,10 @@ import StdArray, StdBool, StdList, StdFunc, StdTuple, StdOrdList
import
StdProcess
,
StdId
,
StdMenu
,
StdReceiver
,
StdMenuElement
,
StdFileSelect
,
StdPStClass
import
flexwin
import
ArgEnv
import
ExtNotice
import
Help
import
ShowProfile
import
Platform
ApplicationName
:==
"ShowTimeProfile"
HelpFileName
:==
ApplicationName
+++
"Help"
...
...
@@ -72,7 +72,7 @@ where
#
(_,
ps
)
=
openMenu
Void
(
sort_menu
recId
)
ps
#
(_,
ps
)
=
openMenu
Void
(
view_menu
recId
)
ps
#
(_,
ps
)
=
openMenu
Void
(
help_menu
)
ps
=
ps
=
installPlatformEventHandlers
ps
file_menu
hasClose
winId
closeId
printId
recId
=
Menu
"&File"
...
...
@@ -130,23 +130,15 @@ info =
//-- Support functions...
open_time_file_from_command_line
ps
|
size
commandline
==
1
=
(([],[],
""
),
ps
)
#
(
ok
,
pathname
)
=
GetLongPathName
commandline
.[
1
]
|
not
ok
#
(
commandline
,
ps
)
=
initPlatformCommandLine
ps
|
length
commandline
<=
1
=
(([],[],
""
),
ps
)
=
open_file_function
pathname
ps
where
commandline
=
getCommandLine
=
open_file_function
(
commandline
!!
1
)
ps
openFiles
_
_
_
_
[]
ps
=
ps
openFiles
winId
closeId
printId
recId
[
h
:
t
]
ps
#
(
ok
,
pathname
)
=
GetLongPathName
h
|
not
ok
=
ps
#
((
mods
,
funs
,
name
),
ps
)
=
open_file_function
pathname
ps
=
open_file_function
h
ps
#
(
viewer_mode
,
ps
)
=
accPLoc
(\
vs
=:{
mode
}->
(
mode
,{
vs
&
mods
=
mods
,
funs
=
funs
,
name
=
name
}))
ps
#
info
=
case
viewer_mode
of
ViewByModule
->
mods
...
...
@@ -234,12 +226,16 @@ printfun recId ps
=
ps
#
info
=
fromJust
info
#
(
functionData
,[
sumData
:_])
=
splitAt
(
dec
(
length
info
))
info
#
((
ok
,
printFont
),
ps
)
=
accPIO
(
accScreenPicture
(
openFont
{
fName
=
"Courier New"
,
fStyles
=[
BoldStyle
],
fSize
=
8
}
))
ps
|
not
ok
=
ps
#
((
ok
,
printFont
),
ps
)
=
accPIO
(
accScreenPicture
(
openFont
printFont
))
ps
//
| not ok
//
= ps
#
(
printSetup
,
ps
)
=
printTable
printFont
printSetup
functionData
sumData
ps
#
ps
=
appPLoc
(\
vs
->
{
vs
&
pset
=
printSetup
})
ps
=
ps
where
printFont
=
PlatformDependant
{
fName
=
"Courier New"
,
fStyles
=[
BoldStyle
],
fSize
=
8
}
{
fName
=
"Monaco"
,
fStyles
=[],
fSize
=
8
}
//-- Profile stuff...
...
...
@@ -296,10 +292,3 @@ where
#
line_height
=
fontLineHeight
metrics
=
line_height
*
(
length
lines
)
//--
import
expand_8_3_names_in_path
GetLongPathName
::
!
String
->
(!
Bool
,!
String
);
GetLongPathName
short_path
=
(
True
,
expand_8_3_names_in_path
short_path
);
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment