; --------------------------------------------------------------terug.gif
; Deze file bevat de afhandeling van floating point functies. Deze functies
; testen niet of de 80x87 processor aanwezig is. Ze mogen pas aangeroepen
; worden als getest is of de coprocessor aanwezig is. Dit kan met subfunctie #00.
; Met subfunctie #00 kan eveneens ingesteld worden met welke floating point
; notatie gewerkt dient te worden. Ondersteund worden Atom notatie en Intel 8
;--------------------------------------------------------------
; Auteur: Roland Leurs december 1995
; Toevoeging: Leendert Bijnagte    februari 1998
; Maart 1998 0.1 Aanpassing in documentatie, FPATN opgevoerd
; Domweg vergeten in de vorige uitvoering
; --------------------------------------------------------------
                P386
                P387
ATOM            DQ      0                       ; ATOM FP GETAL
INTEL           DQ      0                       ; INTEL FP GETAL
COPROC          DB      0                       ; COPROCESSOR TYPE
FPMODE          DB      0                       ; FLOATING POINT MODE
CONST180        DQ      180.0                   ; CONSTANTE WAARDE 180
HALF            DQ      0.5                     ; CONSTANTE WAARDE 0.5000
SaveCW          DW      ?                       ; var voor 2^x (LB)
MaskedCW        DW      ?
 

; --------------------------------------------------------------
; Algemene floating point subroutines
; --------------------------------------------------------------

ATEL            PROC    NEAR                    ; CONVERSIE VAN ATOM->INTEL8
                XOR     AX,AX                   ; CLEAR INTEL WAARDE
                MOV     WORD PTR INTEL[0],AX
                MOV     WORD PTR INTEL[2],AX
                MOV     WORD PTR INTEL[4],AX
                MOV     WORD PTR INTEL[6],AX
                MOV     AH,BYTE PTR ATOM[1]     ; ATOM MANTISSA NAAR AX:BX
                MOV     AL,BYTE PTR ATOM[2]
                MOV     BH,BYTE PTR ATOM[3]
                MOV     BL,BYTE PTR ATOM[4]
                XOR     DX,DX                   ; DX OOK BIJ INTEL MANTISSA
                MOV     CX,0BH                  ; LAADT TELLER
ATEL1:          SHR     AX,1                    ; SCHUIF MANTISSA DRIE BITS
                RCR     BX,1
                RCR     DX,1
                LOOP    ATEL1
                MOV     CL,BYTE PTR ATOM[1]     ; LAADT SIGN BIT IN CL7
                SHL     AX,1                    ; MAAK PLAATS VOOR SIGN BIT
                SHL     CL,1                    ; ZET SIGN BIT IN CARRY
                RCR     AX,1                    ; SCHUIF SIGN BIT IN AX
                AND     AX,1000000000001111B    ; EXPONENT NOG BEREKENEN
                MOV     CL,BYTE PTR ATOM[0]     ; LAADT EXPONENT IN CL
                XOR     CL,80H                  ; INVERTEER BIAS BIT
                XCHG    AX,CX                   ; WISSEL AX EN CX TIJDELIJK
                CBW
                XCHG    AX,CX                   ; WISSEL AX EN CX WEER
                ADD     CX,1022                 ; BEREKEN INTEL'S EXPONENT
                SHL     CX,1                    ; RESULTAAT OPSCHUIVEN
                SHL     CX,1
                SHL     CX,1
                SHL     CX,1
                XOR     AX,CX                   ; EXPONENT TOEVOEGEN
                MOV     WORD PTR INTEL[6],AX    ; RESULTAAT OPSLAAN
                MOV     WORD PTR INTEL[4],BX
                MOV     WORD PTR INTEL[2],DX
                RET                             ; EINDE ROUTINE
ATEL            ENDP

INTOM           PROC    NEAR                    ; CONVERSIE VAN INTEL8->ATOM
                MOV     AH,BYTE PTR INTEL[7]    ; LAADT MANTISSA IN AX:BX:BX
                MOV     AL,BYTE PTR INTEL[6]
                MOV     BH,BYTE PTR INTEL[5]
                MOV     BL,BYTE PTR INTEL[4]
                MOV     DH,BYTE PTR INTEL[3]
                MOV     DL,BYTE PTR INTEL[2]
                MOV     CX,11                   ; LAADT TELLER
INTOM1:         SHL     DX,1                    ; SCHUIF LINKS
                RCL     BX,1
                RCL     AX,1
                LOOP    INTOM1                  ; ELF MAAL DOEN
                SHL     AX,1                    ; EVEN OPSCHUIVEN
                MOV     CL,BYTE PTR INTEL[7]    ; LEES TEKEN VAN INTEL
                SHL     CL,1                    ; SCHUIF TEKEN IN CARRY
                RCR     AX,1                    ; SCHUIF TEKEN IN MANTISSA
                MOV     BYTE PTR ATOM[1],AH     ; ATOM MANTISSA WEGSCHRIJVEN
                MOV     BYTE PTR ATOM[2],AL
                MOV     BYTE PTR ATOM[3],BH
                MOV     BYTE PTR ATOM[4],BL
                MOV     AH,BYTE PTR INTEL[7]    ; LAADT INTEL EXPONENT
                MOV     AL,BYTE PTR INTEL[6]
                MOV     CL,4                    ; LAADT TELLER
                SHR     AX,CL                   ; BEPAAL EXPONENT
                AND     AX,7FFH                 ; ALLEEN ONDERSTE 11 BITS
                SUB     AX,1022                 ; ATOM EXPONENT BEREKENEN
                PUSHF                           ; SAVE CARRY
                SHL     AL,1                    ; EVEN PLAATSMAKEN VOOR BIAS
                POPF                            ; HAAL CARRY TERUG
                RCR     AL,1                    ; ZET CARRY ALS BIAS
                XOR     AL,80h                  ; INVERT OM KLOPPEND TE MAKEN
                MOV     BYTE PTR ATOM[0],AL     ; BERG ATOM EXPONENT OP
                RET                             ; EINDE ROUTINE
INTOM           ENDP

ZENDREAL        PROC    NEAR                    ; STUUR FP GETAL NAAR ATOM
                CMP     FPMODE,0                ; TEST OP ATOM MODE
                JNE     ZENDREAL1               ; SPRING INDIEN INTEL MODE
                CALL    INTOM                   ; CONVERTEER WAARDE NAAR ATOM
                MOV     SI,OFFSET ATOM          ; LAADT ADRES ATOM MODE
                MOV     CX,5                    ; LEES AANTAL TE ZENDEN BYTES
                JMP     SHORT ZENDREAL2         ; GEDWONGEN SPRONG
ZENDREAL1:      MOV     SI,OFFSET INTEL         ; LAADT ADRES INTEL MODE
                MOV     CX,8                    ; LAADT AANTAL TE ZENDEN BYTES
ZENDREAL2:      MOV     AL,BYTE PTR [SI]        ; LEES BYTE
                CALL    ZENDBYTE                ; STUUR NAAR ATOM
                INC     SI                      ; VERHOOG POINTER
                LOOP    ZENDREAL2               ; DOE VOOR ALLE BYTES
                RET                             ; EINDE ROUTINE
ZENDREAL        ENDP

LEESREAL        PROC    NEAR                    ; LEES FP GETAL VAN ATOM
                CMP     FPMODE,0                ; TEST OP ATOM MODE
                JNE     LEESREAL1               ; SPRING INDIEN INTEL MODE
                MOV     DI,OFFSET ATOM          ; LAADT ADRES ATOM MODE
                MOV     CX,5                    ; LEES AANTAL TE ZENDEN BYTES
                JMP     SHORT LEESREAL2         ; GEDWONGEN SPRONG
LEESREAL1:      MOV     DI,OFFSET INTEL         ; LAADT ADRES INTEL MODE
                MOV     CX,8                    ; LAADT AANTAL TE ZENDEN BYTES
LEESREAL2:      CALL    LEESBYTE                ; LEES BYTE VAN ATOM
                MOV     BYTE PTR [DI],AL        ; BERG OP IN VARIABELE
                INC     DI                      ; VERHOOG POINTER
                LOOP    LEESREAL2               ; DOE VOOR ALLE BYTES
                CMP     FPMODE,0                ; TEST NOGMAALS OP ATOM MODE
                JNE     LEESREAL3               ; SPRING INDIEN NIET ATOM
                CALL    ATEL                    ; ZET OM NAAR INTEL NOTATIE
LEESREAL3:      RET                             ; EINDE ROUTINE
LEESREAL        ENDP

; --------------------------------------------------
; Subcommando interpreter
; --------------------------------------------------

FPFUN:          CALL    LEESBYTE        ; LEES SUBFUNCTIE NUMMER
                CMP     AL,20H          ; TEST OP GELDIGE FUNCTIE
                JLE     FPFUN1          ; SPRING INDIEN GELDIG
                MOV     FUN_CODE,AL     ; ZET AL IN WERKRUIMTE
                ;MP     ERROR           ; GEEF FOUTMELDING EN BEEINDIG ROUTINE
FPFUN1:         MOV     AH,0            ; MAAK HOGE BYTE AX 0
                SHL     AX,1            ; MAAK ER EEN WORD POINTER VAN
                MOV     BX,AX           ; ZET TABEL OFFSET IN BASE REGISTER
                JMP     WORD PTR FPTAB[BX]  ; SPRING NAAR SUBFUNCTIE

FPTAB:  DW FPROC, FPADD, FPSUB, FPMUL, FPDIV, FPABS    ; 0, 1, 2, 3, 4, 5
        DW FPRNDINT, FPSQRT, FTANG, FPSIN, FPCOS       ; 6, 7, 8, 9, A
        DW FPDEG, FPRAD, FPOWER, FPHTN, FPLN, FPLOG    ; b, c, d, e, f, 10
        DW FPYTOX, FPEXP, FPTENTOX, FPACOT, FPACOS     ; 11, 12, 13, 14, 15
        DW FPASIN, FPSEC, FPCSC, FPCOT, FPTWOTOX       ; 16, 17, 18, 19, 1a
        DW FPATN                                       ; 1b
        DW FPEQ, FPNE, FPGE, FPGT, FPLE, FPLT          ; 1C, 1D, 1E, 1F, 20
 

;   Dit is de wensenlijst van Leendert van functies die er in zouden moeten
;   Niet direct bij aanvang, maar zeker bij latere uitbreidingen.
;  Naam       | Doel van de functie        unc. No Datum Laatste
;  FABS       | Absolute value        5 13/3/1998
;  FACOS      | FP Arc Cosine       21 13/3/1998
;  FASIN      | FP Arc Sine       22 13/3/1998
;  FATAN      | FP Arc Tangent       27 13/3/1998
;  FATANH     | FP Hyperbolic Arc Tangent     14 13/3/1998
;  FCOS       | FP Cosine       10 13/3/1998
;  FCOSH      | FP Hyperbolic Cosine
;  FETOX      | FP e^x        17 13/3/1998
;  FETOXM1    | FP e^(x-1)
;  FGETEXP    | Get exponent
;  FGETMAN    | Get mantissa
;  FINT       | FP Integer
;  FINTRZ     | Get integer and round down
;  FLOGN      | FP Ln(n)       15 13/3/1998
;  FLOGNP1    | FP Ln(n+1)
;  FLOG10     | FP Log10(n)       16 13/3/1998
;  FLOG2      | FP Log2(n)
;  FNEG       | Negate a floating point number
;  FSIN       | FP Sine         9 13/3/1998
;  FSINH      | FP Hyperbolic Sine
;  FSQRT      | FP Square Root        7 13/3/1998
;  FTAN       | FP Tangent        8 13/3/1998
;  FTANH      | FP Hyperbolic Tangent
;  FTENTOX    | FP 10^x        18 13/3/1998
;  FTWOTOX    | FP 2^x        26 13/3/1998
 

; --------------------------------------------------
; Commando's
; --------------------------------------------------

FPROC:          CALL    LEESBYTE        ; LEES FP-MODE (0=ATOM, 1=INTEL)
                MOV     FPMODE,AL       ; BERG OP
                FNINIT                  ; INIT COPROCESSOR
                XOR     DX,DX           ; CLEAR PROCESSORTYPE
                MOV     WORD PTR INTEL,5A5AH
                FNSTSW  WORD PTR INTEL
                CMP     BYTE PTR INTEL,DL
                JNE     SET_FLAGS       ; GEEN COPROCESSOR AANWEZIG
                FNSTCW  WORD PTR INTEL
                MOV     AX,WORD PTR INTEL
                AND     AX,103FH
                CMP     AX,3FH
                JNE     SET_FLAGS       ; GEEN COPROCESSOR AANWEZIG
                INC     DX              ; VERHOOG PROCESSORTYPE 8087/80287
                FLD1
                FLDZ
                FDIV
                FLD     ST
                FCHS
                FCOMPP
                FSTSW   WORD PTR INTEL
                MOV     AX,WORD PTR INTEL
                SAHF
                JE      SET_FLAGS       ; SPRING ALS 8087 OF 80287
                INC     DX              ; HET IS EEN 80387 OF HOGER
SET_FLAGS:      MOV     COPROC,DL       ; SCHRIJF PROCESSORTYPE WEG
                MOV     AL,DL           ; STUUR TEVENS NAAR ATOM
                CALL    ZENDBYTE
                JMP     LEESCOM         ; EINDE COMMANDO

FPADD:          CALL    LEESREAL        ; LEES EERSTE GETAL
                FLD     INTEL           ; LEES IN PROCESSOR
                CALL    LEESREAL        ; LEES TWEEDE GETAL
                FADD    INTEL           ; TEL DE GETALLEN OP
                FSTP    INTEL           ; ZET RESULTAAT IN GEHEUGEN
                WAIT
                CALL    ZENDREAL        ; STUUR NAAR ATOM
                JMP     LEESCOM         ; EINDE COMMANDO

FPSUB:          CALL    LEESREAL        ; LEES EERSTE GETAL
                FLD     INTEL           ; LEES IN PROCESSOR
                CALL    LEESREAL        ; LEES TWEEDE GETAL
                FSUB    INTEL           ; TREK GETALLEN VAN ELKAAR AF
                FSTP    INTEL           ; ZET RESULTAAT IN GEHEUGEN
                WAIT
                CALL    ZENDREAL        ; STUUR NAAR ATOM
                JMP     LEESCOM         ; EINDE COMMANDO

FPMUL:          CALL    LEESREAL        ; LEES EERSTE GETAL
                FLD     INTEL           ; LEES IN PROCESSOR
                CALL    LEESREAL        ; LEES TWEEDE GETAL
                FMUL    INTEL           ; VERMENIGVULDIG DE GETALLEN
                FSTP    INTEL           ; ZET RESULTAAT IN GEHEUGEN
                WAIT
                CALL    ZENDREAL        ; STUUR NAAR ATOM
                JMP     LEESCOM         ; EINDE COMMANDO

FPDIV:          CALL    LEESREAL        ; LEES EERSTE GETAL
                FLD     INTEL           ; LEES IN PROCESSOR
                CALL    LEESREAL        ; LEES TWEEDE GETAL
                FDIV    INTEL           ; DEEL DE GETALLEN
                FSTP    INTEL           ; ZET RESULTAAT IN GEHEUGEN
                WAIT
                CALL    ZENDREAL        ; STUUR NAAR ATOM
                JMP     LEESCOM         ; EINDE COMMANDO

FPABS:          CALL    LEESREAL        ; LEES GETAL
                FLD     INTEL           ; LEES IN PROCESSOR
                FABS                    ; BEREKEN ABSOLUTE WAARDE
                FSTP    INTEL           ; ZET RESULTAAT IN GEHEUGEN
                WAIT
                CALL    ZENDREAL        ; STUUR NAAR ATOM
                JMP     LEESCOM         ; EINDE COMMANDO

FPRNDINT:       CALL    LEESREAL        ; LEES GETAL
                FLD     INTEL           ; LEES IN PROCESSOR
                FRNDINT                 ; ROND AF NAAR INTEGER WAARDE
                FSTP    INTEL           ; ZET RESULTAAT IN GEHEUGEN
                WAIT
                CALL    ZENDREAL        ; STUUR NAAR ATOM
                JMP     LEESCOM         ; EINDE COMMANDO

FPSQRT:         CALL    LEESREAL        ; LEES GETAL
                FLD     INTEL           ; LEES IN PROCESSOR
                FSQRT                   ; BEREKEN VIERKANTSWORTEL
                FSTP    INTEL           ; ZET RESULTAAT IN GEHEUGEN
                WAIT
                CALL    ZENDREAL        ; STUUR NAAR ATOM
                JMP     LEESCOM         ; EINDE COMMANDO

FTANG:          CALL    LEESREAL        ; LEES GETAL
                CMP     COPROC,2        ; TEST OP 80387
                JE      FTAN387         ; JA, VERVOLG ROUTINE
                JMP     FTAN287         ; VOOR 287 ANDERE ROUTINE
FTAN387:        FLD     INTEL           ; LEES WAARDE IN PROCESSOR
                FPTAN                   ; BEREKEN VERHOUDING Y/X
                FDIV                    ; BEREKEN TANGENS
                FSTP    INTEL           ; ZET RESULTAAT IN GEHEUGEN
                CALL    ZENDREAL        ; STUUR NAAR ATOM
                JMP     LEESCOM         ; EINDE COMMANDO

FTAN287:        CALL    _FTAN287        ; LAAT TANGENS BEREKENEN DOOR PROC
                CALL    ZENDREAL        ; STUUR NAAR ATOM
                JMP     LEESCOM         ; EINDE COMMANDO

_FTAN287        PROC    NEAR            ; BEREKEN TANGENS VAN GETAL IN ST
                FINIT
                FLD     INTEL           ; LEES WAARDE IN PROCESSOR
                FLD     HALF            ; LAAD 0.5
                FLDPI                   ; LAAD PI
                FMUL                    ; BEREKEN 0.5*PI
                FLDPI                   ; LAAD PI NOGMAALS
                FXCH    ST(2)           ; ST=x, ST(1)=0.5*PI, ST(2)=PI
                FTST                    ; BEPAAL TEKEN VAN ST
                FSTSW   TEMP            ; ZET STATUSREGISTER IN TEMP
                FWAIT
                MOV     AX,WORD PTR TEMP; KOPIEER STATUS NAAR FLAGS
                SAHF
                JC      FTAN_NEG        ; SPRING ALS ST < 0
FTAN_POS:       FCOM    ST(1)           ; KIJK OF ST > 0.5*PI
                FSTSW   TEMP
                FWAIT
                MOV     AX,WORD PTR TEMP
                AND     AH,01000001B    ; FILTER BENODIGDE STATUSBITS
                JNZ     FTAN287A        ; EXIT ALS ST <= 0.5*PI
                FSUB    ST,ST(2)        ; ST:=ST-PI
                JMP     SHORT FTAN_POS
FTAN_NEG:       FXCH    ST(1)           ; ZET -0.5*PI IN ST(1)
                FCHS
                FXCH    ST(1)           ; ST=x, ST(1)=-0.5*PI, ST(2)=PI
FTAN_NEG1:      FCOM    ST(1)           ; KIJK OF ST < -0.5*PI
                FSTSW   TEMP
                FWAIT
                MOV     AX,WORD PTR TEMP
                SAHF
                JNC     FTAN287A        ; EXIT ALS ST >= -0.5*PI
                FADD    ST,ST(2)        ; ST:=ST+PI
                JMP     SHORT FTAN_NEG1
FTAN287A:       FTST                    ; BEPAAL TEKEN VAN NIEUWE ST
                FSTSW   TEMP            ; BERG OP IN WERKRUIMTE
                FABS                    ; BEPAAL |ST|
                FLD     HALF            ; LAAD 0.5
                FMUL    ST,ST(3)        ; VERMENIGVULDIG MET 0.5*PI
                FABS                    ; HET RESULTAAT KAN NEGATIEF ZIJN
                FCOM                    ; TEST OF ST(1) < OF > 0.25*PI
                FSTSW   TEMP[2]
                FWAIT
                MOV     AX,WORD PTR TEMP[2]
                SAHF
                JC      FTANREV         ; SPRING ALS ST(1) > 0.25*PI
                FLD     ST(1)           ; LAAD ARGUMENT IN ST
                FPTAN                   ; BEREKEN TANGENS VAN ST
                FDIV
                JMP     SHORT FTAN287B  ; GA TEKEN NOG GOED ZETTEN
FTANREV:        FLD     HALF            ; LAAD 0.5
                FLDPI                   ; LAAD PI
                FMUL                    ; BEREKEN 0.5*PI
                FSUB    ST,ST(1)        ; BEREKEN 0.5*PI-ST(1)
                FPTAN                   ; BEREKEN DAAR DE TANGENS VAN
                FDIV
                FLD1                    ; LAAD WAARDE 1
                FDIV                    ; BEREKEN 1/TAN(0.5*PI-x)
FTAN287B:       MOV     AX,WORD PTR TEMP; HAAL TEKEN INFO TERUG
                SAHF                    ; ZET IN FLAGS
                JNC     FTAN287C        ; SPRING INDIEN POSITIEF
                FCHS                    ; MAAK NEGATIEF
FTAN287C:       FSTP    INTEL           ; ZET EINDRESULTAAT IN WERKRUIMTE
                FWAIT
                RET                     ; EINDE TAN287 ROUTINE
_FTAN287        ENDP

                P386                    ; DEZE FUNCTIES ALLEEN VOOR 80386
                P387
FPSIN:          CALL    LEESREAL        ; LEES GETAL
                CMP     COPROC,2        ; TEST OP 387
                JE      FPSIN387
                JMP     FPSIN287        ; VOOR 287 ANDERE ROUTINE
FPSIN387:       FLD     INTEL           ; LEES IN PROCESSOR
                FSIN                    ; BEREKEN SINUS
                FSTP    INTEL           ; ZET RESULTAAT IN GEHEUGEN
                CALL    ZENDREAL        ; STUUR NAAR ATOM
                JMP     LEESCOM         ; EINDE COMMANDO
                P286
                P287

FPSIN287:       CALL    FPCOSIN287      ; BEREKEN SINUS
                FLD     QWORD PTR TEMP  ; LAAD SINUS
                FSTP    INTEL           ; ZET IN GEHEUGEN
                FWAIT
                CALL    ZENDREAL        ; STUUR NAAR ATOM
                JMP     LEESCOM         ; EINDE COMMANDO

                P386
                P387
FPCOS:          CALL    LEESREAL        ; LEES GETAL
                CMP     COPROC,2        ; TEST OP 387
                JE      FPCOS387
                JMP     FPCOS287        ; VOOR 287 ANDERE ROUTINE
FPCOS387:       FLD     INTEL           ; LEES IN PROCESSOR
                FCOS                    ; BEREKEN COSINUS
                FSTP    INTEL           ; ZET RESULTAAT IN GEHEUGEN
                CALL    ZENDREAL        ; STUUR NAAR ATOM
                JMP     LEESCOM         ; EINDE COMMANDO
                P286                    ; EN WEER TERUG NAAR 286 INSTRUKTIES
                P287

FPCOS287:       CALL    FPCOSIN287      ; BEREKEN COSINUS
                CALL    ZENDREAL        ; STUUR NAAR ATOM
                JMP     LEESCOM         ; EINDE ROUTINE

FPCOSIN287      PROC    NEAR            ; BEREKEN COS EN SIN VAN ST
                FLDPI                   ; LAAD PI
                FLD     INTEL           ; LAAD x
                FPREM
                FST     QWORD PTR TEMP[24] ; BEWAAR IN WERKRUIMTE
                FSTP    INTEL           ; PLAATS IN WERKRUIMTE
                FWAIT
                CALL    _FTAN287        ; BEREKEN TAN
                FLD     INTEL           ; HAAL TAN OP
                FST     QWORD PTR TEMP[16] ; BERG OP VOOR LATER GEBRUIK
                FLD     INTEL           ; HAAL NOGMAALS TAN OP
                FMUL                    ; BEREKEN TAN-KWADRAAT
                FLD1                    ; TEL ER 1 BIJ OP
                FADD
                FLD1                    ; LAAD 1
                FDIVR                   ; BEREKEN 1/(1+TAN-KWADRAAT)
                FSQRT                   ; BEREKEN SQRT (1/(1+TAN-KWADRAAT))
                FSTP    INTEL           ; ZET IN GEHEUGEN
                FWAIT
                FLD     QWORD PTR TEMP[24] ; TEKEN NOG AANPASSEN
                FABS                    ; BEPAAL |ST|  (ST= x)
                FLDPI                   ; LAAD PI
                FLD     HALF            ; LAAD 0.5
                FMULP                   ; ST = 0.5*PI
                FCOM    ST(1)           ; TEST OF |x| < 0.5*PI
                FSTSW   TEMP
                MOV     AX,WORD PTR TEMP
                SAHF
                JNC     FPCOSIN287A
                FLD     INTEL           ; WIJZIG HET TEKEN
                FCHS
                FST     INTEL           ; BERG COS x WEER OP
FPCOSIN287A:    FLD     INTEL           ; LAAD COS IN ST
                FLD     QWORD PTR TEMP[16] ; LAAD TAN IN ST
                FMUL                    ; COS * TAN = SIN
                FSTP    QWORD PTR TEMP  ; BERG SIN x OP IN TEMP
                FWAIT
                FINIT                   ; RESET 287
                RET                     ; INTEL=COS, ST=SIN
FPCOSIN287      ENDP

FPDEG:          CALL    LEESREAL        ; LEES GETAL
                FLD     INTEL           ; LEES IN PROCESSOR
                FMUL    CONST180        ; VERMENIGVULDIG MET 180
                FLDPI                   ; DEEL DOOR PI
                FDIV
                FSTP    INTEL           ; ZET RESULTAAT IN GEHEUGEN
                WAIT
                CALL    ZENDREAL        ; STUUR NAAR ATOM
                JMP     LEESCOM         ; EINDE COMMANDO

FPRAD:          CALL    LEESREAL        ; LEES GETAL
                FLD     INTEL           ; LEES IN PROCESSOR
                FDIV    CONST180        ; DEEL DOOR 180
                FLDPI                   ; DEEL DOOR PI
                FMUL
                FSTP    INTEL           ; ZET RESULTAAT IN GEHEUGEN
                WAIT
                CALL    ZENDREAL        ; STUUR NAAR ATOM
                JMP     LEESCOM         ; EINDE COMMANDO

; Dit ding gebruik ik als raamwerk voor de volgende functies.
; Hier wordt een argument doorgegeven en vervolgens ook weer geretourneerd.
; FPSKEL:      CALL     LEESREAL        ; LEES GETAL
;              FLD      INTEL           ; LEES IN PROCESSOR
;              FSTP     INTEL           ; ZET RESULTAAT IN GEHEUGEN
;              WAIT
;              CALL     ZENDREAL        ; STUUR NAAR ATOM
;              JMP      LEESCOM         ; EINDE COMMANDO

; FPEQ   vergelijkt twee waarden op de stack en geeft in geval van
;   een gelijke waarde een 0 terug en anders een 1
;   bits C0, 1 en 3 bevatten relevante informatie:
;   C3 C2 C0
;   0   0 0   st > source      (JA, JAE)
;   0   0 1   st < source      (JB, JBE)
;   1   0 0   st = source      (JZ)
;   1   1 1   st is geen nummer

FPEQ:          CALL     LEESREAL        ; LEES GETAL
               FLD      INTEL           ; LEES IN PROCESSOR
               CALL     LEESREAL        ; put number on top of stack
               FLD      INTEL
               FCOMPP                   ; sleur 2 waardes van de stack
               mov      bl, 02AH        ; bl op 0, geen Z geen C op 6502 niveau
               FSTSW    AX              ; status in ax, update flags
               sahf                     ; store C0 in carry, c2 in par, en c3 in zero flag
               JZ       equal
               mov      bl, 0           ; doe alsof er een Carry en een Z is voor de 6502
equal:         WAIT
               MOV      AL, bl          ; ALLES 0
               CALL     ZENDBYTE        ; STUUR NAAR ATOM
               JMP      LEESCOM         ; EINDE COMMANDO

; FPNE           vergelijkt twee waarden op de stack en geeft in geval van
;   een gelijke waarde een 0 terug en anders een 1
;   bits C0, 1 en 3 bevatten relevante informatie:
;   C3 C2 C0
;   0   0 0   st > source      (JA, JAE)
;   0   0 1   st < source      (JB, JBE)
;   1   0 0   st = source      (JZ)
;   1   1 1   st is geen nummer

FPNE:          CALL     LEESREAL        ; LEES GETAL
               FLD      INTEL           ; LEES IN PROCESSOR
               CALL     LEESREAL        ; put number on top of stack
               FLD      INTEL
               FCOMPP                   ; sleur 2 waardes van de stack
               mov      bl, 02AH        ; bl op 0, geen Z geen C op 6502 niveau
               FSTSW    AX              ; status in ax, update flags
               sahf                     ; store C0 in carry, c2 in par, en c3 in zero flag
               JZ       neequal
               mov      bl, 0           ; doe alsof er een Carry en een Z is voor de 6502
neequal:       WAIT
               MOV      AL, bl          ; ALLES 0
               CALL     ZENDBYTE        ; STUUR NAAR ATOM
               JMP      LEESCOM         ; EINDE COMMANDO
 

; FPGT           vergelijkt twee waarden op de stack en geeft in geval van
;   een gelijke waarde een 0 terug en anders een 1
;   bits C0, 1 en 3 bevatten relevante informatie:
;   C3 C2 C0
;   0   0 0   st > source      (JA, JAE)
;   0   0 1   st < source      (JB, JBE)
;   1   0 0   st = source      (JZ)
;   1   1 1   st is geen nummer

FPGT:        CALL    LEESREAL        ; LEES GETAL
             FLD     INTEL           ; LEES IN PROCESSOR
             CALL    LEESREAL        ; put number on top of stack
             FLD     INTEL
             FCOMPP                  ; sleur 2 waardes van de stack
             mov     bl, 0           ; bl op 0, geen Z geen C op 6502 niveau
             FSTSW   AX              ; status in ax, update flags
             sahf                    ; store C0 in carry, c2 in par, en c3 in zero flag
             JNC     gethan
             mov     bl, 02BH        ; doe alsof er een Carry en een Z is voor de 6502
gethan:      WAIT
             MOV     AL, bl          ; ALLES 0
             CALL    ZENDBYTE        ; STUUR NAAR ATOM
             JMP     LEESCOM         ; EINDE COMMANDO

; FPGE           vergelijkt twee waarden op de stack en geeft in geval van
;   een gelijke waarde een 0 terug en anders een 1
;   bits C0, 1 en 3 bevatten relevante informatie:
;   C3 C2 C0
;   0   0 0   st > source      (JA, JAE)
;   0   0 1   st < source      (JB, JBE)
;   1   0 0   st = source      (JZ)
;   1   1 1   st is geen nummer

FPGE:            CALL    LEESREAL        ; LEES GETAL
                 FLD     INTEL           ; LEES IN PROCESSOR
                 CALL    LEESREAL        ; put number on top of stack
                 FLD     INTEL
                 FCOMPP                  ; sleur 2 waardes van de stack
                 mov     bl, 02AH        ; bl op 0, geen Z geen C op 6502 niveau
                 FSTSW   AX              ; status in ax, update flags
                 sahf                    ; store C0 in carry, c2 in par, en c3 in zero flag
                 Jbe     geequal
                 mov     bl, 0           ; doe alsof er een Carry en een Z is voor de 6502
geequal:         WAIT
                 MOV     AL, bl          ; ALLES 0
                 CALL    ZENDBYTE        ; STUUR NAAR ATOM
                 JMP     LEESCOM         ; EINDE COMMANDO

; FPLT           vergelijkt twee waarden op de stack en geeft in geval van
;   een gelijke waarde een 0 terug en anders een 1
;   bits C0, 1 en 3 bevatten relevante informatie:
;   C3 C2 C0
;   0   0 0   st > source      (JA, JAE)
;   0   0 1   st < source      (JB, JBE)
;   1   0 0   st = source      (JZ)
;   1   1 1   st is geen nummer

FPLT:            CALL    LEESREAL        ; LEES GETAL
                 FLD     INTEL           ; LEES IN PROCESSOR
                 CALL    LEESREAL        ; put number on top of stack
                 FLD     INTEL
                 FCOMPP                  ; sleur 2 waardes van de stack
                 mov     bl, 02CH        ; bl op 0, geen Z geen C op 6502 niveau
                 FSTSW   AX              ; status in ax, update flags
                 sahf                    ; store C0 in carry, c2 in par, en c3 in zero flag
                 JBE     let
                 mov     bl, 0           ; doe alsof er een Carry en een Z is voor de 6502
let:             WAIT
                 MOV     AL, bl          ; ALLES 0
                 CALL    ZENDBYTE        ; STUUR NAAR ATOM
                 JMP     LEESCOM         ; EINDE COMMANDO

; FPLE           vergelijkt twee waarden op de stack en geeft in geval van
;   een gelijke waarde een 0 terug en anders een 1
;   bits C0, 1 en 3 bevatten relevante informatie:
;   C3 C2 C0
;   0   0 0   st > source      (JA, JAE)
;   0   0 1   st < source      (JB, JBE)
;   1   0 0   st = source      (JZ)
;   1   1 1   st is geen nummer

FPLE:            CALL    LEESREAL       ; LEES GETAL
                 FLD     INTEL          ; LEES IN PROCESSOR
                 CALL    LEESREAL       ; put number on top of stack
                 FLD     INTEL
                 FCOMPP                 ; sleur 2 waardes van de stack
                 mov     bl, 02AH       ; bl op 0, geen Z geen C op 6502 niveau
                 FSTSW   AX             ; status in ax, update flags
                 sahf                   ; store C0 in carry, c2 in par, en c3 in zero flag
                 Jbe     leeq
                 mov     bl, 0          ; doe alsof er een Carry en een Z is voor de 6502
leeq:            WAIT
                 MOV     L, bl          ; ALLES 0
                 CALL    ZENDBYTE       ; STUUR NAAR ATOM
                 JMP     LEESCOM        ; EINDE COMMANDO

; HTN(x)- Berekent de hyperbolische tangens van hoek x in radialen.
;  Maakt gebruik van een formule, omdat de functie niet als
;  implied instructie beschikbaar is.
;
;      htn(x) = (exp(x) - exp(-x) / exp(x) + exp(-x) ).
;

FPHTN:          CALL    LEESREAL        ; LEES GETAL
                FLD     INTEL           ; LEES IN PROCESSOR
                call    exp             ; bereken exponent (e tot de macht (arg))
                FLD     INTEL           ; LEES IN PROCESSOR
                fchs                    ; wissel het teken
                call    exp             ; bereken van -x het exponent
                fld     st(1)           ; dupliceer het eerste antwoord
                fld     st(1)           ; en dupliceer het tweede antwoord
                fsub                    ; trek beide van elkaar af.
                fld     st(2)           ; dupliceer het eerste antwoord op stack
                faddp   st(2),st        ; tel TOS en ST0 op en plaats op TOS
                fdiv    st,st(1)        ; deel deze tegen elkaar weg
                FSTP    INTEL           ; ZET RESULTAAT IN GEHEUGEN
                fstp                    ; ruim rotzooi op (st(1))
                fstp    st(0)           ; ruim rotzooi op
                WAIT
                CALL    ZENDREAL        ; STUUR NAAR ATOM
                JMP     LEESCOM         ; EINDE COMMANDO

; LN(x)-  bereken op basis van het natuurlijk grondtal E het logarithme van x
;  X moet groter zijn dan 0.
;  Maakt gebruik van een formule, omdat de functie niet als
;  implied instructie beschikbaar is.
;
; ln(x) = lg(x)/lg(e).

FPLN:           CALL    LEESREAL        ; LEES GETAL
                FLD     INTEL           ; LEES IN PROCESSOR
                fld1                    ; laadt constante 1
                fxch                    ; maak er -1 van
                fyl2x                   ; bereken 1*lg(x).
                fldl2e                  ; Laadt lg(e).
                fdiv                    ; bereken lg(x)/lg(10).
                FSTP    INTEL           ; ZET RESULTAAT IN GEHEUGEN
                WAIT                    ; sync voor de 80x86 gebruikers
                CALL    ZENDREAL        ; STUUR NAAR ATOM
                JMP     LEESCOM         ; EINDE COMMANDO

; LOG(x)- bereken de logaritme met 10 als grondtal.
;  Gebruikelijke range voor X: >= 0
;  Maakt gebruik van een formule, omdat de functie niet als
;  implied instructie beschikbaar is.
;
; LOG(x) = lg(x)/lg(10).

FPLOG:          CALL    LEESREAL        ; LEES GETAL
                FLD     INTEL           ; LEES IN PROCESSOR
                fld1                    ; laadt constante 1
                fxch                    ; wissel TOS en ST(1) van plek
                fyl2x                   ; Bereken 1*lg(x).
                fldl2t                  ; Laadt lg(10).
                fdiv                    ; Bereken lg(x)/lg(10).
                FSTP    INTEL           ; ZET RESULTAAT IN GEHEUGEN
                WAIT                    ; sync voor de 80x86 gebruikers
                CALL    ZENDREAL        ; STUUR NAAR ATOM
                JMP     LEESCOM         ; EINDE COMMANDO

; YtoX(y,x)- Berekent y**x, waarbij (y=st(1), x=st(0)).
;  Deze routine vereist drie vrije registers.
;  Maakt gebruik van een formule, omdat de functie niet als
;  implied instructie beschikbaar is.
;  Tevens wordt de subroutine Two2X aangeroepen.
;
;  Y moet groter zijn dan 0.
;
; YtoX(y,x) = 2 ** (x * lg(y))

FPYTOX:         CALL    LEESREAL        ; LEES GETAL
                FLD     INTEL           ; LEES IN PROCESSOR
                CALL    LEESREAL        ; put number on top of stack
                FLD     INTEL           ; LEES IN PROCESSOR
                fxch                    ; Wissel TOS en ST(1) van plek
                fld1                    ; laadt constante 1
                fxch                    ; Wissel TOS en ST(1) van plek
                fyl2x                   ; bereken logaritme:
                fmul                    ; Bereken x*lg(y).
                call    Two2X           ; Bereken 2**(x*lg(y)).
                FSTP    INTEL           ; ZET RESULTAAT IN GEHEUGEN
                fSTP    ST(0)           ; HEBBEN WE OOK NIET NODIG.
                WAIT                    ; sync voor de 80x86 gebruikers
                CALL    ZENDREAL        ; STUUR NAAR ATOM
                JMP     LEESCOM         ; EINDE COMMANDO

; exp(x)- Berekent e**x.
;  Deze routine vereist drie vrije registers.
;  Maakt gebruik van een formule, omdat de functie niet als
;  implied instructie beschikbaar is.
;  Tevens wordt de subroutine Two2X aangeroepen.
;
; exp(x) = 2**(x * lg(e))

FPEXP:          CALL    LEESREAL        ; LEES GETAL
                FLD     INTEL           ; LEES IN PROCESSOR
                fldl2e                  ; Plaats lg(e) op de stack.
                fmul                    ; Bereken x*lg(e).
                call    Two2X           ; Bereken 2**(x * lg(e))
                FSTP    INTEL           ; ZET RESULTAAT IN GEHEUGEN
                FSTP    ST(0)           ; HEBBEN WE OOK NIET NODIG.
                WAIT                    ; sync voor de 80x86 gebruikers
                CALL    ZENDREAL        ; STUUR NAAR ATOM
                JMP     LEESCOM         ; EINDE COMMANDO

; Two2X(x)- Berekent 2**x.
;  Deze routine vereist drie vrije registers.
;  Tevens wordt de subroutine Two2X aangeroepen.
;

FPTWOTOX:       CALL    LEESREAL        ; LEES GETAL
                FLD     INTEL           ; LEES IN PROCESSOR
                FSTP    INTEL           ; ZET RESULTAAT IN GEHEUGEN
                CALL    Two2X           ; de man in kwestie
                FSTP    ST(0)           ; HEBBEN WE OOK NIET NODIG.
                WAIT
                CALL    ZENDREAL        ; STUUR NAAR ATOM
                JMP     LEESCOM         ; EINDE COMMANDO
 

; TenToX(x)- Berekent 10**x.
;  Deze routine vereist drie vrije registers.
;  Maakt gebruik van een formule, omdat de functie niet als
;  implied instructie beschikbaar is.
;  Tevens wordt de subroutine Two2X aangeroepen.
;
;  TenToX(x) = 2**(x * lg(10))
 

FPTENTOX:       CALL    LEESREAL        ; LEES GETAL
                FLD     INTEL           ; LEES IN PROCESSOR
                fldl2t                  ; Zet lg(10) op de stack
                fmul                    ; Bereken x*lg(10)
                call    Two2X           ; Bereken 2**(x * lg(10)).
                FSTP    INTEL           ; ZET RESULTAAT IN GEHEUGEN
                FSTP    ST(0)           ; HEBBEN WE OOK NIET NODIG.
                WAIT
                CALL    ZENDREAL        ; STUUR NAAR ATOM
                JMP     LEESCOM         ; EINDE COMMANDO

; Two2X(x)- Berekent 2**x.
;  Dit wordt bereikt door het volgende regeltje toe te passen:
;
;  2**x = 2**int(x) * 2**frac(x).
;  We kunnen eenvoudig berekenen 2**int(x) met fscale en
;  2**frac(x) door gebruik te maken van f2xm1.
;
;  Deze routine vereist drie vrije registers.

; Modificeer het control word om af te kappen indien er afgerond moet worden

Two2X           proc    near
                fstcw   SaveCW
                fstcw   MaskedCW
                or      byte ptr MaskedCW+1, 1100b
                fldcw   MaskedCW

                fld st(0)               ;Dupliceer tos.
                fld st(0)
                frndint                 ;Bereken integer deel

                fxch                    ;Swap FP en INT waardes
                fsub st(0), st(1)       ;Bereken fractional deel

                f2xm1                   ;Bereken 2**frac(x)-1.
                fld1
                fadd                    ;Bereken 2**frac(x).

                fxch   ;Get integer deel
                fld1                    ;Bereken 1*2**int(x).
                fscale
                fstp st(1)              ;Verwijder st(1) (wat hier 1 is).

                fmul                    ;Bereken 2**int(x) * 2**frac(x).
                fldcw SaveCW            ;Terug naar de afrond mode.
                ret
Two2X           endp

; exp(x)- Berekent e**x.
;  Deze routine vereist drie vrije registers.
;  Maakt gebruik van een formule, omdat de functie niet als
;  implied instructie beschikbaar is.
;  Tevens wordt de subroutine Two2X aangeroepen.
;
; exp(x) = 2**(x * lg(e))

exp             proc     near
                fldl2e          ;Zet lg(e) op de stack.
                fmul            ;Bereken x*lg(e).
                call    Two2X   ;Bereken 2**(x * lg(e))
                fstp st(1)      ;Zooi opruimen
                ret
exp             endp
 

; ATN(x)- Berekent de arctangent van st(0) en laat zet resultaat
;   in st(0).
;  X <> 0
;  Ten minste een vrij register is noodzakelijk voor deze functie
;
; acot(x) = atan(x/1)

FPATN:          CALL LEESREAL           ; LEES GETAL
                FLD     INTEL           ; LEES IN PROCESSOR
                fld1                    ; fpatan Berekening
                fpatan                  ; we willen de atan(st(0)/st(1)).
                FSTP    INTEL           ; ZET RESULTAAT IN GEHEUGEN
                WAIT
                CALL    ZENDREAL        ; STUUR NAAR ATOM
                JMP     LEESCOM         ; EINDE COMMANDO

; ACOT(x)- Berekent de arctangent van st(0) en laat zet resultaat
;   in st(0).
;  X <> 0
;  Ten minste een vrij register is noodzakelijk voor deze functie
;
; acot(x) = atan(1/x)

FPACOT:         CALL    LEESREAL        ; LEES GETAL
                FLD     INTEL           ; LEES IN PROCESSOR
                fld1                    ; fpatan Berekens
                fxch                    ; atan(st(1)/st(0)).
                fpatan                  ; we willen atan(st(0)/st(1)).
                FSTP    INTEL           ; ZET RESULTAAT IN GEHEUGEN
                WAIT
                CALL    ZENDREAL        ; STUUR NAAR ATOM
                JMP     LEESCOM         ; EINDE COMMANDO

; ACOS(x)- Berekent de arccosinus van st(0). Resultaat in ST(0)
;  Toegestane reekse: -1<=x<=+1
;  Deze routine vereist twee vrije registers.
;  Maakt gebruik van een formule, omdat de functie niet als
;  implied instructie beschikbaar is.
;
; acos(x) = atan(sqrt((1-x*x)/(x*x)))

FPACOS:  CALL LEESREAL ; LEES GETAL
                FLD     INTEL           ; LEES IN PROCESSOR
                fld     st(0)           ; Dupliceer X op tos.
                fmul                    ; Bereken X**2.
                fld     st(0)           ; Dupliceer X**2 op tos.
                fld1                    ; Bereken 1-X**2.
                fsubr
                fdivr                   ; Bereken (1-x**2)/X**2.
                fsqrt                   ; Bereken sqrt((1-X**2)/X**2).
                fld1                    ; Om volledgige arctangens te berekenen
                fpatan                  ; Bereken atan van de bovenstaande
                FSTP    INTEL           ; ZET RESULTAAT IN GEHEUGEN
                WAIT
                CALL    ZENDREAL        ; STUUR NAAR ATOM
                JMP     LEESCOM         ; EINDE COMMANDO

; ASIN(x)- Berekent de arcsinus van st(0). Berg resultaat op in ST(0)
;  Toegestane reekse: -1<=x<=+1
;  Deze routine vereist twee vrije registers.
;  Maakt gebruik van een formule, omdat de functie niet als
;  implied instructie beschikbaar is.
;
; asin(x) = atan(sqrt(x*x/(1-x*x)))

FPASIN:         CALL     LEESREAL       ; LEES GETAL
                FLD     INTEL           ; LEES IN PROCESSOR
                fld     st(0)           ; Dupliceer X op tos.
                fmul                    ; Bereken X**2.
                fld     st(0)           ; Dupliceer X**2 on tos.
                fld1                    ; Bereken 1-X**2.
                fsubr
                fdiv                    ; Bereken X**2/(1-X**2).
                fsqrt                   ; Bereken sqrt(x**2/(1-X**2)).
                fld1                    ; Om volledgige arctangens te berekenen
                fpatan                  ; Bereken atan van de bovenstaande
                FSTP    INTEL           ; ZET RESULTAAT IN GEHEUGEN
                WAIT
                CALL    ZENDREAL        ; STUUR NAAR ATOM
                JMP     LEESCOM         ; EINDE COMMANDO
; hiero
; SEC(x) - Berekent het secant van st(0). Resultaat in ST0
;    st(0) bevat x (in radialen) en moet liggen in de reeks
;  -2**63 and +2**63.
;    Het secant van x is ongedefineerd voor elke waarde van cos(x) wat
;  oplevert 0 (b.v. pi/2 radialen).
;    Deze routine vereist drie vrije registers.
;    Maakt gebruik van een formule, omdat de functie niet als
;    implied instructie beschikbaar is.
;
; sec(x) = 1/cos(x)

                P386                    ; DEZE FUNCTIES ALLEEN VOOR 80386
                P387
FPSEC:          CALL    LEESREAL        ; LEES GETAL
                FLD     INTEL           ; LEES IN PROCESSOR
                FCOS                    ; bepaal cosinus
                fld1                    ; laadt 1 als constante
                fdivr                   ; deel koos en miep
                FSTP    INTEL           ; ZET RESULTAAT IN GEHEUGEN
                WAIT
                CALL    ZENDREAL        ; STUUR NAAR ATOM
                JMP     LEESCOM         ; EINDE COMMANDO

; CSC(x) - Berekent de cosecant van st(0). Resultaat in ST0
;    st(0) bevat x (in radialen) en moet liggen in de reeks
;  -2**63 and +2**63.
;    Het cosecant van x is ongedefineerd voor elke waarde van sin(x) wat
;  oplevert 0 (b.v. 0 of pi radialen).
;    Deze routine vereist drie vrije registers.
;    Maakt gebruik van een formule, omdat de functie niet als
;    implied instructie beschikbaar is.
;
; csc(x) = 1/sin(x)

                P386                    ; DEZE FUNCTIES ALLEEN VOOR 80386
                P387
FPCSC:          CALL    LEESREAL        ; LEES GETAL
                FLD     INTEL           ; LEES IN PROCESSOR
                FSIN                    ; bepaal sinus
                fld1                    ; laadt 1 als constante
                fdivr                   ; deel koos en miep
                FSTP    INTEL           ; ZET RESULTAAT IN GEHEUGEN
                WAIT
                CALL    ZENDREAL        ; STUUR NAAR ATOM
                JMP     LEESCOM         ; EINDE COMMANDO
 

; COT(x) - Berekent the cotangens van st(0). Resultaat in ST0
;    st(0) bevat x (in radialen) en moet liggen in de reeks
;  -2**63 and +2**63
;    Deze routine vereist drie vrije registers.
;    Maakt gebruik van een formule, omdat de functie niet als
;    implied instructie beschikbaar is.
;
; cot(x) = 1/tan(x)

                P386                    ; DEZE FUNCTIES ALLEEN VOOR 80386
                P387
FPCOT:          CALL    LEESREAL        ; LEES GETAL
                FLD     INTEL           ; LEES IN PROCESSOR
                FSINCOS                 ; bereken sinus en cosinus
                fdivr                   ; het 1 complement
                FSTP    INTEL           ; ZET RESULTAAT IN GEHEUGEN
                WAIT
                CALL    ZENDREAL        ; STUUR NAAR ATOM
                JMP     LEESCOM         ; EINDE COMMANDO

; Power(x,y)   Berekent y**x, waarbij (y=st(1), x=st(0)).
;
;        Y moet groter zijn dan 0.
;        Routine van Roland, die dus alleen al om die reden niet in
;        deze source mag ontbreken. Wordt vervangen door de FPYTOX routine
;        die sneller en eenvoudiger is.

FPOWER:         CALL    LEESREAL        ; LEES GETAL
                FLD     INTEL           ; put power on top of stack
                CALL    LEESREAL        ; put number on top of stack
                FLD     INTEL
                fabs                    ; make sure it's not negative
                ftst                    ; is it's zero ....
                fstsw   AX
                sahf
                jne     not_zero
                jmp     get_out         ; ...yes, so get out with 0.0 on TOS
not_zero:                               ; now st(1) = power, st = number
                fyl2x                   ; st = number * log power base 2
                fstcw   TEMP+2          ; save the control word to restore later
                fstcw   WORD PTR temp   ; to change rounding control to round-down
                and     WORD PTR temp,0F33FH ; clear out RoundingControl bits
                or      WORD PTR temp,0400H  ; set for Round-down
                fldcw   WORD PTR temp   ; put it in control word
                fld     st(0)           ; push copy of number
                frndint                 ; st = z1, st(1) = z
                fldcw   TEMP+2          ; restore initial control word
                fsub    st(1), st       ; st(1) = z2 = (z-z1)
                fxch                    ; st = z2, st(1) = z1
                fld     half            ; 1/2 -> top of stack
                fxch                    ; st = z2, st(1) = 1/2
                fprem                   ; st is z2 or z2=1/2; if z2=1/2, c1=1
                fstsw   TEMP+2
                fstp    st(1)           ; now flags are set, so get rid of the half
                f2xm1                   ; st is now  ((2 to the st) - 1)
                fld1
                faddp   st(1), st
                test    TEMP+3,00000010B; st has z2 if bit 1 on
                jz     was_z2           ; else it had z2 - 1/2
                fld1
                fadd    st, st(0)
                fsqrt                   ; so multiply it by the square root of 2
                fmulp   st(1), st
was_z2:         fscale                  ; just need to scale by 2**st(1)
get_out:        fstp    st(1)
                fstp    INTEL           ; BERG RESULTAAT OP
                WAIT
                CALL    ZENDREAL        ; STUUR NAAR ATOM
                JMP     LEESCOM         ; EINDE ROUTINE
 

terug.gif