LeapYear Function (Boolean eval.)

[Munair]

The thing is, Leap years come every four years, or thereabouts as demonstrated.
It is a strange function to optimise to a millions per second crunch rate.
I would have suggested to jj2007 to wrap up his/her extreme asm in a procedure, but held back at the last minute.
As for using ulongint, it seems too futuristic for this function.

Calendar programs automatically compute every year if it's a leap year or not so they know how to display February. But it's probably one of the least called functions.

Regarding accuray, we could actually do with a simple USHORT (or SHORT if prolaptic) since the current Gregorian calendar will become inaccurate after 4000 years. It has already been proposed in the past to insert another extra leap day every 4000 years, but it has not been officially adopted. It probably never will as by that time another civilization will most likely have another calendar adapted to (slightly) changed Earth's cycles.

On the other hand, I have written software that extensively computes days between dates. That's where an optimized LeapYear function comes in handy, although one still wouldn't notice a .003 or somthing seconds being shaved off the clock. :-)

This topic is primarily of educational value, to see what is the best programming practice and also to learn about the FreeBASIC compiler. In any case, I definitely gained more insight..

[jj2007]

I have been up all night. I have been known to code all night but that was when I was very much younger.

Same problem over here ;-)

Nobody spotted it. <laugh>

Well... I saw these figures, and thought they were too high, BUT: For some "optimisation" options, the compiler does strange things with my purest assembly code. Instead of creating a function (call someproc, ret) it inlines the code, and before executing the actual code, it inserts two calls to obscure little routines, which in turn call other routines. Then the assembly "function" is executed, but afterwards it calls again twice these obscure little routines, in reverse order (->disassembly). That is 8 calls added to a handful of lines of fast assembly code. No wonder that it becomes slow.

With optimisations disabled, the compiler creates a subroutine, but even then, it adds quite a bit of superfluous code. For example, it creates a stack frame, and it preserves esi edi ebx on the stack. That is safe code, sure, but do you use inline assembly for safe code or for fast code...?

whilst you lot continue to roll about the floor in stitches. <smile>

Exactly what I needed after this coding night, thank you so much for that!

This topic is primarily of educational value, to see what is the best programming practice and also to learn about the FreeBASIC compiler.

That's an excellent conclusion ;-)

[dodicat]

I used the non optimised leap year function a few years ago for a calendar.
1899 is the earliest year, and I have completely forgotten why!

Code: Select all

'CALENDAR
#include "fbgfx.bi"
Dim Shared As Integer xres,yres
Screen 19,32,1,FB.GFX_ALPHA_PRIMITIVES
Screeninfo xres,yres
Windowtitle "FreeBASIC CALENDAR"
#macro incircle(cx,cy,radius,x,y)
(cx-x)*(cx-x) +(cy-y)*(cy-y)<= radius*radius
#endmacro

Type box
    As String text
    As Ulong colour
    As long value,tx,ty,bx,by
End Type
Type Calendar_Month
        Number As long  
        Month_name As String 
End Type
declare sub digits(t As String,x As long,y As long,clr As Ulong,sz As long,img As Any Pointer=0)
Declare Function IsLeapYear(N As long) As long
Declare Sub PrintCalendar (_year As long, _month As long)
Declare Sub ComputeMonth (_year As long, _month As long, Byref StartDay As long, Byref TotalDays As long)
declare sub inspect(mx as long,my as long,mw as long)
Dim Shared MonthData(1 To 12)   As Calendar_Month
Declare Sub initdata
Declare Sub initmonth
Declare Sub inityear
Declare Sub initdigits
Declare Sub dropmonth
Declare Sub dropyear
Declare Sub dropdigit1
Declare Sub dropdigit2
Declare Sub monthheader()
Declare Sub yearheader
Declare Function inbox(colour As Ulong,x As long,y As long) As long
Declare Sub paintscreen
Declare Sub mouseloop()
Declare Sub checkevents(mx As long,my As long)
Declare Function allflags() As long
Declare Function checktext() As long
Dim Shared As Single m1,m2,y1,y2,BOXWIDTH,d11,d12,d21,d22,digitboxwidth
Dim Shared As long monthflag,yearflag,digit1flag,digit2flag,printflag,endflag,nowflag
Dim Shared As fb.event e
Dim Shared As long _month,_year
Dim Shared As String monthtext,yeartext,digit1text,digit2text,mday,_yr,mn,verse
boxwidth=.07
m1=.1:m2=m1+.07'.2
y1=m2:y2=y1+.07
digitboxwidth=.04
d11=y2:d12=y2+digitboxwidth
d21=d12:d22=d21+digitboxwidth
Dim Shared  As box mon(1 To 13),montxt(1 To 13)
Dim Shared  As box yr(1 To 4),yrtxt(1 To 4)
Dim Shared  As box digit1(9),digit1txt(9)
Dim Shared  As box digit2(9),digit2txt(9)
Dim Shared As Ulong offwhite=Rgb(250,251,252)
'_ MAIN ___________
initdata
initmonth
inityear
initdigits
mouseloop
'___________________


'PROCEDURES __________________

Sub initdata
    Restore dat2
    For I As long = 1 To 12
        Read MonthData(I).Month_name, MonthData(I).Number
    Next 
End Sub

Sub initmonth 
    Dim s As String
    Dim count As long
    Restore dat1
    For x As long=1 To 13
        Read s
        mon(x).text=s
        mon(x).value=x-1
        mon(x).colour=Rgb(0,200,x)
        montxt(x).colour=Rgb(255,255,200+x)
    Next x
    mon(1).colour=Rgb(200,200,1)
    Restore
End Sub
Sub inityear
    yr(1).text="Year"
    yr(2).text="18"
    yr(3).text="19"
    yr(4).text="20"
    For x As long=1 To 4
        yr(x).colour=Rgb(200,0,x)
        yrtxt(x).colour=Rgb(254,254,200+x)
    Next x
    yr(1).colour=Rgb(0,0,200)
End Sub
Sub initdigits
    For x As long=0 To 9
        digit1(x).text=Str(x)
        digit2(x).text=Str(x)
        digit1(x).colour=Rgb(101,101,101+x)
        digit2(x).colour=Rgb(102,102,102+x)
        digit1txt(x).colour=Rgb(253,253,200+x)
        digit2txt(x).colour=Rgb(252,252,200+x)
    Next x
End Sub
Sub dropmonth
    Dim k As long:Dim sz As long=30
    For x As long=1 To 13
        Line(m1*xres,.1*yres+k)-(m2*xres,.1*yres+sz+k),mon(x).colour,BF
        Line(m1*xres,.1*yres+k)-(m2*xres,.1*yres+sz+k),Rgb(0,0,0),B
        mon(x).tx=m1*xres:mon(x).ty=.1*yres+k
        mon(x).bx=m2*xres:mon(x).by=.1*yres+sz+k
        Draw String((m1+.01)*xres,.11*yres+k),mon(x).text,montxt(x).colour
        k=k+sz
    Next x
End Sub

Sub dropyear
    Dim k As long:Dim sz As long=30
    For x As long=1 To 4
        Line(y1*xres,.1*yres+k)-(y2*xres,.1*yres+sz+k),yr(x).colour,BF
        Line(y1*xres,.1*yres+k)-(y2*xres,.1*yres+sz+k),Rgb(0,0,0),B
        yr(x).tx=y1*xres:yr(x).ty=.1*yres+k
        yr(x).bx=y2*xres:yr(x).by=.1*yres+sz+k
        Draw String((y1+.01)*xres,.11*yres+k),yr(x).text,yrtxt(x).colour
        k=k+sz
    Next x
End Sub

Sub dropdigit1
    Dim k As long:Dim sz As long=30
    For x As long=0 To 9
        Line(d11*xres,.1*yres+k)-(d12*xres,.1*yres+sz+k),digit1(x).colour,BF
        Line(d11*xres,.1*yres+k)-(d12*xres,.1*yres+sz+k),Rgb(0,0,0),B
        digit1(x).tx=d11*xres:digit1(x).ty=.1*yres+k
        digit1(x).bx=d12*xres:digit1(x).by=.1*yres+sz+k
        Draw String((d11+.01)*xres,.11*yres+k),digit1(x).text,digit1txt(x).colour
        k=k+sz
    Next x
End Sub
Sub dropdigit2
    Dim k As long:Dim sz As long=30
    For x As long=0 To 9
        Line(d21*xres,.1*yres+k)-(d22*xres,.1*yres+sz+k),digit2(x).colour,BF
        Line(d21*xres,.1*yres+k)-(d22*xres,.1*yres+sz+k),Rgb(0,0,0),B
        digit2(x).tx=d21*xres:digit2(x).ty=.1*yres+k
        digit2(x).bx=d22*xres:digit2(x).by=.1*yres+sz+k
        Draw String((d21+.01)*xres,.11*yres+k),digit2(x).text,digit2txt(x).colour
        k=k+sz
    Next x
End Sub

Sub monthheader()
    Dim k As long
    Dim sz As long=30
    Dim count As long=1
    Line(m1*xres,.1*yres+k)-(m2*xres,.1*yres+sz+k),mon(1).colour,BF
    Line(m1*xres,.1*yres+k)-(m2*xres,.1*yres+sz+k),Rgb(0,0,0),B
    Draw String((m1+.01)*xres,.11*yres+k),mon(1).text,montxt(1).colour
End Sub
Sub yearheader
    Dim k As long
    Dim sz As long=30
    Dim count As long
    Line(y1*xres,.1*yres+k)-(y2*xres,.1*yres+sz+k),yr(1).colour,BF
    Line(y1*xres,.1*yres+k)-(y2*xres,.1*yres+sz+k),Rgb(0,0,0),B
    Draw String((y1+.01)*xres,.11*yres+k),yr(1).text,yrtxt(1).colour 
End Sub

Function inbox(colour As Ulong,x As long,y As long) As long
    If Point(x,y)=colour  Then
        Return -1
    Else
        Return 0
        Endif
    End Function
    
    Sub paintscreen
        Line(.1*xres,.1*yres)-(.9*xres,.9*yres),Rgb(2,2,2),B
        Paint (0,0),Rgb(236,233,216),Rgb(2,2,2)
        Paint(xres/2,yres/2),Rgb(255,255,255),Rgb(2,2,2) 
        Line(.4*xres,.2*yres)-(.89*xres,.7*yres),Rgb(0,0,0),BF 'black box
        For k As long=-3 To 3 'blue frame
            Line(.4*xres+k,.2*yres-k)-(.89*xres-k,.7*yres+k),Rgb(0,150+30*k,236),B 
        Next k
    End Sub
    
    Sub checkevents(mx As long,my As long)
        'highlight month
        For x As long = 2 To 13 
        If  inbox(mon(x).colour,mx,my) Or inbox(montxt(x).colour,mx,my) Then
            line(mon(x).tx,mon(x).ty)-(mon(x).bx,mon(x).by),rgb(255,255,255),b
            end if
        next x
        'highlight year
         For x As long = 2 To 4 
          If inbox(yr(x).colour,mx,my) Or inbox(yrtxt(x).colour,mx,my)Then 
          line(yr(x).tx,yr(x).ty)-(yr(x).bx,yr(x).by),rgb(255,255,255),b
      end if
  next x
  'highlight digits
  For x As long = 0 To 9  
        If inbox(digit1(x).colour,mx,my) Or inbox(digit1txt(x).colour,mx,my)Then 
        line(digit1(x).tx,digit1(x).ty)-(digit1(x).bx,digit1(x).by),rgb(255,255,255),b
    end if
next x
 For x As long = 0 To 9  
        If inbox(digit2(x).colour,mx,my) Or inbox(digit2txt(x).colour,mx,my)Then 
        line(digit2(x).tx,digit2(x).ty)-(digit2(x).bx,digit2(x).by),rgb(255,255,255),b
    end if
next x

        'HEADERS
        If (ScreenEvent(@e)) Then
            If e.type=13 Then end
            
            If e.type=fb.EVENT_MOUSE_BUTTON_PRESS Then
                
                If inbox(mon(1).colour,mx,my) Or inbox(montxt(1).colour,mx,my)Then 
                monthflag=1
                nowflag=0
                Exit Sub
            End If
            
            If  inbox(yr(1).colour,mx,my) Or inbox(yrtxt(1).colour,mx,my)Then 
            yearflag=1
            nowflag=0
            Exit Sub
        End If
        'OTHERS (drop menus)
        
        For x As long = 2 To 13  
            If  inbox(mon(x).colour,mx,my) Or inbox(montxt(x).colour,mx,my) Then 
                _month=mon(x).value
                monthtext=mon(x).text
                line(mon(x).tx,mon(x).ty)-(mon(x).bx,mon(x).by),rgb(255,255,255),bf
                Exit Sub
            End If
        Next x
        
        For x As long = 2 To 4  
            If inbox(yr(x).colour,mx,my) Or inbox(yrtxt(x).colour,mx,my)Then 
            yeartext=yr(x).text
            '_year=yr(x).value
            line(yr(x).tx,yr(x).ty)-(yr(x).bx,yr(x).by),rgb(255,255,255),bf
            Exit Sub
        End If
    Next x
    
    For x As long = 0 To 9  
        If inbox(digit1(x).colour,mx,my) Or inbox(digit1txt(x).colour,mx,my)Then 
        digit1text=digit1(x).text
        digit1flag=1
        line(digit1(x).tx,digit1(x).ty)-(digit1(x).bx,digit1(x).by),rgb(255,255,255),bf
        Exit Sub
    End If
Next x

For x As long = 0 To 9  
    If  inbox(digit2(x).colour,mx,my) Or inbox(digit2txt(x).colour,mx,my)Then 
    digit2text=digit2(x).text
    digit2flag=1
    line(digit2(x).tx,digit2(x).ty)-(digit2(x).bx,digit2(x).by),rgb(255,255,255),bf
    Exit Sub
End If
Next x   
if incircle(.5*xres,.8*yres,35,mx,my) then
       _year=valint(_yr): _month= valint(mn )
       nowflag=1
       yearflag=0
       monthflag=0
       monthtext=""
       yeartext=""
       digit1text=""
       digit2text=""
       exit sub
            end if
'LAST EVENT REACHED (date filled)

If incircle(.5*xres,.05*yres,xres/30,mx,my) Then 
    printflag=1
    Exit Sub
End If

End If 'e.type  

End If 'screvent
End Sub
Function allflags() As long
    Dim sum As long=monthflag+yearflag+digit1flag+digit2flag
    If sum=4 Then
        Return -1
    Else
        Return 0
    End If
End Function

Function checktext() As long
    If monthtext="" Then Return 0
    If yeartext="" Then Return 0
    If digit1text="" Then Return 0
    If digit2text="" Then Return 0
    Return -1
End Function


Sub mouseloop()
    
    Dim As long mx,my
    Do
        Getmouse mx,my
        mday=mid(date,4,2)
         _yr=mid(date,7,4)
          mn=mid(date,1,2)
        Screenlock
        Cls
        paintscreen
        if allflags and printflag then
        for z as single=35 to 30 step -.1
          circle(.5*xres,.8*yres),z,Rgb(0,150+30*z,236)
          next z
        circle(.5*xres,.8*yres),30,rgb(0,0,0),,,,f
        draw string(.485*xres,.79*yres),"Now"
        end if
        if nowflag=1 then
             digits(time,.52*xres,.13*yres,rgb(100,0,0),10)
             draw string(.215*xres,.37*yres),"Now",rgb(0,0,0)
            #define pt(n) draw string(.2*xres-n,.8*yres),verse,rgb(0,00,0)
           ' dim as long temp3=12 (for testing rymes)
            select case _month
            case 1
verse="January brings the snow, Makes our feet and fingers glow."
draw string(.2*xres,.8*yres),verse,rgb(0,00,0)
case 2
    verse="February brings the rain, Thaws the frozen lake again."
pt(len(verse))
case 3
    verse="March brings breezes loud and shrill, Stirs the golden daffodil."
pt(len(verse))
case 4
    verse="April brings the primrose sweet, Scatters daisies at our feet."
pt(len(verse))
case 5
    verse="May brings flocks of pretty lambs, Skipping by their fleecy dams."
pt(len(verse))
case 6
    verse="June brings tulips, lillies, roses, Fills the children's hands with posies."
pt(len(verse))
case 7
    verse="Hot July brings cooling showers, Apricots and gillyflowers."
pt(len(verse))
case 8
    verse="August brings the sheaves of corn, Then the harvest home is borne."
pt(len(verse))
case 9
    verse="Warm September brings the fruit, Sportsmen then begin to shoot."
pt(len(verse))
case 10
    verse="Fresh October brings the pheasant, Then to gather nuts is pleasant."
pt(len(verse))
case 11
    verse="Dull November brings the blast, Then the leaves are falling past."
pt(len(verse))
case 12
    verse="Chill December brings the sleet, Blazing fire and Christmas treat."
pt(len(verse))
                end select
            inspect(185,230,2.5)
            end if
        monthheader
        yearheader
        If printflag=1 Then PrintCalendar _year, _month
        If monthflag=1 Then dropmonth:Draw String (.1*xres,.05*yres),monthtext,Rgb(0,0,0)
        If yearflag=1 Then 
        dropyear:Draw String (.15*xres,.05*yres),yeartext,Rgb(0,0,0)
        dropdigit1:Draw String (.17*xres,.05*yres),digit1text,Rgb(0,0,0)
        dropdigit2:Draw String (.18*xres,.05*yres),digit2text,Rgb(0,0,0)
        end if
        If (allflags And checktext) Then 
            If printflag=0 Then  
            Circle(.5*xres,.05*yres),xres/30,Rgb(100,100,100),,,,f
            Draw String(.475*xres,.04*yres),"Start",offwhite
            end if
          if nowflag=0 then  _year=Valint(yeartext+digit1text+digit2text)
            
        End If
        If _year<1899 Then 
            printflag=0
            Draw String(10,10),"NOT BEFORE 1899 PLEASE",Rgb(255,0,0)
        End If
       
        checkevents(mx,my)
        Screenunlock
        Sleep 1,1
    Loop Until Inkey=Chr(27) or endflag=1
End Sub
Sub ComputeMonth (_year As long, _month As long, Byref StartDay As long,Byref TotalDays As long) 
        Const LEAP = 366 Mod 7
        Const NORMAL = 365 Mod 7
    Dim As long NumDays,I
        For I  = 1899 To _year- 1
                If IsLeapYear(I) Then            
                        NumDays = NumDays + LEAP   
        Else                               
                        NumDays = NumDays + NORMAL 
        End If
    Next
    
        For I = 1 To _month - 1
                NumDays = NumDays + MonthData(I).Number
    Next
        TotalDays = MonthData(_month).Number
        If IsLeapYear(_year) Then
                If _month > 2 Then
                        NumDays = NumDays + 1
        Elseif _month = 2 Then
                        TotalDays = TotalDays + 1
        End If
    End If
        StartDay = NumDays Mod 7
End Sub
Function IsLeapYear (N As long) As long
        IsLeapYear = (N Mod 4 = 0 And N Mod 100 <> 0) Or (N Mod 400 = 0)
End Function

sub inspect(mx as long,my as long,mw as long)
 if mw=0 then mw=1
 mw=abs(mw)
 for z as long=0 to 16
 line(mx-40+z,my-40+z)-(mx+40-z,my+40-z),rgb(50*z/40,50*z/4,50*z/3.2),B
 next z
 dim as ulong array(1 to 6561)
  dim as long count
 for x as long=mx-40 to mx+40
 for y as long=my-40 to my+40
 count=count+1
 array(count)=point(x,y)
next y
next x
count=0
for x as long=mx-40 to mx+40
    for y as long=my-40 to my+40
        count=count+1
     var NewX=mw*(x-mx)+mx
     var NewY=mw*(y-my)+my 
 line(NewX-mw/2,NewY-mw/2)-(NewX+mw/2,NewY+mw/2),array(count),BF
next y
next x
end sub
Sub PrintCalendar (_year As long, _month As long) 'STATIC
    Dim As String header
    Dim As long totaldays,_pos,_csrlin
    Dim As long startday,leftmargin
        ComputeMonth _year, _month, StartDay, TotalDays
        Header = Rtrim(MonthData(_month).Month_name) + ", " + Str(_year)
        LeftMargin = (35 - Len(Header)) \ 2 
    Locate 15
        Print Tab(LeftMargin+50); Header
        Print
        Print Tab(50);"Su    M   Tu    W   Th    F   Sa"
        Print
        LeftMargin = 5 * StartDay + 1 
        Print Tab(LeftMargin+49);
        For I As long = 1 To TotalDays
                Print Using "##_   "; I;
                if I=valint(mday) then
                    _pos=pos
                    _csrlin=csrlin 
    if nowflag=1 then circle(  (xres*(_pos)/100)-38,yres*_csrlin/37-15),13,rgba(200,0,0,150),,,,f
                    end if
        If Pos(0) > 82 Then Print Tab(50);
        
    Next
    
End Sub

dat1: 'for boxes
Data "Month","JAN","FEB","MAR","APR","MAY","JUN","JUL","AUG","SEP","OCT","NOV","DEC"
dat2:'for calendar
Data "January", 31, "February", 28,  "March", 31
Data "April", 30,   "May", 31, "June", 30, "July", 31, "August", 31
Data "September",   30, "October", 31, "November", 30, "December", 31
Sub digits(t As String,x As long,y As long,clr As Ulong,sz As long,img As Any Pointer=0)
        x=x-2*sz
        dim as single s=any,c=any
        #macro thickline(x1,y1,x2,y2)
             s=(y1-y2)/10
             c=(x2-x1)/10
            Line img,(x1-s,y1-c)-(x2+s,y2+c),clr,bf
        #endmacro
        #macro display(_a,_b,_c,_d,_e,_f,_g)
        x=x+2*sz
        If _a=1 Then :thickline(x,y,(x+sz),y):End If
        If _b=1 Then :thickline((x+sz),y,(x+sz),(y+sz)):End If
        If _c=1 Then :thickline((x+sz),(y+sz),(x+sz),(y+2*sz)):End If 
        If _d=1 Then :thickline((x+sz),(y+2*sz),x,(y+2*sz)):End If
        If _e=1 Then :thickline(x,(y+2*sz),x,(y+sz)):End If
        If _f=1 Then :thickline(x,(y+sz),x,y):End If
        If _g=1 Then :thickline(x,(y+sz),(x+sz),(y+sz)):End If
        #endmacro
        For z As long=0 To Len(t)-1
            Select Case As Const t[z]
            Case 48 :display(1,1,1,1,1,1,0)             '"0"
            Case 49 :display(0,1,1,0,0,0,0)             '"1"
            Case 50 :display(1,1,0,1,1,0,1)             '"2"
            Case 51 :display(1,1,1,1,0,0,1)             '"3"
            Case 52 :display(0,1,1,0,0,1,1)             '"4"
            Case 53 :display(1,0,1,1,0,1,1)             '"5"
            Case 54 :display(1,0,1,1,1,1,1)             '"6"
            Case 55 :display(1,1,1,0,0,0,0)             '"7"
            Case 56 :display(1,1,1,1,1,1,1)             '"8"
            Case 57 :display(1,1,1,1,0,1,1)            '"9"
            Case 58                                     '":"                   
                Circle((x+2*sz),(y+sz/2)),(sz/5),clr,,,,f
                Circle((x+2*sz),(y+1.5*sz)),(sz/5),clr,,,,f
                x=x+sz 
            Case 45 :display(0,0,0,0,0,0,1)              '"-"                       
            Case 46                                      '"."                       
                Circle((x+2*sz),(y+1.9*sz)),(sz/5),clr,,,,f
                x=x+sz 
            Case 32                                      '" "
                x=x+sz 
            End Select
        Next z
    End Sub  
    
 

[paul doe]

Well... I saw these figures, and thought they were too high, BUT: For some "optimisation" options, the compiler does strange things with my purest assembly code. Instead of creating a function (call someproc, ret) it inlines the code, and before executing the actual code, it inserts two calls to obscure little routines, which in turn call other routines. Then the assembly "function" is executed, but afterwards it calls again twice these obscure little routines, in reverse order (->disassembly). That is 8 calls added to a handful of lines of fast assembly code. No wonder that it becomes slow.

Yeah, I noticed this too. I don't know what the criteria for inlining is, but it seems that GCC does it for small subs/functions. With -O3 it inlines like crazy ;)

[Munair]

Well... I saw these figures, and thought they were too high, BUT: For some "optimisation" options, the compiler does strange things with my purest assembly code. Instead of creating a function (call someproc, ret) it inlines the code, and before executing the actual code, it inserts two calls to obscure little routines, which in turn call other routines. Then the assembly "function" is executed, but afterwards it calls again twice these obscure little routines, in reverse order (->disassembly). That is 8 calls added to a handful of lines of fast assembly code. No wonder that it becomes slow.

Yeah, I noticed this too. I don't know what the criteria for inlining is, but it seems that GCC does it for small subs/functions. With -O3 it inlines like crazy ;)

CONCLUSION: Stick to native FB code and try to write it with some efficiency in mind. Also best option for multi-arch development.

[dodicat]

With option -O3 -Ofast I get errors:
TEMP.asm: Assembler messages:
TEMP.asm:199: Error: symbol `Lx2' is already defined
TEMP.asm:208: Error: symbol `Lx1' is already defined

(This is using Mr Swiss's snippet, derived from jj207)

So there are label problems here.
O1 and O2 are OK and the execution seed is improved.

My conclusion
Asm is too tempremental for mission critical.
(trajectory to Mars and things like that)

[Munair]

e-05? You have done something wrong there.

I have a suggestion with your timing code.

You are using something like ;print "elapsed A:"; Timer - Start'. It would be better to assign 'Timer - Start' before executing print.

Doesn't make any difference. It is simple scientific notation done by FB. Run the following two versions. The output is the same.

Code: Select all

dim start as double = Timer

for i as integer = 0 to 1000
next

print Timer - start
end

Code: Select all

dim start as double = Timer

for i as integer = 0 to 1000
next

start = Timer - start
print start
end

[paul doe]

CONCLUSION: Stick to native FB code and try to write it with some efficiency in mind. Also best option for multi-arch development.

My conclusion
Asm is too tempremental for mission critical.
(trajectory to Mars and things like that)

Totally agree with both. I'm currently coding a blitter, in pure FB, for some other thread, and with FB 64-bit -gen gcc -Wc -O3 it runs at least 20% faster than the functionally equivalent FB PUT command. FBGFX implementation uses ASM and MMX, if I'm not mistaken. Or, used it in 32-bit, don't know how it fares in 64-bit though ;)

[deltarho[1859]]

With option -O3 -Ofast I get errors:

With -O3 and -Ofast the compiler generates duplicate labels and compilation fails when the duplicates are encountered resulting in ' '<label>' is already defined '. I do not know what extra optimisation -O3 and -Ofast require duplication but one solution is to use local labels each of which is automatically made unique thus avoiding the 'already defined' error.

[deltarho[1859]]

When Munair originally tested three algorithms which he designated as A, B and C he used 'const years 800000000'. Later, 'const years = 100000000' was introduced. I made a cardinal error and used 1000,000,000 but that is water under the bridge. There was an exchange of posts without code and then we got into looking at jj2007's asm. What we did not do was return to Munair's original testing and apply 'const years = 100000000'.

I have done here but only tested B, C and Roland Chastain's second contribution.

Code: Select all

elapsed B: 68.46720013526308,  24250000 leap years found
elapsed C: 68.67989842842803,  24250000 leap years found
elapsed Roland: 68.66819563939686,  24250000 leap years found

Clearly all three are 'neck and neck'.

When I finally got my 'head together' I ended up with the fastest time for jj2007's asm code.

Code: Select all

elapsed Asm: 259ms           24250000 leap years found ( -O3 )

The FB code is then coming in at pushing four times faster than the asm code.

My preference is Roland's code, which to my mind, is the epitome of succinctness.

[Josep Roca]

This is what I'm using in my framework for Windows:

Code: Select all

IF (nYear MOD 4 = 0 AND nYear MOD 100 <> 0) OR nYear MOD 400 = 0 THEN RETURN TRUE

[jj2007]

OK, once more timings, full code below:

Code: Select all

elapsed Asm: 172ms           24250000 leap years found (inline)
elapsed Asm: 175ms           24250000 leap years found (inline)
elapsed Asm: 174ms           24250000 leap years found (inline) (repeated 5x to make sure timings are reliable)
elapsed Asm: 173ms           24250000 leap years found (inline)
elapsed Asm: 175ms           24250000 leap years found (inline)
elapsed Asm: 699ms           24250000 leap years found (function)
elapsed D:   878ms           24250000 leap years found
elapsed C:   560ms           24250000 leap years found
elapsed B:   534ms           24250000 leap years found
elapsed R2:  625ms           24250000 leap years found (Roland Chastain 2)
elapsed AL:  904ms           24250000 leap years found (ULong)
elapsed AI:  2639ms          24250000 leap years found (ULongInt)

This is for -gen gcc -s console, i.e. no optimisation (with -O3, native FB code is 2-3 times slower). "AL" corresponds to Josep's version afaics. Here is the full code:

Code: Select all

' leapyear algorithms test adapted from Munair, 2017-11-11, https://www.freebasic.net/forum/viewtopic.php?f=7&t=25305&p=239132#p239133
' ---------------------------------------------------
const years = 100000000

Function drLeapYear ( Year As ULONG ) As Boolean
  If Year Mod  4 = 0 Andalso _     
  Year Mod 100 > 0 Orelse _     
  Year Mod 400 = 0 Then Return true
End Function

Function LeapYearAL (N As ULong) As boolean	' fast
   LeapYearAL = (N Mod 4 = 0 Andalso N Mod 100 <> 0) Or (N Mod 400 = 0)
   ' Josep Roca: IF (N MOD 4 = 0 AND N MOD 100 <> 0) OR N MOD 400 = 0 Then Return TRUE
End Function

Function LeapYearAI (N As ULongInt) As boolean	' slow
   LeapYearAI = (N Mod 4 = 0 Andalso N Mod 100 <> 0) Or (N Mod 400 = 0)
End Function

function LeapYearB(byval y as ULong) as boolean
   if (y mod 4) then
      return false
   end if
   if not cbool(y mod 100) then
      if not cbool(y mod 400) then
         return true
      end if
      return false
   end if
   return true
end function

Function LeapYearC(ByVal yea As ULong) As Boolean
    If (yea Mod 4) Then Return FALSE    ' definitely NOT a leap Year
    ' below: exception test (a century but, not also clean dividable by 400)
    If Not CBool(yea Mod 100) AndAlso CBool(yea Mod 400) Then Return FALSE
    ' below: all tests passed = it is, a leap Year
    Return TRUE
End Function

Function LeapYearRC2(ByVal yr as ULong) as Boolean
  return (yr Mod 4 = 0) andalso ((yr Mod 100 <> 0) orelse (yr Mod 400 = 0))
End Function

Function LeapYearJ(ByVal yea As ULong) As ULong
Asm
  mov ecx, dword ptr [yea]
  test ecx, 3
  setz al
  jne 0f
  mov eax, ecx
  cdq
  push 100
  idiv dword ptr [esp]	' 0, 4, 8, ..., 96, 0
  test edx, edx	' mod 100=0 should set zero flag
  jne 1f
  mov eax, ecx
  cdq
  push 400
  idiv dword ptr [esp]
  pop eax
  dec edx	'*** invert the zero flag ***
  sets dl	' sign set if edx was zero
  test dl, dl
1:
  pop eax
  setnz al
0:
  movsx eax, al
  mov [function], eax	' MichaelW
'   leave
'   ret 4
'   pop edi
'   pop esi
'   pop ebx
'   mov esp, ebp
'   pop ebp
'   ret 4
End Asm
End Function

dim Start as double
dim i as ULong
dim lyears as long

cls

'AsmJJ
sleep 1
for i = 1 to 5	' manually inlined assembly, same code as LeapYearJ
  Start = Timer
  lyears=0
  Asm
	xor ecx, ecx
	nop		' align 4
  Lxi0:	inc ecx
	test cl, 3
	' setz al not needed
	jne Lxi1
	mov eax, ecx
	cdq
	push 100
	idiv dword ptr [esp]	' 0, 4, 8, ..., 96, 0
	test edx, edx   ' mod 100=0 should set zero flag
	jne Lxi2
	mov eax, ecx
	' cdq not needed, edx is zero
	push 400
	idiv dword ptr [esp]
	pop eax
	dec edx	' *** invert the zero flag ***
	sets dl	' sign set if edx was zero
	test dl, dl
  Lxi2:	pop eax
	setnz al
	je Lxi1
	inc dword ptr [lyears]
  Lxi1:	cmp ecx, years
	jbe Lxi0
  End Asm
  start=Timer - Start
  print "elapsed Asm:"; int(start*1000);"ms", lyears;" leap years found (inline)"
next

'AsmJJ
sleep 1
Start = Timer
lyears=0
' asm int 3
for i = 1 to years	' assembly function, inlined by compiler
	' asm int 3		' forum
	lyears=lyears+LeapYearJ(i)
	asm nop
	asm nop
' 	asm nop
' 	asm nop
next
print "elapsed Asm:"; int((Timer - Start)*1000);"ms", lyears;" leap years found (function)"

'DR
sleep 1
Start = Timer
lyears=0
for i = 1 to years
   if drLeapYear(i) then lyears=lyears+1
next
print "elapsed D:  "; int((Timer - Start)*1000);"ms", lyears;" leap years found"

'C
sleep 1
Start = Timer
lyears=0
for i = 1 to years
   if LeapYearC(i) then lyears=lyears+1
next
print "elapsed C:  "; int((Timer - Start)*1000);"ms", lyears;" leap years found"

'B
sleep 1
Start = Timer
lyears=0
for i = 1 to years
   if LeapYearB(i) then lyears=lyears+1
next
print "elapsed B:  "; int((Timer - Start)*1000);"ms", lyears;" leap years found"

'R2
sleep 1
Start = Timer
lyears=0
for i = 1 to years
   if LeapYearRC2(i) then lyears=lyears+1
next
print "elapsed R2: "; int((Timer - Start)*1000);"ms", lyears;" leap years found (Roland Chastain 2)"

'AL
sleep 1
Start = Timer
lyears=0
for i = 1 to years
   if LeapYearAL(i) then lyears=lyears+1
next
print "elapsed AL: "; int((Timer - Start)*1000);"ms", lyears;" leap years found (ULong)"

'AI
sleep 1
Start = Timer
lyears=0
for i = 1 to years
   if LeapYearAI(i) then lyears=lyears+1
next
print "elapsed AI: "; int((Timer - Start)*1000);"ms", lyears;" leap years found (ULongInt)"
sleep
end

[dodicat]

Josep Roca
I thought you were a fan of andalso rather than and
viewtopic.php?f=2&t=25976&p=236838&hili ... 2A#p236838
Maybe orelse in the second bit?
I tested gas and gcc (no optimisations) and it is slightly faster
(By the way, I apologise for being a bit ill tempered in that -pp thing)
This seems pretty fast also (using and 3 instead of mod 4)

Code: Select all

Function LeapYearA (N As long) As long
        LeapYearA = (N and 3 = 0 Andalso N Mod 100 <> 0) Orelse (N Mod 400 = 0)
End Function 

[deltarho[1859]]

'And 3' makes Roland's contribution the fastest FB code.

[deltarho[1859]]

Considering the variation of machines used for timing in this thread it could be regarded as pointless for anyone of us to publish timing results in milliseconds, that is in absolute terms.

Better, in my view would be to publish in relative terms where one particular timing was designated as the base line.

Since jj2007's inline is not being used by anyone other than jj2007 then the inline should not be used as the baseline; jj2007 may update his code. jj2007 may also change his asm code.

One of the BASIC contributions, which have not changed, should be used as the baseline. Lets use, B, for example so everyone who posts results divides there figures by what they get for B in ms.

jj2007's latest figres now look like this.

Code: Select all

elapsed Asm: 0.322           24250000 leap years found (inline)
elapsed Asm: 0.328          24250000 leap years found (inline)
elapsed Asm: 0.326           24250000 leap years found (inline) (repeated 5x to make sure timings are reliable)
elapsed Asm: 0.324           24250000 leap years found (inline)
elapsed Asm: 0.328           24250000 leap years found (inline)
elapsed Asm: 1.309           24250000 leap years found (function)
elapsed D:   1.644           24250000 leap years found
elapsed C:   1.049           24250000 leap years found
elapsed B:   1.000          24250000 leap years found
elapsed R2:  1.170           24250000 leap years found (Roland Chastain 2)
elapsed AL:  1.693           24250000 leap years found (ULong)
elapsed AI:  4.942          24250000 leap years found (ULongInt)

Figures < 1 are faster than B and figures >1 are sower than B. jj2007 would use 534 as his divisor.

My latest figures (-gen gcc -s console; no opt ) now reads as:

Code: Select all

elapsed B: 1.000,  24250000 leap years found
elapsed C: 1.003,  24250000 leap years found
elapsed Roland: 1.003,  24250000 leap years found
elapsed Asm: 3.783           24250000 leap years found ( -O3 )

and my divisor was B = 373.5341883991658438.

My B, C and Roland are much closer together than jj2007's B, C and R2 but that will happen between machines and there is nothing that we can do about that.

What now stands out like a sore thumb is the Asm figure, 1.309 with jj207's figures and 3.783 with my figures. Go figure as they say in America.

Whilst MrSwiss will be pleased by the above, being based upon no compiler optimisation and therefore comparing algorithms, they may not be reflected proportionately with optimisation and so should not be used as a judgement tool for deciding what to use in release code which may be compiler optimised.

I have done some tests using -Ofast and would advise it be used with extreme caution. I have decided to use -O3 as my top level for optimisation.