FileAccessModes.equ

! 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)

MyProjectSettings.pr

#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

ProfileMg.clw

  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')