[*]Profan

Deutsch

[quote:00a30dd46d=Michael Wodrich]Ich wußte doch, daß ich das direkte Zugreifen auf Double-Werte von Profan schon mal rausgetüftelt hatte....

Damit habe ich die Funktion FindEdge() etwas direkter programmiert. Diese Funktion ist im Original unter den Beispielen als Fließkommazahlen.prf zu finden.

Außerdem habe ich mich mal an dem Gegenstück zu INT() versucht. Unter Pascal heißt diese Funktion Frac().

Dieser Codeschnipsel ist noch mit der MemoryModule-freien Version von XPIA getestet worden - läuft bei mir fehlerfrei.

Da fällt mir ein: wird es in XPIA einstellbar sein, welche Variante man einsetzt?
Das Generieren einer externen DLL hat ja auch seine Vorteile - z.B. für ältere Profan-Versionen eine DLL zu erstellen.

Hier der Code:
Kompilieren Markieren Separieren

!
 {$cleq}
 {$cliq}

Proc geaendertes_Beispiel

    Sucht die höchste und die niedrigste Zahl aus einem Array mit Fließkommazahlen.
    Declare anzahl&
    Anzahl Fließkommazahlen im Array
    anzahl& = 30
    Declare Tabelle_1![anzahl&], Tabelle_2![2], x&, y&, z&, text$
    Randomize
    Zufällige Fließkommazahlen
    generieren.

    WhileLoop anzahl&

        Tabelle_1![&loop - 1] = Rnd(100000) / 1.09 - 50000

    EndWhile

    Assemblerfunktions-Parameters:  Adresse von Tabelle mit Floats, Adresse von Zieltabelle, Anzahl Floats

    AsmStart FindEdge ( addr(Tabelle_1![0]), addr(Tabelle_2![0]), anzahl& )

        Local  tmp :REAL10
        mov    edx, para1
        mov    ebx, para2
        mov    ecx, para3
        fld    qword ptr [edx]        ; st(3): min   STK:(0:min)
        fld    qword ptr [edx]        ; st(2): max   STK:(0:max,1:min)
        schleife:
        fld    qword ptr [edx]        ; st(1): akt. Vergleichswert   STK:(0:akt,1:max,2:min)
        fld    st(0)                  ; st(0)  dupl. akt. Vergleichswert   STK:(0:akt,1:akt,2:max,3:min)
        fcomp  st(3)                  ; cmp st0 < st3 ? (st0 wird geändert/entfernt)   STK:(0:akt,1:max,2:min)
        fnstsw ax
        sahf
        jae    over1                  ; überspringe wenn st0 >= st3
        fst    st(2)                  ; sichere neuen Minimumwert (derzeit st2)   STK:(0:akt,1:max,2:neumin)
        over1:
        fld    st(0)                  ; st(0)  dupl. akt. Vergleichswert   STK:(0:akt,1:akt,2:max,3:min)
        fcomp  st(2)                  ; cmp st0 > st2 ? (st0 wird geändert/entfernt)   STK:(0:akt,1:max,2:min)
        fnstsw ax
        sahf
        jbe    over2                  ; überspringe wenn st0 <= st2
        fst    st(1)                  ; sichere neuen Maximumwert (derzeit st1)   STK:(0:akt,1:neumax,2:min)
        over2:
        fstp   [tmp]                  ; entferne akt.Wert vom Stapel   STK:(0:max,1:min)
        add    edx, 8						; auf den nächsten double-Wert zeigen
        sub    ecx, 1                 ; Countdown
        jne    schleife               ; solange <> 0 : weitermachen
        fstp   qword ptr [ebx]        ; Maximum sichern   STK:(0:min)
        fstp   qword ptr [ebx+8]      ; Minimum sichern   STK:()

    AsmEnd

    --- kleiner Zusatz-Programmteil ---
    Zahlen am Dezimalpunkt ausrichten
    - zuerst den am weitesten rechts stehenden Dezimalpunkt feststellen
    Declare Dezipunkt%, i%,tmp$, j%,tmp2$

    WhileLoop anzahl&

        tmp$ = Str$(Tabelle_1![&loop - 1])
        i% = InStr(".",tmp$)
        Case (i% = 0) : i% = Len(tmp$) + 1  dann stehen Integers vor dem Dezipunkt
        Case (i% > Dezipunkt%) : Dezipunkt% = i%

    EndWhile

    Inc Dezipunkt%  dadurch ist links mind. ein Leerzeichen
    - dann die ausgerichtete Ausgabe

    WhileLoop anzahl&

        tmp$ = Str$(Tabelle_1![&loop - 1])
        i% = InStr(".",tmp$)

        If i% = 0

            Print Space$(Dezipunkt% - Len(tmp$) - 1) + tmp$

        Else

            Print Space$(Dezipunkt% - i%) + tmp$

        EndIf

    EndWhile

    - für die MinMax-Werte
    tmp$ = Str$(Tabelle_2![0])
    i% = InStr(".",tmp$)
    tmp2$ = Str$(Tabelle_2![1])
    j% = InStr(".",tmp2$)
    Dezipunkt% = if(i% > j%,i%,j%) + 1
    Print
    Print "Höchste Zahl aus dem Array    =", Space$(Dezipunkt% - i%) + tmp$
    Print "Niedrigste Zahl aus den Array =", Space$(Dezipunkt% - j%) + tmp2$

EndProc

Proc Frac

    Parameters value!

    AsmStart Frac_asm ( Addr(value!) )

        Local d1 :WORD
        local d2:word
        mov     edx, para1
        fnstcw  [d1]		; fpu control word wegsichern
        fwait			; warten
        mov     cx, [d1]
        or      cx, 0F00h		; Präzision/Rundung maskieren (keine Rundung)
        mov     [d2], cx		; Änderung nach d2
        fldcw   [d2]		; ...und in die fpu
        fld     qword ptr [edx]	; Wert laden
        frndint			; runde Wert auf Ganzzahl (also abschneiden)
        fld     qword ptr [edx]	; Wert laden (st0=gesamtwert,st1=INT-Wert)
        fsub    st(0), st(1)		; value! - INT(value!)
        fstp    st(1)		; st0 nach st1 kopieren und st0 vom stack entfernen
        fstp    qword ptr [edx]	; jetzigen st0 nach value! speichern
        fldcw   [d1]		; fpu control word zurückladen

    AsmEnd

    Return value!

EndProc

Proc Ausgabe

    Parameters d!
    print "Wert.....: ", d!
    print "gerundet.: ", Round( d!, 0 )
    print "Ganzzahl.: ", Int( d! )
    print "Nachkomma: ", Frac( d! )

EndProc

--- Main ---
set("decimals",15)
WindowTitle "Frac - anschließend geändertes Fließkommazahlen.prf"
Window 0,0 - %maxx,%maxy
Print
Print "Zeigt das Runden, den Vorkomma-Wert, und mittels Assembler den Nachkomma-Wert."
Print
Print "----------"
Ausgabe 5.6
Print "----------"
Ausgabe Pi()
Print "----------"
Print
Print "weiter mit Tastendruck/Mausklick"
Print
waitinput
WindowTitle "jetzt geändertes Fließkommazahlen.prf"
geaendertes_Beispiel
Print
Print "Dieses FindEdge findet Maximum und Minimum"
Print "in einem Array in nur einem Durchgang."
Print "Zur Zwischenspeicherung wird der FPU-Stack benutzt."
Print
Print "Zahlen werden am Dezimalpunkt ausgerichtet."
Print
Print "Ende nach Tastendruck/Mausklick"
waitinput
end