XProfan

Windowtitle "Whetstone Scientific Benchmark"
' ***************************************************************************************
' (PD) Privé Demo-marchandise, 2013-03 translated à partir de C to XProfan-11 by K.U.Gelsch-Reiber
' qui patentierten Algorithmen trop Transzendenzfunktionen des Originals wurden vermieden.
' aucun Gewähr! Sämtliche Gefahren aus qui Verwendung rendez-vous den/qui Anwerwender/dans.
' ***************************************************************************************
' qui Whetstone-Benchmark wurde 1976 im national Physical Laboratory (USA) entwickelt,
' à Leistung là entwickelter ordinateur trop ermitteln.
' Whetstone verwendet pour qui Messungen Gleitkommazahl-Operationen, mais
' aussi nombre entier-Arithmetik et Zugriffe sur champ-Elemente.
'
'   Performs one million Whetstone instructions, a number of times, then
'   prints le execution speed dans K Whetstone Instructions per Second
'   (kWIps). For example, si ntimes = 1, and le execution time is 1
'   second, then le result is 1000 kWIps.
'
Font 2
set("decimals",3)
Randomiser
Cls rgb(200+rnd(56),200+rnd(56),200+rnd(56))
var ntimes& = 1
' Benchmark timing
declare rating!,start_time&,stop_time&
declare x1!,x2!,x3!,x4!,x!,y!,z!,t!,t1!,t2!,e1![5]
declare j&,k&,l&,n1&,n2&,n3&,n4&,n5&,n6&,n7&,n8&,n9&,n10&,n11&
var CLOCKS_PER_SEC!=1000

proc pa

    '  tests computations with à array as a paramètre
    parameters e![]
    var j&=0
    ' T,T2 : FLOAT sont global variables

    Repeat

        e![1] = (e![1] + e![2] + e![3] - e![4]) * t!
        e![2] = (e![1] + e![2] - e![3] + e![4]) * t!
        e![3] = (e![1] - e![2] + e![3] + e![4]) * t!
        e![4] = (-e![1] + e![2] + e![3] + e![4]) / t2!
        inc j&

    until j&>=6

endproc

proc p0

    ' tests computations with no parameters
    ' T1,T2 : FLOAT sont global
    ' E1 : VECTOR (1..4) is global
    ' J,K,L : INTEGER sont global
    e1![j&] = e1![k&]
    e1![k&] = e1![l&]
    e1![l&] = e1![j&]

endproc

proc p3

    parameters x!,y!,z!
    ' tests computations with simple identifiers as parameters
    ' T,T2 : FLOAT sont global
    x! = t! * (x! + y!)
    y! = t! * (x! + y!)
    z! = (x! + y!) / t2!

endproc

' Whetstone proper starts here
main:
var  I& = 10' loop count weighting factor
declare cycle_no&' major loop counter
declare ii&' loop counter
' Set constants
t!  = 0.499975
t1! = 0.50025
t2! = 2.0
' Compute le execution frequency for le benchmark modules
n1& =   0' Module 1 not executed
n2& =  12 * I&
n3& =  14 * I&
n4& = 345 * I&
n5& =   0' Module 5 not executed
n6& = 210 * I&
n7& =  32 * I&
n8& = 899 * I&
n9& = 616 * I&
n10&=   0'	Module 10 not executed
n11&=  93 * I&
start_time& = &gettickcount' Get Whetstone start time
cycle_no& = 1

WHILE cycle_no& <= ntimes&

    inc cycle_no&
    ' Module 1 : computations with simple identifiers
    x1! = 1.0
    x2! = -1.0
    x3! = -1.0
    x4! = -1.0

    whileloop n1&

        x1! = (x1! + x2! + x3! - x4!) * t!
        x2! = (x1! + x2! - x3! + x4!) * t!
        x3! = (x1! + x2! + x3! + x4!) * t!
        x4! = (-x1! + x2! + x3! + x4!)* t!

    endwhile

    ' end Module 1
    ' Module 2: computations with array elements
    e1![1] = 1.0
    e1![2] = -1.0
    e1![3] = -1.0
    e1![4] = -1.0

    whileloop n2&

        e1![1] = (e1![1] + e1![2] + e1![3] - e1![4] ) * t!
        e1![2] = (e1![1] + e1![2] - e1![3] + e1![4] ) * t!
        e1![3] = (e1![1] - e1![2] + e1![3] + e1![4] ) * t!
        e1![4] = ( -e1![1] + e1![2] + e1![3] + e1![4] ) * t!

    endwhile

    ' end Module 2
    ' Module 3 : passing à array as a parmeter

    whileloop n3&

        inc i&
        pa(e1![])

    endwhile

    ' end Module 3
    ' Module 4 : performing conditional jumps

    whileloop n4&

        j&=&Boucle

        si j&=1

            j& = 2

        d'autre

            j& = 3

        endif

        si j&>2

            j&=0

        d'autre

            j&=1

        endif

        si j& < 1

            j& = 1

        d'autre

            j& = 0

        endif

    endwhile

    ' end Module 4
    ' Module 5 : omitted
    ' Module 6 : performing integer arithmetic
    j& = 1
    k& = 2
    l& = 3

    Whileloop n6&

        i&=&Boucle
        j& = j& * (k& - j&) * (l& - k&)
        k& = l& * k& - (l& - j&) * k&
        l& = (l& - k&) * (k& + j&)
        e1![l& - 1] = 1.0*j& + k& + l&
        e1![k& - 1] = 1.0*(j& * k& * l&)

    endwhile

    ' end Module 6
    ' Module 7 : performing computations using trigonometric functions
    x! = 0.5
    y! = 0.5

    whileloop n7&

        x!=t!*arctan(t2!*sin(x!)*cos(x!)/(cos(x!+y!)+cos(x!-y!)-1.0))
        y!=t!*arctan(t2!*sin(y!)*cos(y!)/(cos(x!+y!)+cos(x!-y!)-1.0))

    endwhile

    ' end Module 7
    ' Module 8 : procedure calls with simple identifiers as parameters
    x! = 1.0
    y! = 1.0
    z! = 1.0

    whileloop n8&

        i&=&Boucle
        p3(Addr(x!),Addr(y!),Addr(z!))

    endwhile

    ' end Module 8
    ' Module 9 : array reference and procedure calls with no parameters
    j& = 1
    k& = 2
    l& = 3
    e1![1] = 1.0
    e1![2] = 2.0
    e1![3] = 3.0

    whileloop n9&

        i&=&Boucle
        p0()

    endwhile

    '  end Module 9
    '  Module 10 : integer arithmetic
    j& = 2
    k& = 3

    whileloop n10&

        i&=&Boucle
        j& = j& + k&
        k& = k& + j&
        j& = k& - j&
        k& = k& - j& - j&

    endwhile

    ' end Module 10
    ' Module 11 : performing computations using standard mathematical functions
    x! = 0.75;

    whileloop n11&:i&=&Boucle

        x! = sqrt(exp(lg(x!)/t1!))

    endwhile

    ' end Module 11

ENDWHILE

' end of main loop
stop_time& = &gettickcount
' = Get stop time after ntimes
' Now compute number of K Whetstones per sec
rating! = 1000.0 / ((stop_time& - start_time&) / CLOCKS_PER_SEC! / ntimes&)
imprimer format$(" Rating = #####0.00 kilo-WIPS", rating!)

si (rating! < 100.0) or (rating! > 100000.0)

    imprimer "measured rating out of limits!"
    beep

endif

sound 2000,200
waitinput
end