Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
! File Access Modes
OMIT('__FileAccessModes__',FileAccessMode:WriteOnly)
!FILE:ReadOnly EQUATE ( 0H)
!FILE:WriteOnly EQUATE ( 1H)
!FILE:ReadWrite EQUATE ( 2H)
!!-------------
!FILE:AnyAccess EQUATE ( 0H)
!FILE:DenyAll EQUATE (10H)
!FILE:DenyWrite EQUATE (20H)
!FILE:DenyRead EQUATE (30H)
!FILE:DenyNone EQUATE (40H)
!FILE:Default EQUATE (FILE:ReadWrite + FILE:DenyWrite)
FileAccessMode:ReadOnly EQUATE ( 0H)
FileAccessMode:WriteOnly EQUATE ( 1H)
FileAccessMode:ReadWrite EQUATE ( 2H)
!-------------
FileAccessMode:AnyAccess EQUATE ( 0H)
FileAccessMode:DenyAll EQUATE (10H)
FileAccessMode:DenyWrite EQUATE (20H)
FileAccessMode:DenyRead EQUATE (30H)
FileAccessMode:DenyNone EQUATE (40H)
FileAccessMode:Default EQUATE (FileAccessMode:ReadWrite + FileAccessMode:DenyWrite)
FileAccessMode:ReadWrite_DenyNone EQUATE (FileAccessMode:ReadWrite + FileAccessMode:DenyNone)
!end-OMIT('__FileAccessModes__',FILE:WriteOnly)
#pragma define(asserts=>on)
#pragma define(profile=>on)
#if define(profile)=on #then
#message "profile is ON -- adding ProfileMG and the ASCII Driver"
#message "profile is ON -- adding ProfileMG and the ASCII Driver"
-- #compile "Profile.clw" /define(profile=>off)
#compile "ProfileMG.clw" /define(profile=>off)
#pragma link("C%V%ASC%X%%L%.LIB")
#else
#message "profile is OFF"
#endif
MEMBER
pragma('define(init_priority=>2)')
INCLUDE('FileAccessModes.EQU'),ONCE
MAP
EnterProc(UNSIGNED Line,*CSTRING Proc,*CSTRING File),NAME('Profile:EnterProc')
LeaveProc(),NAME('Profile:LeaveProc')
ShowOutput(STRING xMessage)
MODULE('C%V%RUN%X%')
Profile_PrintDebugSTRING(string argString ),pascal,dll(1),name('WslDebug$Print')
Profile_PrintDebugEvent ( ),pascal,dll(1),name('WslDebug$PrintEvent') !Prints something like: "EVENT:Selected ?BUTTON1 (1)<13,10>"
END
END
! Omit('************** Documentation ****************')
! @================================================================================================
! Purpose : To support the pragma profile=>on
! note: CASE SENSITIVE: it seems that Profile=>on doesn`t work, but profile=>on does work
!
! Notice : This code evolved from a copy of C55\Libsrc\Profile.clw
! It has been modified by Mark Goldberg (Clarion@MonolithCC.com)
!
!
! How to Use:
! In the project editor -> (top line) Properties -> Define
! add the define: profile
! note: this IS CASE SENSITIVE
!
! In the project editor -> add file
! add ProfileMG.PR
!
! If the line USE_DEBUGER is TRUE then use DebugView from www.sysinternals.com to view messages
! make sure your FILTER is set to show the messages
!
! If the line USE_DEBUGER is TRUE then look at C%V%LOG.TXT file
! note: %V% is the version of Clarion, as in 50,55,60 etc.
!
!
! Updates : June 4th, 2003 - Tested using SkipW`s Debuger, was failing because the 2nd arg was not TRUE
! - Currently configured use the Debuger
! - Added prototypes for Profile_PrintDebugString from the RTL
!
! @================================================================================================
! Omit('************** Documentation ****************')
!!! --- contents of ProfileMG.PR
!!! -- Note: should be modified to use the .RED vs. hardwired paths on the #compile line.
!!!
!!! --#if "define(profile)"="on" #then
!!!
!!! #if define(profile)=on #then
!!! #message "profile is ON -- adding ProfileMG and the ASCII Driver"
!!! #message "profile is ON -- adding ProfileMG and the ASCII Driver"
!!!
!!! #compile "c:\cla\shared\libsrc\ProfileMG.clw" /define(profile=>off)
!!! #pragma link("C%V%ASC%X%%L%.LIB")
!!! #else
!!! #message "profile is OFF"
!!! #endif
!!!
!!! --- contents of ProfileMG.PR -end
Use_Debuger EQUATE(TRUE) !TRUE => use Skip Williams Debugger
!FALSE => use PrintDebugString, which will add the text to C%V%LOG.txt
! (ex: C55LOG.txt when using C55, or C60LOG.txt when using C6)
mod:CallDepth Long(0),Static
mod:EnterCount Long(0),Static
mod:LeaveCount Long(0),Static
Q QUEUE
Line UNSIGNED
File STRING(40)
Proc STRING(60)
!Used LONG
Thread Byte
Time Time
Depth LIKE(mod:CallDepth)
END
compile('***',Use_Debuger)
INCLUDE('Debuger.inc'),ONCE
ProfileDBG LIKE(Debuger)
!-end compile('***',Use_Debuger)
!MOD:Track:Enter BOOL(FALSE)
!MOD:Track:Leave BOOL(FALSE)
C CLASS
BuildQ BOOL(FALSE)
ShowOutput BOOL(FALSE) !<--- important to remember this
QueueToFile BOOL( TRUE)
Construct PROCEDURE
Destruct PROCEDURE !Purpose: to dump the Q on program termination
QueueToFile PROCEDURE
END
COMPILE('***',profile)
Don`t try and profile this, you get infinite recursion!
Set profile=>off on this module in the project
This comment will prevent you from compiling without the profile=>off on this module
***
MyIndent STRING(' .{512}') !<-- this is LESS of a limitation than P.B above
!====================================================================
C.Construct PROCEDURE
code
! ProfileDBG.INIT('Profile',,0)
SELF.BuildQ = TRUE
SELF.ShowOutput = TRUE
SELF.QueueToFile = TRUE
compile('***',Use_Debuger)
ProfileDBG.INIT('Profile',TRUE,0)
ProfileDBG.DebugOut('ProfileDBG Initialized')
!-end compile('***',Use_Debuger)
!====================================================================
C.Destruct PROCEDURE
CODE
IF SELF.QueueToFile
SELF.QueueToFile()
END
!====================================================================
EnterProc PROCEDURE(unsigned Line,*cstring Proc,*cstring File)
CODE
IF SIZE(Proc) > 7 |
AND Proc[1] = 'P' |
AND Proc[2] = 'R' |
AND Proc[3] = 'O' |
AND Proc[4] = 'F' |
AND Proc[5] = 'I' |
AND Proc[6] = 'L' |
AND Proc[7] = 'E' |
AND Proc[8] = ':' |
THEN
CASE Proc
OF 'PROFILE:SHOW:ON' ; C.ShowOutput = TRUE ; profileDBG.DebugOut('Proc['& Proc &']')
OF 'PROFILE:SHOW:OFF' ; C.ShowOutput = FALSE ; profileDBG.DebugOut('Proc['& Proc &']')
OF 'PROFILE:BUILDQ:ON' ; C.BuildQ = TRUE ; profileDBG.DebugOut('Proc['& Proc &']')
OF 'PROFILE:BUILDQ:OFF' ; C.BuildQ = FALSE ; profileDBG.DebugOut('Proc['& Proc &']')
OF 'PROFILE:QTOFILE:ON' ; C.QueueToFile = TRUE ; profileDBG.DebugOut('Proc['& Proc &']')
OF 'PROFILE:QTOFILE:OFF' ; C.QueueToFile = FALSE ; profileDBG.DebugOut('Proc['& Proc &']')
END
END
mod:EnterCount += 1
mod:CallDepth += 1
IF C.BuildQ
DO AddQ
END
IF C.ShowOutput
ShowOutput(Left (File , size(Q.File)+1) |
& Right(Line , 6 ) & ' ' |
& Right(THREAD() , 3 ) & ' ' |
& choose( inrange( mod:CallDepth,1,size(MyIndent)) , MyIndent[ 1 : MOD:CallDepth ], '['& MOD:CallDepth &']-' ) |
& Proc |
& '--Enter' |
)
END
AddQ ROUTINE
Q.Line = Line
Q.File = File
Q.Proc = Proc
Q.Thread = Thread()
Q.Time = Clock()
Q.Depth = mod:CallDepth
ADD(Q)
!====================================================================
ShowOutput PROCEDURE(STRING xMessage)
CODE
compile('***',Use_Debuger)
ProfileDBG.DebugOut(xMessage)
!-end compile('***',Use_Debuger)
omit('***',Use_Debuger)
Profile_PrintDebugString(xMessage & '<13,10>')
!-end omit('***',Use_Debuger)
!====================================================================
LeaveProc PROCEDURE()
!MyIndent EQUATE(' .{512}') !<-- this is LESS of a limitation than P.B above
CODE
!IF ~MOD:Track:Leave THEN RETURN END
IF C.BuildQ
DO AddQ
END
mod:CallDepth -= 1
mod:LeaveCount += 1
IF C.ShowOutput
! problem when ~BuildQ
ShowOutput( Left ('' , size(Q.File)+1) |
& Right(0 , 6 ) & ' ' |
& Right(Thread() , 3 ) & ' ' |
& choose( inrange(MOD:CallDepth,1,size(MyIndent)) ,MyIndent[ 1 : MOD:CallDepth ], '['& MOD:CallDepth &']-' ) |
|& Q.Proc & |
& '--Leave' |
)
!-end compile('***',Use_Debuger)
END
AddQ ROUTINE
Q.Line = 0
Q.File = '' !tried '<', but it seems to clutter the output
Q.Proc = ''
Q.Depth = mod:CallDepth
Q.Thread = Thread()
Q.Time = Clock()
add(Q)
!====================================================================
C.QueueToFile PROCEDURE
P FILE,DRIVER('ASCII', '/CLIP=on'),CREATE,NAME('Profile.txt')
R RECORD
B STRING(512) !<-- 512 could be a limitation here, especially with the depth representation
END
END
I LONG,auto
Time_First Time,auto
Time_Last Time,auto
Time_Curr Time,auto
Time_Delta Time,auto
!MyIndent STRING(' .{512}') !<-- this is LESS of a limitation than P.B above
!<-- note: if you are squeemish about the 512 here, then replace the string slice, with ALL('.',Q.Depth)
Time_Threshold uLong(1) !<-- consider adding an getIni for this value
CODE
!SORT(Q,-Q.Used)
CREATE(P)
ASSERT(~ERRORCODE())
OPEN(P, FileAccessMode:Default)
ASSERT(~ERRORCODE())
! 1 2 3 4 5 7 8 9 10 11 12 13 14 15 17 18 19 20 21 22 23 24 5 7 8 9 10
!123456789-123456789-123456789-123456789-123456789-123456789-123456789-123456789-123456789-123456789-123456789-123456789-123456789-123456789-123456789-123456789-123456789-123456789-123456789-123456789-123456789-123456789-
! 123456 123456 12345678 123456789-
P.B = 'Program Exited:' &FORMAT(TODAY(),@D17) &' at: '& format(clock(),@t7); add(P)
P.B = 'Enter Count ['& mod:EnterCount &'] Leave Count ['& mod:LeaveCount &']'; add(p)
P.B = ' Time' ; add(p)
P.B = 'File Line Thread Time Delta Procedure'; add(p)
P.B = '---------------------------------------- ------ ------ -------- ----- ---------------------------------------------------------------------------------'; add(p)
! P.B = '---------------------------------------- ------ ------ -------- ---------- ---------------------------------------------------------------------------------'; add(p)
P.B = ''; ADD(P)
if Records(Q)
get(Q,1)
Time_First= Q.Time
end
Time_Last = Time_First
Loop I = 1 to Records(Q)
get(Q,I)
Time_Curr = Q.Time - Time_First
Time_Delta = Time_Curr - Time_Last
P.B = Left (Q.File , size(Q.File)+1) & |
Right(Q.Line , 6 ) & ' ' & |
Right(Q.Thread , 6 ) & ' ' & |
Right(Time_Curr, 8 ) & ' ' & |
Choose(Time_Delta = 0,'<32>{6}', Right(Time_Delta,5 ) & choose(Time_Delta > Time_Threshold,'@',' ')) & |
choose( inrange(Q.Depth,1,size(MyIndent)) ,MyIndent[ 1 : Q.Depth ], '['&Q.Depth&']-' ) & Q.Proc
Add(P)
Time_Last = Time_Curr
end
CLOSE(P)
Run('Notepad profile.txt')
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.