( Operateurs de base pour calculs en virgule flottante. Version 1.20 du 2 Fevrier 2002. Ecrit par jpb.forth . ) TELECHARGEMENT ( Routines pour calcul en virgule flottante sur le format suivant : le nombre flottant est code en IEEE simple precision, bit 31 : bit de signe S a 0 si le nombre est positif, bits 30 a 23 : exposant E du nombre biaise par la valeur 127, bits 22 a 0 : mantisse M du nombre - 1. Si E = 255 et M # 0 alors il ne s'agit pas d'un nombre flottant, si E = 255 et M = 0 alors le nombre est l'infini avec le signe de S, si 0 < E < 255 alors il s'agit d'un nombre flottant normalise, si E = 0 et M # 0 alors il s'agit d'un nombre flottant denormalise, si E = 0 et M = 0 alors le nombre est egal a 0. ) DECIMAL RAZ_ASSEMBLEUR : FNEGATE ( flottant --> flottant ) [ ASSEMBLEUR TST.L D7 BEQ.S FNEG BCHG #31,D7 FNEG END ] ; : FABS ( flottant --> flottant ) [ ASSEMBLEUR BCLR #31,D7 END ] ; : NORM ( exposant,nombre --> flottant ) [ ASSEMBLEUR MOVE.L (A6)+,D5 NORM0 CLR D4 TST.L D7 BEQ.S NORM6 ; Nombre nul BPL.S NORM1 ADDI #$8000,D4 NEG.L D7 BMI.S NORM2 NORM1 SUBQ #1,D5 ADD.L D7,D7 BPL.S NORM1 NORM2 ADDI.L #128,D7 BCC.S NORM3 ROXR.L #1,D7 ADDQ #1,D5 NORM3 LSR.L #8,D7 ADDQ #8,D5 BGT.S NORM4 CLR.L D7 ; Nombre trop petit donc nul RTS NORM4 CMPI #$FF,D5 BLT.S NORM5 ADDI #$7F80,D4 ; Nombre trop grand donc infini MOVE D4,D7 SWAP D7 CLR D7 RTS NORM5 SWAP D7 ANDI #$7F,D7 LSL #7,D5 ADD D5,D7 ADD D4,D7 SWAP D7 NORM6 END ] ; : F+ ( flottant1,flottant2 --> flottant1+flottant2 ) [ ASSEMBLEUR MOVE.L (A6)+,D6 BEQ.S FP6 MOVE.L D7,D5 BNE.S FP1 MOVE.L D6,D7 RTS FP1 ANDI.L #$007FFFFF,D7 BSET #23,D7 SWAP D5 ASR #7,D5 BPL.S FP2 ANDI #$FF,D5 NEG.L D7 FP2 MOVE.L D6,D4 ANDI.L #$007FFFFF,D6 BSET #23,D6 SWAP D4 ASR #7,D4 BPL.S FP3 ANDI #$FF,D4 NEG.L D6 FP3 CMP D4,D5 BEQ.S FP5 BPL.S FP4 EXG D4,D5 EXG D6,D7 FP4 SUB D5,D4 NEG D4 CMPI #30,D4 BCC NORM0 ASL.L #6,D7 ASL.L #6,D6 SUBQ #6,D5 ASR.L D4,D6 FP5 ADD.L D6,D7 BRA NORM0 FP6 END ] ; : F- ( flottant1,flottant2 --> flottant1-flottant2 ) FNEGATE F+ ; : F* ( flottant1,flottant2 --> flottant1*flottant2 ) [ ASSEMBLEUR MOVE.L (A6)+,D4 BNE.S FM1 CLR.L D7 RTS FM1 MOVE.L D7,D5 BEQ.S FM4 CLR D5 SWAP D5 ASR #7,D5 BPL.S FM2 ANDI #$FF,D5 BSET #31,D5 FM2 MOVE.L D4,D6 SWAP D6 ASR #7,D6 BPL.S FM3 ANDI #$FF,D6 BCHG #31,D5 FM3 ADD D6,D5 SUBI #127,D5 MOVEA.L D5,A5 BSET #23,D7 LSL.L #8,D7 ADD.L D4,D4 MOVE D7,D6 MULU D4,D6 ADDI.L #32768,D6 CLR D6 SWAP D6 MOVE D7,D5 SWAP D4 ANDI #$FF,D4 ADDI #$100,D4 MULU D4,D5 ADD.L D5,D6 MOVE.L D4,D5 SWAP D5 SWAP D7 MULU D7,D5 ADD.L D5,D6 ADDI.L #32768,D6 CLR D6 SWAP D6 MULU D4,D7 ADD.L D6,D7 MOVE.L A5,D5 BPL NORM0 NEG.L D7 BRA NORM0 FM4 END ] ; : F/ ( flottant1,flottant2 --> flottant1/flottant2 ) DUP IF [ ASSEMBLEUR MOVE.L (A6)+,D4 BNE.S FD1 CLR.L D7 RTS FD1 MOVE.L D4,D5 CLR D5 SWAP D5 ASR #7,D5 BPL.S FD2 ANDI #$FF,D5 BSET #31,D5 FD2 MOVE.L D7,D6 SWAP D6 ASR #7,D6 BPL.S FD3 ANDI #$FF,D6 BCHG #31,D5 FD3 SUB D6,D5 ADDI #127,D5 MOVEA.L D5,A5 ANDI.L #$007FFFFF,D4 BSET #23,D4 ANDI.L #$007FFFFF,D7 BSET #23,D7 MOVE.L D7,D6 CLR.L D7 MOVEQ #24,D5 FD4 ADD.L D7,D7 SUB.L D6,D4 BCS.S FD5 ADDQ #1,D7 BRA.S FD6 FD5 ADD.L D6,D4 FD6 ADD.L D4,D4 DBF D5,FD4 ADDQ.L #1,D7 LSR.L #1,D7 MOVE.L A5,D5 BPL NORM0 NEG.L D7 BRA NORM0 END ] ELSE DROP ." Division par ZERO en nombre flottant !" CR BELL THEN ; : INT ( flottant --> n ) [ ASSEMBLEUR TST.L D7 BEQ.S I6 MOVE.L D7,D5 ANDI.L #$007FFFFF,D7 BSET #23,D7 CLR.L D4 SWAP D5 ASR #7,D5 BPL.S I1 MOVEQ #1,D4 ANDI #$FF,D5 I1 SUBI #127,D5 BPL.S I2 CLR.L D7 RTS I2 CMPI #31,D5 BCS.S I3 MOVE.L #$7FFFFFFF,D7 ADD.L D4,D7 RTS I3 SUBI #23,D5 BMI.S I4 BEQ.S I5 LSL.L D5,D7 BRA.S I5 I4 NEG D5 LSR.L D5,D7 I5 TST D4 BEQ.S I6 NEG.L D7 I6 END ] ; : UFLOAT ( n --> flottant ) >R [ 127 23+ LITERAL ] R> NORM ; : PUISSANCE ( flottant,n --> flottant^n ) DUP 0< IF >R >R [ 1 UFLOAT LITERAL ] R> F/ R> NEGATE THEN >R [ 1 UFLOAT LITERAL ] R> BEGIN DUP 1 AND IF >R OVER F* R> THEN 2/ DUP IF >R >R DUP F* R> R> 0 ELSE -1 THEN UNTIL DROP >R DROP R> ; : F/MOD ( flottant1,flottant2 --> flottant1-[n*flottant2],n ) OVER OVER 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 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 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 LITERAL ] R> PUISSANCE F* R> R> SWAP >R 0< IF FNEGATE THEN R> ; " +infini" STRING S_PINFINI " 0" STRING S_ZERO " -infini" STRING S_MINFINI : <##F#> ( flottant --> adr,n pour affichage de 6 chiffres significatifs ) DUP SWAB 32640 AND DUP 32640 = IF DROP 0< IF S_MINFINI ELSE S_PINFINI THEN COUNT ELSE 0= IF DROP S_ZERO COUNT ELSE BASE @ >R DECIMAL DUP <# ROT DUP 0< IF FNEGATE THEN ( Ajustage 1 =< f < 10 ) 0 OVER [ 1 UFLOAT LITERAL ] F- 0< IF BEGIN >R [ 10 UFLOAT LITERAL ] F* R> 1- OVER [ 1 UFLOAT LITERAL ] F- 0< NOT UNTIL ELSE BEGIN OVER [ 10 UFLOAT LITERAL ] F- 0< NOT WHILE >R [ 10 UFLOAT LITERAL ] F/ R> 1+ REPEAT THEN ( Arrondi avec 5e-6 et reajustage f < 10 ) >R [ 5 UFLOAT 1000000 UFLOAT F/ LITERAL ] F+ R> OVER [ 10 UFLOAT LITERAL ] F- 0< NOT IF >R [ 10 UFLOAT 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 DUP INT DUP >R UFLOAT F- R> SWAP [ 10 UFLOAT LITERAL ] F* LOOP 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 ; ( FIN )