( Operations en virgule flottante. Version 0.50 du 22 Septembre 2013. Ecrit par jpb.forth . ) TELECHARGEMENT ( flottant = fh, fl soient 2 mots de 16 bits pour un flottant sur 32 bits. ) HEX : FNEGATE ( flottant --> flottant ) [ E0 0000 PRG, 3A 0002 PRG, E0 001E PRG, 32 0001 PRG, A2 F01E PRG, ] ; : FABS ( flottant --> flottant ) DIRECT [ A1 F01E PRG, ] ; : NORM ( exposant,poids_forts,poids_faibles --> flottant ) [ 78 1F81 PRG, 78 1F82 PRG, 78 1F83 PRG, 78 00BE PRG, 78 013E PRG, 70 0181 PRG, 32 0029 PRG, EB 0180 PRG, A3 F801 PRG, 32 0005 PRG, A0 F003 PRG, EA 0000 PRG, EA 8081 PRG, B0 8001 PRG, 33 0004 PRG, E9 0102 PRG, D0 0000 PRG, D2 8081 PRG, 3B FFFC PRG, B0 0800 PRG, B0 8001 PRG, 39 0003 PRG, D3 8081 PRG, D3 8000 PRG, E8 0102 PRG, 78 4001 PRG, FD 8000 PRG, EB 4080 PRG, FD 8001 PRG, B0 0082 PRG, 3C 0002 PRG, EF 0000 PRG, 37 000F PRG, E8 4102 PRG, 3A 0005 PRG, 27 F801 PRG, 40 8083 PRG, 78 2701 PRG, EF 0000 PRG, 37 0009 PRG, E9 4102 PRG, A1 7001 PRG, FD 8002 PRG, D1 0102 PRG, 40 8082 PRG, 40 8083 PRG, 78 2701 PRG, 37 0001 PRG, 78 2700 PRG, 78 01CF PRG, 78 014F PRG, 78 00CF PRG, ] ; : UFLOAT ( n --> flottant ) [ 78 1F81 PRG, 78 1F82 PRG, 78 1F83 PRG, 20 0962 PRG, EB 0080 PRG, A3 F800 PRG, 32 FFC5 PRG, EA 8081 PRG, 37 FFC3 PRG, ] ; : INT ( flottant --> n ) [ 78 1F81 PRG, 78 1F82 PRG, 78 00BE PRG, 70 0101 PRG, 32 001F PRG, 78 0101 PRG, B2 07F1 PRG, A0 7001 PRG, A3 F802 PRG, 32 0004 PRG, EA 0000 PRG, EA 8081 PRG, B0 8001 PRG, A1 F002 PRG, DE 1147 PRG, B1 08E2 PRG, 33 0006 PRG, A3 F801 PRG, 32 0002 PRG, 28 0000 PRG, 37 000F PRG, 27 FFF0 PRG, 37 000D PRG, EA 0102 PRG, E1 106F PRG, 34 0002 PRG, EF 0000 PRG, 37 0008 PRG, D1 8081 PRG, D3 8000 PRG, 78 4001 PRG, FD 8000 PRG, E9 8102 PRG, 33 0002 PRG, 09 8002 PRG, D1 8000 PRG, 78 014F PRG, 78 00CF PRG, ] ; : F+ ( flottant1,flottant2 --> flottant1+flottant2 ) [ 78 1F81 PRG, 78 1F82 PRG, 78 1F83 PRG, 78 1F84 PRG, 78 1F85 PRG, 78 00BE PRG, 78 0101 PRG, B2 07F1 PRG, A0 7001 PRG, A3 F802 PRG, 32 0004 PRG, EA 0000 PRG, EA 8081 PRG, B0 8001 PRG, A1 F002 PRG, DE 1147 PRG, 78 01BE PRG, 78 023E PRG, 78 0284 PRG, B2 07F4 PRG, A0 7004 PRG, A3 F805 PRG, 32 0004 PRG, EA 0183 PRG, EA 8204 PRG, B0 8004 PRG, A1 F005 PRG, DE 2AC7 PRG, E1 2802 PRG, 34 0003 PRG, FD 0003 PRG, FD 0084 PRG, FD 0105 PRG, 51 0285 PRG, 32 0004 PRG, D1 8204 PRG, D3 8183 PRG, E9 0285 PRG, 3A FFFC PRG, 40 0003 PRG, 48 8084 PRG, 78 02CF PRG, 78 024F PRG, 37 FF6A PRG, ] ; : F- ( flottant1,flottant2 --> flottant1-flottant2 ) [ 07 FF53 PRG, 37 FFCF PRG, ] ; : F* ( flottant1,flottant2 --> flottant1*flottant2 ) [ 78 1F81 PRG, 78 1F82 PRG, 78 1F83 PRG, 78 00BE PRG, 78 0101 PRG, B2 07F1 PRG, A0 7001 PRG, 78 1F84 PRG, 78 1F85 PRG, B8 021E PRG, D0 0204 PRG, 4A 81E0 PRG, B8 0A3E PRG, 42 0203 PRG, 4A 82E0 PRG, 78 019E PRG, B2 07F3 PRG, A0 7003 PRG, 78 1F86 PRG, 78 1F87 PRG, B8 0303 PRG, 42 0206 PRG, 4A 8287 PRG, 78 03CF PRG, 78 034F PRG, B8 1801 PRG, 48 80E0 PRG, 40 0005 PRG, 48 80E0 PRG, D0 0204 PRG, D2 8000 PRG, D2 8081 PRG, B0 0804 PRG, 48 0060 PRG, 78 4200 PRG, FD 8004 PRG, 78 4001 PRG, FD 8000 PRG, 78 0080 PRG, 78 0004 PRG, 78 02CF PRG, 78 024F PRG, A3 F802 PRG, 32 0004 PRG, EA 0000 PRG, EA 8081 PRG, B0 8001 PRG, A1 F002 PRG, DE 1147 PRG, 78 01BE PRG, A3 F803 PRG, 32 0004 PRG, EA 0000 PRG, EA 8081 PRG, B0 8001 PRG, A1 F003 PRG, DE 19C7 PRG, B1 07F3 PRG, 41 0103 PRG, 37 FF26 PRG, ] ; : F/ ( flottant1,flottant2 --> flottant1/flottant2 ) [ 78 1F81 PRG, 78 1F82 PRG, 78 1F83 PRG, 78 00BE PRG, 70 0101 PRG, 32 0033 PRG, 78 0101 PRG, B2 07F1 PRG, A0 7001 PRG, 78 1F84 PRG, 78 1F85 PRG, 78 023E PRG, 78 029E PRG, B2 07F5 PRG, A0 7005 PRG, 78 1F86 PRG, 78 1F87 PRG, EB 0300 PRG, EB 0380 PRG, 20 0173 PRG, D0 0306 PRG, D2 8387 PRG, 52 0200 PRG, 5A 8281 PRG, 31 0002 PRG, E8 0306 PRG, 37 0002 PRG, 42 0200 PRG, 4A 8281 PRG, D0 0204 PRG, D2 8285 PRG, E9 0183 PRG, 39 FFF3 PRG, 78 0006 PRG, 78 0087 PRG, 78 03CF PRG, 78 034F PRG, 78 02CF PRG, 78 024F PRG, A3 F802 PRG, 32 0004 PRG, EA 0000 PRG, EA 8081 PRG, B0 8001 PRG, A1 F002 PRG, DE 1147 PRG, 78 01BE PRG, A3 F803 PRG, 32 0004 PRG, EA 0000 PRG, EA 8081 PRG, B0 8001 PRG, A1 F003 PRG, DE 19C7 PRG, 51 8102 PRG, B0 07F2 PRG, 37 FEEA PRG, 78 01CF PRG, 78 014F PRG, 78 00CF PRG, 78 003E PRG, ] ." **** Division par ZERO en nombre flottant !" CR BELL ; DECIMAL : PUISSANCE ( flottant,n --> flottant^n ) DUP 0< IF >R >R >R [ 1 UFLOAT SWAP LITERAL LITERAL ] R> R> F/ R> NEGATE THEN >R [ 1 UFLOAT SWAP LITERAL LITERAL ] R> BEGIN DUP 1 AND IF >R 4 PICK 4 PICK F* R> THEN 2/ DUP IF >R >R >R OVER OVER F* R> R> R> 0 ELSE -1 THEN UNTIL DROP >R >R DROP DROP R> R> ; : F/MOD ( flottant1,flottant2 --> flottant1-[n*flottant2],n ) 4 PICK 4 PICK 4 PICK 4 PICK F/ INT DUP >R UFLOAT F* F- R> ; : FCONVERT ( flottant,adr-1 --> flottant,adr' ) 1+ DUP C@ DUP 45 = IF DROP 1+ -1 ELSE 43 = IF 1+ THEN 0 THEN >R BEGIN DUP C@ DUP 47 > SWAP 58 < AND WHILE >R [ 10 UFLOAT SWAP LITERAL LITERAL ] F* R@ C@ 48- UFLOAT F+ R> 1+ REPEAT 0 OVER C@ DUP 44 = SWAP 46 = OR IF >R 1+ R> BEGIN OVER C@ DUP 47 > SWAP 58 < AND WHILE >R >R [ 10 UFLOAT SWAP LITERAL LITERAL ] F* R@ C@ 48- UFLOAT F+ R> 1+ R> 1- REPEAT THEN OVER C@ DUP 69 = SWAP 101 = OR IF >R BASE @ >R DECIMAL 0 SWAP CONVERT R> BASE ! SWAP R> + THEN SWAP >R >R [ 10 UFLOAT SWAP LITERAL LITERAL ] R> PUISSANCE F* R> R> SWAP >R 0< IF FNEGATE THEN R> ; : <##F#> ( flottant --> adr,n pour affichage de 6 chiffres significatifs ) OVER 32640 AND DUP 32640 = IF DROP DROP <# 105 HOLD 110 HOLD 105 HOLD 102 HOLD 110 HOLD 105 HOLD OVER 0= NOT 2 AND 43+ HOLD #> ELSE 0= IF DROP DROP 0 <# 48 HOLD #> ELSE BASE @ >R DECIMAL OVER <# 4 ROLL 4 ROLL OVER 0< IF FNEGATE THEN ( Ajustage 1 =< f < 10 ) 0 3 PICK 3 PICK [ 1 UFLOAT SWAP LITERAL LITERAL ] F- DROP 0< IF BEGIN >R [ 10 UFLOAT SWAP LITERAL LITERAL ] F* R> 1- 3 PICK 3 PICK [ 1 UFLOAT SWAP LITERAL LITERAL ] F- DROP 0< NOT UNTIL ELSE BEGIN 3 PICK 3 PICK [ 10 UFLOAT SWAP LITERAL LITERAL ] F- DROP 0< NOT WHILE >R [ 10 UFLOAT SWAP LITERAL LITERAL ] F/ R> 1+ REPEAT THEN ( Arrondi avec 5e-6 et reajustage f < 10 ) >R [ 5 UFLOAT 1000 UFLOAT F/ 1000 UFLOAT F/ SWAP LITERAL LITERAL ] F+ R> 3 PICK 3 PICK [ 10 UFLOAT SWAP LITERAL LITERAL ] F- DROP 0< NOT IF >R [ 10 UFLOAT SWAP LITERAL LITERAL ] F/ R> 1+ THEN 5 OVER 3 MOD ?DUP IF DUP 0< IF 3+ THEN ROT OVER - >R - R> SWAP THEN >R ?DUP IF DUP 0< IF NEGATE -1 ELSE 0 THEN SWAP #S SIGN DROP DROP 101 HOLD THEN 6 0 DO OVER OVER INT DUP >R UFLOAT F- R> ROT ROT [ 10 UFLOAT SWAP LITERAL LITERAL ] F* LOOP DROP DROP R@ DUP 0 DO OVER 0= IF >R DROP R> 1- ELSE LEAVE THEN LOOP ?DUP IF 0 DO 48+ HOLD LOOP 44 HOLD THEN 6 R> - 0 DO 48+ HOLD LOOP SIGN #> R> BASE ! THEN THEN ; : F. ( flottant --> - ) <##F#> TYPE SPACE ; : FSQRT ( flottant --> flottant' ) OVER 0> IF SWAP DUP 32640 AND 16384- DUP >R - SWAP R> 2/ DUP 64 AND IF >R [ 1 UFLOAT 2 UFLOAT F/ SWAP LITERAL LITERAL ] F* R> 64+ THEN >R OVER OVER [ 25 UFLOAT 1000 UFLOAT F/ SWAP LITERAL LITERAL ] F- DROP 0< IF OVER OVER [ 85 UFLOAT 10 UFLOAT F/ SWAP LITERAL LITERAL ] F* [ 2 UFLOAT 10 UFLOAT F/ SWAP LITERAL LITERAL ] F+ ELSE OVER OVER [ 875 UFLOAT 1000 UFLOAT F/ SWAP LITERAL LITERAL ] F* [ 1 UFLOAT 100 UFLOAT F/ SWAP LITERAL LITERAL ] F+ THEN 4 PICK 4 PICK [ 3288 UFLOAT 1000 UFLOAT F/ 1000 UFLOAT F/ SWAP LITERAL LITERAL ] F- DROP 0< IF 8 ELSE 34 THEN 0 DO 4 PICK 4 PICK 4 PICK 4 PICK F/ F+ [ 1 UFLOAT 2 UFLOAT F/ SWAP LITERAL LITERAL ] F* LOOP >R >R DROP DROP R> R> SWAP R> + SWAP ELSE OVER 0< IF ." **** Racine carree d'un flottant negatif !" CR BELL THEN THEN ; : FEXP0 ( flottant --> flottant' ) [ 3 UFLOAT SWAP LITERAL LITERAL ] 20 PUISSANCE F/ 20 0 DO OVER OVER OVER OVER F* [ 4 UFLOAT SWAP LITERAL LITERAL ] F* [ 3 UFLOAT SWAP LITERAL LITERAL ] F+ F* LOOP OVER OVER OVER OVER F* [ 1 UFLOAT SWAP LITERAL LITERAL ] F+ FSQRT F+ ; : FLN0 ( flottant compris entre 1 et e --> flottant' ) [ 1 UFLOAT SWAP LITERAL LITERAL 0 UFLOAT SWAP LITERAL LITERAL 1 UFLOAT FEXP0 SWAP LITERAL LITERAL 1 UFLOAT SWAP LITERAL LITERAL ] ( x,a,la,b,lb ) BEGIN 8 PICK 8 PICK 6 PICK 6 PICK F* FSQRT 8 PICK 8 PICK 6 PICK 6 PICK F+ [ 2 UFLOAT SWAP LITERAL LITERAL ] F/ ( x,a,la,b,lb,g,lg ) 14 PICK 14 PICK 6 PICK 6 PICK F- DROP 0< IF >R >R >R >R DROP DROP DROP DROP R> R> R> R> ELSE >R >R >R >R >R >R >R >R DROP DROP DROP DROP R> R> R> R> R> R> R> R> 8 ROLL 8 ROLL 8 ROLL 8 ROLL THEN 8 PICK 8 PICK 6 PICK 6 PICK F- FABS [ 5 UFLOAT 10000 UFLOAT F/ 1000 UFLOAT F/ SWAP LITERAL LITERAL ] F- DROP 0> NOT UNTIL >R >R DROP DROP R> R> F+ [ 2 UFLOAT SWAP LITERAL LITERAL ] F/ >R >R DROP DROP DROP DROP R> R> ; : FEXP ( flottant --> flottant' ) OVER 0< IF >R >R [ 1 UFLOAT SWAP LITERAL LITERAL ] R> R> FNEGATE FEXP F/ ELSE [ 177 UFLOAT SWAP LITERAL LITERAL ] 4 PICK 4 PICK F- DROP 0< IF ." **** Exponentielle d'un flottant trop grand !" CR BELL ELSE [ 2 UFLOAT FLN0 SWAP LITERAL LITERAL ] F/MOD >R [ 1 UFLOAT OVER OVER 16 UFLOAT F/ F+ FLN0 SWAP LITERAL LITERAL ] F/MOD >R [ 1 UFLOAT OVER OVER 16 UFLOAT F/ F+ SWAP LITERAL LITERAL ] R> PUISSANCE >R >R [ 1 UFLOAT OVER OVER 256 UFLOAT F/ F+ FLN0 SWAP LITERAL LITERAL ] F/MOD >R [ 1 UFLOAT OVER OVER 256 UFLOAT F/ F+ SWAP LITERAL LITERAL ] R> PUISSANCE R> R> F* >R >R [ 1 UFLOAT OVER OVER 4096 UFLOAT F/ F+ FLN0 SWAP LITERAL LITERAL ] F/MOD >R [ 1 UFLOAT OVER OVER 4096 UFLOAT F/ F+ SWAP LITERAL LITERAL ] R> PUISSANCE R> R> F* >R >R [ 1 UFLOAT OVER OVER 256 UFLOAT F/ 256 UFLOAT F/ F+ FLN0 SWAP LITERAL LITERAL ] F/MOD >R [ 1 UFLOAT OVER OVER 256 UFLOAT F/ 256 UFLOAT F/ F+ SWAP LITERAL LITERAL ] R> PUISSANCE R> R> F* >R >R OVER OVER [ 1 UFLOAT 2 UFLOAT F/ SWAP LITERAL LITERAL ] F* [ 1 UFLOAT SWAP LITERAL LITERAL ] F+ F* [ 1 UFLOAT SWAP LITERAL LITERAL ] F+ R> R> F* SWAP R> 7 LSH + SWAP THEN THEN ; : FLN ( flottant --> flottant' ) OVER 0> IF OVER OVER [ 1 UFLOAT SWAP LITERAL LITERAL ] F- DROP ?DUP IF 0< IF >R >R [ 1 UFLOAT SWAP LITERAL LITERAL ] R> R> F/ FLN FNEGATE ELSE OVER DUP 16640 > ( Test si superieur a 4 ) IF 16256- 32256 AND DUP -7 LSH NEGATE >R SWAP >R - R> ELSE DUP XOR >R THEN >R >R [ 2 UFLOAT FLN0 SWAP 256+ LITERAL LITERAL ] R> R> BEGIN OVER OVER [ 1 UFLOAT OVER OVER 16 UFLOAT F/ F+ SWAP LITERAL LITERAL ] F* OVER 16768 < ( Test si inferieur a 16 ) IF >R >R DROP DROP [ 1 UFLOAT OVER OVER 16 UFLOAT F/ F+ FLN0 SWAP LITERAL LITERAL ] F- R> R> 0 ELSE DROP DROP -1 THEN UNTIL BEGIN OVER OVER [ 1 UFLOAT OVER OVER 256 UFLOAT F/ F+ SWAP LITERAL LITERAL ] F* OVER 16768 < ( Test si inferieur a 16 ) IF >R >R DROP DROP [ 1 UFLOAT OVER OVER 256 UFLOAT F/ F+ FLN0 SWAP LITERAL LITERAL ] F- R> R> 0 ELSE DROP DROP -1 THEN UNTIL BEGIN OVER OVER [ 1 UFLOAT OVER OVER 4096 UFLOAT F/ F+ SWAP LITERAL LITERAL ] F* OVER 16768 < ( Test si inferieur a 16 ) IF >R >R DROP DROP [ 1 UFLOAT OVER OVER 4096 UFLOAT F/ F+ FLN0 SWAP LITERAL LITERAL ] F- R> R> 0 ELSE DROP DROP -1 THEN UNTIL BEGIN OVER OVER [ 1 UFLOAT OVER OVER 65536 UFLOAT F/ F+ SWAP LITERAL LITERAL ] F* OVER 16768 < ( Test si inferieur a 16 ) IF >R >R DROP DROP [ 1 UFLOAT OVER OVER 256 UFLOAT F/ 256 UFLOAT F/ F+ FLN0 SWAP LITERAL LITERAL ] F- R> R> 0 ELSE DROP DROP -1 THEN UNTIL SWAP 512- SWAP OVER OVER [ -1 UFLOAT 2 UFLOAT F/ SWAP LITERAL LITERAL ] F* [ 2 UFLOAT SWAP LITERAL LITERAL ] F+ F* [ -3 UFLOAT 2 UFLOAT F/ SWAP LITERAL LITERAL ] F+ F+ R> UFLOAT [ 2 UFLOAT FLN0 SWAP LITERAL LITERAL ] F* F- THEN ELSE DROP DROP 0 DUP THEN ELSE ." **** Logarithme d'un flottant negatif ou nul !" CR BELL THEN ; : SP_FPI ( - --> PI en flottant ) [ 1 UFLOAT SWAP LITERAL LITERAL ] [ 1 UFLOAT 2 UFLOAT F/ FSQRT SWAP LITERAL LITERAL ] 0 DUP 16 0 DO >R >R 4 PICK 4 PICK 4 PICK 4 PICK F* FSQRT >R >R F+ [ 2 UFLOAT SWAP LITERAL LITERAL ] F/ R> R> 4 PICK 4 PICK OVER OVER F* 4 PICK 4 PICK OVER OVER F* F- R> R> 4 ROLL 4 ROLL I 1+ 127+ 7 LSH 0 F* F+ LOOP [ -2 UFLOAT SWAP LITERAL LITERAL ] F* [ 1 UFLOAT SWAP LITERAL LITERAL ] F+ >R >R DROP DROP OVER OVER F* [ 4 UFLOAT SWAP LITERAL LITERAL ] F* R> R> F/ ; : FPI [ SP_FPI SWAP LITERAL LITERAL ] ; : FATAN0 ( flottant --> flottant' ) OVER OVER >R >R OVER OVER F* R> R> OVER OVER 0 ( f^2,f^(2n+1),fatan,n ) BEGIN 3 PICK 3 PICK >R >R >R >R >R 4 PICK 4 PICK F* R> R> 4 PICK 4 PICK R@ 2* 3+ UFLOAT F/ R@ 1 AND IF F+ ELSE F- THEN R> 1+ 3 PICK 3 PICK R> R> F- OR 0= UNTIL DROP >R >R DROP DROP DROP DROP R> R> ; : AJUSTEXY ( arc, y, x, ki, fatan[ki] --> arc', y', x' ) >R >R 8 PICK 8 PICK R> R> F/MOD ?DUP IF ( arc, y, x, ki, arc', ai ) >R 10 ROLL DROP 9 ROLL DROP 8 ROLL 8 ROLL 8 ROLL 8 ROLL R> ( ki, arc', y, x, ai ) 0 DO ( ki, arc', y, x ) OVER OVER 10 PICK 10 PICK 8 PICK 8 PICK F* F- >R >R 8 PICK 8 PICK F* F+ R> R> LOOP 8 ROLL DROP 7 ROLL DROP ELSE ( arc, y, x, ki, arc ) DROP DROP DROP DROP THEN ; : FTANU ( flottant --> flottant' ) [ 2 UFLOAT SWAP LITERAL LITERAL ] F/ 0 DUP [ 1 UFLOAT SWAP LITERAL LITERAL ] ( angle moitie, y, x ) [ 1 UFLOAT SWAP LITERAL LITERAL FPI 4 UFLOAT F/ SWAP LITERAL LITERAL ] AJUSTEXY [ 1 UFLOAT 16 UFLOAT F/ OVER OVER SWAP LITERAL LITERAL FATAN0 SWAP LITERAL LITERAL ] AJUSTEXY [ 1 UFLOAT 16 UFLOAT 2 PUISSANCE F/ OVER OVER SWAP LITERAL LITERAL FATAN0 SWAP LITERAL LITERAL ] AJUSTEXY [ 1 UFLOAT 16 UFLOAT 3 PUISSANCE F/ OVER OVER SWAP LITERAL LITERAL FATAN0 SWAP LITERAL LITERAL ] AJUSTEXY [ 1 UFLOAT 16 UFLOAT 4 PUISSANCE F/ OVER OVER SWAP LITERAL LITERAL FATAN0 SWAP LITERAL LITERAL ] AJUSTEXY [ 1 UFLOAT 16 UFLOAT 5 PUISSANCE F/ OVER OVER SWAP LITERAL LITERAL FATAN0 SWAP LITERAL LITERAL ] AJUSTEXY F/ >R >R DROP DROP R> R> ; : FTAN ( flottant --> flottant' ) [ FPI SWAP LITERAL LITERAL ] F/MOD DROP OVER OVER OR IF OVER 0< IF FNEGATE FTAN FNEGATE ELSE OVER OVER [ FPI 2 UFLOAT F/ SWAP LITERAL LITERAL ] F- DROP ?DUP IF 0> DUP >R IF [ FPI SWAP LITERAL LITERAL ] F- FNEGATE THEN FTANU OVER OVER OVER OVER FNEGATE F* [ 1 UFLOAT SWAP LITERAL LITERAL ] F+ F/ [ 2 UFLOAT SWAP LITERAL LITERAL ] F* R> IF FNEGATE THEN ELSE ." **** Tangente de PI/2 ou -PI/2 !" CR BELL THEN THEN THEN ; : FSIN ( flottant --> flottant' ) [ FPI SWAP LITERAL LITERAL ] F/MOD 1 AND IF FNEGATE THEN OVER 0< IF FNEGATE FSIN FNEGATE ELSE [ FPI 2 UFLOAT F/ SWAP LITERAL LITERAL ] F/MOD 1 AND IF >R >R [ FPI 2 UFLOAT F/ SWAP LITERAL LITERAL ] R> R> F- THEN FTANU OVER OVER OVER OVER F* [ 1 UFLOAT SWAP LITERAL LITERAL ] F+ F/ [ 2 UFLOAT SWAP LITERAL LITERAL ] F* THEN ; : FCOS ( flottant --> flottant' ) [ FPI 2 UFLOAT F/ SWAP LITERAL LITERAL ] F- FNEGATE FSIN ; : FATAN ( flottant --> flottant' ) OVER 0< IF FNEGATE FATAN FNEGATE ELSE [ 1 UFLOAT SWAP LITERAL LITERAL ] 4 PICK 4 PICK F- DROP 0< IF >R >R [ FPI 2 UFLOAT F/ SWAP LITERAL LITERAL 1 UFLOAT SWAP LITERAL LITERAL ] R> R> F/ FATAN F- ELSE [ FPI 12 UFLOAT F/ FTAN SWAP LITERAL LITERAL ] 4 PICK 4 PICK F- DROP 0< DUP >R IF OVER OVER >R >R [ 3 UFLOAT FSQRT SWAP LITERAL LITERAL ] F* [ 1 UFLOAT SWAP LITERAL LITERAL ] F- R> R> [ 3 UFLOAT FSQRT SWAP LITERAL LITERAL ] F+ F/ THEN OVER OVER OVER OVER F* OVER OVER OVER OVER F* 4 PICK 4 PICK [ 10 UFLOAT SWAP LITERAL LITERAL ] F* F+ [ 9 UFLOAT SWAP LITERAL LITERAL ] F* [ 105 UFLOAT SWAP LITERAL LITERAL ] F+ >R >R [ 55 UFLOAT SWAP LITERAL LITERAL ] F* [ 105 UFLOAT SWAP LITERAL LITERAL ] F+ F* R> R> F/ R> IF [ FPI 6 UFLOAT F/ SWAP LITERAL LITERAL ] F+ THEN THEN THEN ; : FASIN ( flottant --> flottant' ) OVER 0< IF FNEGATE FASIN FNEGATE ELSE [ 1 UFLOAT SWAP LITERAL LITERAL ] OVER OVER 6 PICK 6 PICK F- DROP ?DUP IF 0< IF DROP DROP ." **** Arcsinus d'un flottant exterieur a [-1,+1] !" CR BELL ELSE 4 PICK 4 PICK OVER OVER F* F- FSQRT F/ FATAN THEN ELSE DROP DROP DROP DROP [ FPI 2 UFLOAT F/ SWAP LITERAL LITERAL ] THEN THEN ; : FACOS ( flottant --> flottant' ) >R >R [ FPI 2 UFLOAT F/ SWAP LITERAL LITERAL ] R> R> FASIN F- ; ( FIN )