PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

Will GetCaller() macro work in PB v6?

https://www.purebasic.fr/english/viewtopic.php?t=76935

Page 1 of 1

Will GetCaller() macro work in PB v6?

Posted: Thu Mar 18, 2021 9:05 pm
by skywalk
I prefer prototypes instead of "procedure xyz() for somestructure".
However, this requires the inline ASM macro GetCaller() to work in the proposed PB -> emit C -> compiler.
Will the code below work in PB v6?

Code: Select all

;////////////////////////////////////////////////
; REV:  051121, skywalk
;       millisecond timer class for medium time critical measurements.
;       Uses Prototypes in Structure instead of Interfaces and Virtual Table pointers.
;       Simpler to build, but carries redundancy in subsequent calls.
;       Ex. t1\Start(t1) ;<-- t1 must be passed to itself if GetCaller(t1) fails.
; REV:  120901, skywalk
;       Updated To PB. Inspired by PB OOP examples from Hydrate, ts-soft
; REV:  121223, skywalk
;       Collapsed GetTime() to Stop().
; Format for classes:
;   PROTOTYPES      - Only necessary for methods not in parent classes. Declared 1st so structure can read it.
;   STRUCTURE       - Variables, then Methods. Order unimportant. - METHODNAME.PROTOTYPE
;   METHODS         - Use prefix 'CLASSNAME_' to distinguish between procedures.
;   PROPERTIES      - Get/Set using Structure Fields.
;   CONSTRUCTOR     - Not in structure and defined last to set all method pointers appropriately.
;   DESTRUCTOR      - Not in structure.
; Requires Windows APIs:
; BOOL QueryPerformanceCounter  (LARGE_INTEGER *lpPerformanceCount) ; kernel32.dll
; BOOL QueryPerformanceFrequency(LARGE_INTEGER *lpFrequency)        ; kernel32.dll
; NOTES:
;   cTimer reports units in seconds! Use Eng notation to determine ms, ns, etc.
;   PB v5.21b2 adds QueryPerformanceCounter_() for ElapsedMilliseconds().
;   But return value will wrap after 49.7 days due to integer instead of quad.
;   Steps to use cTimer.
;     1. Define t1.cTimer
;     2. Call:  cTimer_New(t1)
;     3. t1\Start()...do something...t1\Stop()
;     4. Read out Stop Time or Running Time:
;        Debug t1\Stop()      ; Elapsed time(s) between Last Start() and This Stop()
;        Debug t1\RunTime()   ; Total running time(s) since 1st Start()
;     5. Call:  cTimer_Free(t1)
;-} END cTimer.pbi Header
EnableExplicit
CompilerIf #PB_Compiler_Version > 573
  CompilerError "Warning: Check ASM-Compiler for valid RBP-Register!"
CompilerEndIf
Macro GetCaller(me) ; Get struct pointer from caller
  CompilerIf #PB_Compiler_Processor = #PB_Processor_x64
    !mov [p.p_me], rbp
  CompilerElse
    !mov [p.p_me], ebp
  CompilerEndIf
EndMacro
Prototype   cTimer_OverHead();*me)
Prototype   cTimer_Start()   ;*me)
Prototype.d cTimer_Stop()    ;*me)
Prototype.d cTimer_RunTime() ;*me)
Structure cTimer
  ri.i                          ; API return values
  HiResCounter.i                ; 1 = HiResCounter enabled, 0 = Fail
  Freq.q                        ; Counter Resolution(ticks/sec),     Ex. i5-2540M @ 2.6GHz ~= 390nsec
  OverHead.q                    ; Ticks, (not seconds) of API calls, Ex. i5-2540M @ 2.6GHz ~= 13ticks
  Period.q                      ; Length of Time(ticks) between Timer Start and Stop.
  StartTick.q                   ; Start(ticks) used to determine Time Period
  StartTick1st.q                ; Remember 1st Start Tick for Timer total run time.
                                ; Method.Prototype section
  GetOverHead.cTimer_OverHead   ; Determine overhead of API calls
  Start.cTimer_Start            ; Start the Timer
  Stop.cTimer_Stop              ; Stop the Timer and determine Period, then Read out Time Period between Last Start & This Stop
  Run_Time.cTimer_RunTime       ; Read out Running Time from 1st Start
EndStructure
Procedure cTimer_OverHead();*me.cTimer)
                           ; Determine Overhead(ticks) of API calls using 30 averages.
  Protected *me.cTimer
  GetCaller(*me)
  Protected.i i
  Protected.q Tick1, avg
  *me\OverHead = 0
  For i = 1 To 30
    *me\ri = QueryPerformanceCounter_(@Tick1)
    Delay(0)  ;<-- Overhead = 0 without break between 2 calls.
    *me\ri = QueryPerformanceCounter_(@avg)
    avg - Tick1
    *me\OverHead + avg
  Next i
  *me\OverHead / i
EndProcedure
Procedure cTimer_Start();*me.cTimer)
  Protected *me.cTimer
  GetCaller(*me)
  *me\ri = QueryPerformanceCounter_(@*me\StartTick)
  If *me\StartTick1st = 0
    *me\StartTick1st = *me\StartTick
  EndIf
EndProcedure
Procedure.d cTimer_Stop();*me.cTimer)
                         ; This does not end the Timer.
                         ; Update Time Elapsed between this StopTimer() and previous StartTimer() calls.
  Protected *me.cTimer
  GetCaller(*me)
  Protected.q Tick2
  *me\ri = QueryPerformanceCounter_(@Tick2)
  *me\Period = Tick2 - *me\StartTick
  ; StopTime(seconds) uses TimePeriod from last call of cTimer_Stop().
  ; Otherwise, StopTime holds its previous value.
  ; Subsequent calls to cTimer_Stop() change/update StopTime.
  ; Start() followed by immediate Stop() will reveal OverHead or negative times.
  If *me\StartTick1st
    ProcedureReturn (0.0 + *me\Period - *me\OverHead) / *me\Freq
  EndIf
EndProcedure
Procedure.d cTimer_RunTime();*me.cTimer)
                            ; RunTime(s) from 1st cTimer_Start(). Resets if *me\StartTick1st = 0 or new creation of class cTimer.
  Protected *me.cTimer
  GetCaller(*me)
  Protected.q Tick2
  If *me\StartTick1st
    *me\ri = QueryPerformanceCounter_(@Tick2)
    ProcedureReturn (0.0 + Tick2 - *me\StartTick1st - *me\OverHead) / *me\Freq
  EndIf
EndProcedure
Procedure cTimer_Free(*me.cTimer)
  ;- cTimer DESTRUCTOR
  ; Terminate/Free the class cTimer
  *me\Freq = 0
  *me\Period = 0
  *me\StartTick = 0
  *me\StartTick1st = 0
  *me\OverHead = 0
  *me\HiResCounter = 0
  *me\ri = 0
  ClearStructure(*me, cTimer)
EndProcedure
Procedure cTimer_New(*me.cTimer)
  ;- cTimer CONSTRUCTOR
  ; Define Method/Procedure pointers
  *me\GetOverHead         = @cTimer_OverHead()
  *me\Start               = @cTimer_Start()
  *me\Stop                = @cTimer_Stop()
  *me\Run_Time            = @cTimer_RunTime()
  *me\Period = 0
  *me\StartTick = 0
  *me\StartTick1st = 0
  ; Check for high-resolution performance counter, then determine timing overhead
  If QueryPerformanceFrequency_(@*me\Freq)
    *me\HiResCounter = 1
    *me\GetOverHead();*me)
                     ;*me\Start()
                     ;*me\Start()
                     ;Delay(0)
                     ;*me\Stop()
  EndIf
EndProcedure
;-} END cTimer.pbi
;-{ TEST
CompilerIf 1  ;-! SET TEST
              ;-{ XINCLUDES
  #nNull              = -999.00000000000000000
  #small1             = 1e-16       ; Epsilon value: small '1' to add to double calcs to round up or prevent overflows.
  #small1_EQ          = 1e-9        ; Epsilon value: small '1' for IsEqual comparisons
  #CRLF$              = Chr(13) + Chr(10)
  #DASH$              = "-"
  #PRD$               = "."
  #CMA$               = ","
  #COLON2$            = "::"
  Macro IsInteger(x)
    ; Bool(x = Round(x, #PB_Round_Down))  ; Fails in the following case.
    ; x.d = 11.1 / 10.0 * 100.0   ; 110.99999999999999
    ; y.d = 11.1 * 100.0 / 10.0   ; 111.0
    Bool(Abs((x) - Round(x, #PB_Round_Nearest)) <= #small1)  ; Use Epsilon value instead.
  EndMacro
  Macro PB_CP
    ;ProgramFilename() + #COLON2$ + #PB_Compiler_File + #COLON2$ + #PB_Compiler_Procedure
    GetFilePart(#PB_Compiler_File, #PB_FileSystem_NoExtension) + #COLON2$ + #PB_Compiler_Procedure
  EndMacro
  Macro MRQYN(txt)  ; MessageRequester Question - [Yes] | No
    MessageRequester(PB_CP, txt, #MB_ICONQUESTION | #MB_YESNO | #MB_DEFBUTTON1)
  EndMacro
  Procedure.s StrDex(X.d, numsd.i=6, SI_units.i=0)
    ; REV:  100405, skywalk
    ; Goal:   Shrink overall width of result, instead of fixed width num2eng()
    ;         Leading/Trailing zeros including exponent and decimal point removed.
    ; Syntax:  Xstr = StrDEX(X,numsd,@dropexp=0)
    ; IN:
    ;   x = real number to be formatted.
    ;   numsd = integer specifying the total number of significant digits.
    ;           "aa.bbbe+3" -> 2 + 3 = 5
    ;   *dropexp\i = 1 removes the exponent from the result
    ; RETURN:
    ;   Xstr = string format of X using numsd significant digits in engineering notation.
    ;   *dropexp\i = exp value that was dropped from the Xstr
    Protected.i exp, nsgn
    Protected.s r$, Sgn$
    If X > 0
      Sgn$ = #Empty$    ; Goal is to shrink the overall width of the result.
    ElseIf X < 0
      Sgn$ = #DASH$    ; '-'
      X * -1
      nsgn = 1
    Else
      ProcedureReturn "0"
    EndIf
    If x <> #nNull And ((IsInteger(x) And x > 1000) Or x < 0.001)
      exp = Round(Log10(X),#PB_Round_Down)
      If exp > 0
        exp / 3 * 3
      Else
        exp = (-exp + 3) / 3 * (-3)
      EndIf
      X = X * Pow(10,-exp)
      If X >= 1000
        X / 1000
        exp + 3
      EndIf
      If X >= 100
        numsd - 3
      ElseIf X >= 10
        numsd - 2
      Else
        numsd - 1
      EndIf
      If numsd < 0
        numsd = 0
      EndIf
      If nsgn
        r$ = sgn$ + StrD(x - #small1,numsd)
      Else
        r$ = sgn$ + StrD(x + #small1,numsd)
      EndIf
      ;r$ = RTrim(r$,"0")
      r$ = RTrim(r$,#PRD$)
      If Not SI_units
        r$ + "e" + Str(exp)
      Else
        If exp >= 0
          ; SI Unit  exp:prefix names:  3:kilo,   6:Mega,      9:Giga,  12:Tera,  15:Peta,   18:Exa,   21:Zetta,  24:Yotta
          r$ + StringField(",k,M,G,T,P,E,Z,Y", exp/3+1, #CMA$)
        Else
          ; SI Unit -exp:prefix names: -3:milli, -6:micro(u), -9:nano, -12:pico, -15:femto, -18:atto, -21:zepto, -24:yocto
          r$ + StringField(",m,u,n,p,f,a,z,y", -exp/3+1, #CMA$)
        EndIf
      EndIf
    Else
      If numsd < 0
        numsd = 0
      EndIf
      If nsgn
        r$ = sgn$ + StrD(x - #small1,numsd)
      Else
        r$ = sgn$ + StrD(x + #small1,numsd)
      EndIf
      If numsd
        r$ = RTrim(r$,"0")
      EndIf
      r$ = RTrim(r$,#PRD$)
    EndIf
    ProcedureReturn r$
  EndProcedure
  ;-} XINCLUDES
  Define.s r$
  CompilerIf #PB_Compiler_Debugger = 1
    ;CompilerWarning "Debugger OFF for accurate timings!"
    r$ + "Turn Debugger OFF for accurate timings!" + #CRLF$
  CompilerEndIf
  ; Create/use 2 unique timers.
  Define t1.cTimer, t2.cTimer
  If 1
    cTimer_New(t2)
    cTimer_New(t1)
    r$ + "-- t1\Start(),t2\Start() --"
    t1\Start()
    t2\Start()
    r$ + #CRLF$ + "t2\Stop()-t1\Stop() = " + StrDex(t2\Stop()-t1\Stop(),6,1)
    r$ + #CRLF$ + "t1\HiResCounter     = " + Str(t1\HiResCounter)
    r$ + #CRLF$ + "t1\OverHead         = " + Str(t1\OverHead)
    r$ + #CRLF$ + "t1\StartTick        = " + Str(t1\StartTick)
    r$ + #CRLF$ + "-- Delay(1000) --"
    Delay(1000)
    r$ + #CRLF$ + "t1\Stop()           = " + StrDex(t1\Stop(),6,1)
    r$ + #CRLF$ + "-- t1\Start() --"
    t1\Start()
    r$ + #CRLF$ + "-- Delay(2000) --"
    Delay(2000)
    r$ + #CRLF$ + "t1\Stop()           = " + StrDex(t1\Stop(),6,1)
    r$ + #CRLF$ + "t2\Stop()           = " + StrDex(t2\Stop(),6,1)
    r$ + #CRLF$ + "t1\Run_Time()       = " + StrDex(t1\Run_Time(),6,1)
    r$ + #CRLF$ + "t2\Run_Time()       = " + StrDex(t2\Run_Time(),6,1)
    r$ + #CRLF$ + "-- cTimer_Free(t1) --"
    cTimer_Free(t1)   ; Kill t1
    cTimer_Free(t2)   ; Kill t1
                      ;Debug t1\Stop()   ;<-- ERROR, undefined object after cTimer_Free().
  EndIf
  If 0
    cTimer_New(t1)
    r$ + #CRLF$ + "-- t1\Start() --"
    t1\Start()
    r$ + #CRLF$ + "t1\HiResCounter     = " + Str(t1\HiResCounter)
    r$ + #CRLF$ + "t1\OverHead         = " + Str(t1\OverHead)
    r$ + #CRLF$ + "t1\StartTick        = " + Str(t1\StartTick)
    r$ + #CRLF$ + "-- Delay(100) --"
    Delay(100)
    r$ + #CRLF$ + "t1\Stop()           = " + StrDex(t1\Stop(),6,1)
    r$ + #CRLF$ + "-- t1\Start() --"
    t1\Start()
    r$ + #CRLF$ + "t1\Stop()           = " + StrDex(t1\Stop(),6,1)
    r$ + #CRLF$ + "t1\Run_Time()       = " + StrDex(t1\Run_Time(),6,1)
    r$ + #CRLF$ + "-- Delay(500) --"
    Delay(500)
    r$ + #CRLF$ + "t1\Stop()           = " + StrDex(t1\Stop(),6,1)
    r$ + #CRLF$ + "t1\Run_Time()       = " + StrDex(t1\Run_Time(),6,1)
    r$ + #CRLF$ + "-- Delay(50) --"
    Delay(50)
    r$ + #CRLF$ + "t1\Stop()           = " + StrDex(t1\Stop(),6,1)
    r$ + #CRLF$ + "t1\Run_Time()       = " + StrDex(t1\Run_Time(),6,1)
    r$ + #CRLF$ + "-- t1\Start() --"
    t1\Start()
    r$ + #CRLF$ + "-- Delay(50) --"
    Delay(50)
    r$ + #CRLF$ + "t1\Stop()           = " + StrDex(t1\Stop(),6,1)
    r$ + #CRLF$ + "t1\Run_Time()       = " + StrDex(t1\Run_Time(),6,1)
    r$ + #CRLF$ + "-- cTimer_Free(t1) --"
    cTimer_Free(t1)   ; Kill t1
  EndIf
  If 0
    cTimer_New(t1)
    cTimer_New(t2)
    t1\Start()
    t2\Start()
    r$ + #CRLF$ + "t1\HiResCounter     = " + Str(t1\HiResCounter)
    r$ + #CRLF$ + "t1\OverHead         = " + Str(t1\OverHead)
    r$ + #CRLF$ + "t1\StartTick        = " + Str(t1\StartTick)
    t2\Stop()
    r$ + #CRLF$ + "-- t2 stopped immediately, Delay(0) --"
    r$ + #CRLF$ + "t2\Stop()           = " + StrDex(t2\Stop(),6,1)
    Delay(100)
    r$ + #CRLF$ + "-- Delay(100) --"
    r$ + #CRLF$ + "t1\Stop()           = " + StrDex(t1\Stop(),6,1)
    Delay(100)
    r$ + #CRLF$ + "-- Delay(100) but without Stop --"
    r$ + #CRLF$ + "-- t1 readout unchanged --"
    r$ + #CRLF$ + "t1\Stop()           = " + StrDex(t1\Stop(),6,1)
    r$ + #CRLF$ + "-- t1 readout after Stop --"
    r$ + #CRLF$ + "t1\Stop()           = " + StrDex(t1\Stop(),6,1)
    r$ + #CRLF$ + "-- t1 readout after another Stop --"
    r$ + #CRLF$ + "t1\Stop()           = " + StrDex(t1\Stop(),6,1)
    ; Kill t1 and redefine...
    cTimer_Free(t1)
    Define.cTimer t1
    cTimer_New(t1)
    Delay(100)
    r$ + #CRLF$ + "-- t1 after Init() + delay(100) --"
    r$ + #CRLF$ + "t1\Stop()           = " + StrDex(t1\Stop(),6,1)
    r$ + #CRLF$ + "t1\Run_Time()       = " + StrDex(t1\Run_Time(),6,1)
    r$ + #CRLF$ + "-- t1 after t1\Start() + delay(200) --"
    t1\Start()
    Delay(200)
    r$ + #CRLF$ + "t1\Stop()           = " + StrDex(t1\Stop(),6,1)
    r$ + #CRLF$ + "t1\Run_Time()       = " + StrDex(t1\Run_Time(),6,1)
    r$ + #CRLF$ + "-- t1 after another delay(200) --"
    Delay(200)
    r$ + #CRLF$ + "t1\Stop()           = " + StrDex(t1\Stop(),6,1)
    r$ + #CRLF$ + "t1\Run_Time()       = " + StrDex(t1\Run_Time(),6,1)
    ; Kill t1,t2
    cTimer_Free(t1)
    cTimer_Free(t2)
  EndIf
  CompilerIf #PB_Compiler_Debugger = 0
    If MRQYN("cTimer Test - Copy To Clipboard?" + #CRLF$ + r$) = #PB_MessageRequester_Yes
      SetClipboardText(r$)
    EndIf
  CompilerElse
    Debug r$
  CompilerEndIf
CompilerEndIf
;-} TEST

Re: Will GetCaller() macro work in PB v6?

Posted: Thu Mar 18, 2021 10:03 pm
by Mijikai
I dont see why this should not be possible but we have to wait.
In the meantime you can simply provide the pointer as paramater (whats usually done when doing oop).
I would suggest a vTable to reduce size i personally dont like storing redundant information.

Re: Will GetCaller() macro work in PB v6?

Posted: Thu Mar 18, 2021 10:30 pm
by skywalk
The point of the code is to use GetCaller() to NOT pass a pointer for each call?
t1\Stop() instead of t1\Stop(t1)?
And to NOT use *VTable.

Re: Will GetCaller() macro work in PB v6?

Posted: Fri Mar 19, 2021 10:56 am
by Fred
From what I understand, you're relying on very specific PB generated code to grab the structured object address in your function. It could be possible on C backend using assembly code as well, but will be C compiler dependant and probably optimisation switch dependant as well. IMHO, you should use interface or pass the self pointer to the function to be on the safe side (performance wise it should be the same)

Re: Will GetCaller() macro work in PB v6?

Posted: Fri Mar 19, 2021 12:44 pm
by Rinzwind
That GetCaller breaks when you start using nested structures (fancy word: composition).

Also do not see the worry here. Even when an upgraded structure is implemented (big if, the request is not new), your code is easy to update and more robust and simple in return.

The PB-C-compiler will maybe/probably do things different in ASM. Anyway, PB-ASM-compiler will stay available for years for sure.

Btw Fiddled with this myself too: viewtopic.php?f=12&t=75529
Hence the request to add syntax to make this style easy and elegant to use. Just needs minor additions for large gains 8)

Re: Will GetCaller() macro work in PB v6?

Posted: Fri Mar 19, 2021 2:43 pm
by skywalk
@Fred - Admittedly, I am a low class user. :)
Meaning, very little OOP use. I prefer the lib_DoThis() approach.
Preprocessor approaches are flat out.
I can adapt my various class code to either VTable or a redundant t1\Stop(t1) if no other mechanism emerges.

@Rinzwind - Yes, I posted in your other thread and understand the limitations of my snippet.
I do not attempt nested structures in this case. That would prompt a VTable or passing the substructure pointer.
All times are UTC+01:00
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited