home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Club Amiga de Montreal - CAM
/
CAM_CD_1.iso
/
files
/
420.lha
/
kFloat_v1.0
/
kFloat
< prev
next >
Wrap
Text File
|
1990-09-30
|
9KB
|
310 lines
\ kFloat v1.0 - Redefines some words of ju:float.ffp to improve
\ execution time.
\ Jerry Kallaus 05/08/89
\
\ Please limit distribution of this code; consider it preliminary
\ experimental code. A new version will be released after more
\ exhaustive testing has occurred.
\
\ The following words are redefined.
\ F+ F- F* F/ Float Int Fix F2* F2/
\
\ The following floating pointing condition checking words
\ are also redefined.
\ FEQ FNE FLT FLE FGE FGT FVC FVS
\
\ When the variable FP-STATUS? is TRUE, the floating point condition
\ checking words may be used; when FP-STATUS? is FALSE these words
\ may NOT be used, and the arithmetic operators listed above will
\ not generate code to save condition codes.
\ FP-STATUS? may be turned on and off as desired during compilation
\ and is TRUE by default.
\ The angle unit conversion words are also redefined.
\ See the ReadMe file for more information.
Include? f+ ju:float.ffp
Anew task-kFloat
Variable FP-Status? FP-Status? ON
\ Prelude code for 2 operand float ops
Asm F.Pre2
move.l tos,d1 right operand
move.l (dsp)+,d0 left operand
move.l a6,d3 save dsp
forth{ mathffp_lib ] aliteral [ }
move.l $0(org,tos.l),a6
Forth{ inline }
End-Code
\ Postlude code for floating ops with no GetCC
Asm F.Post
move.l d0,tos
move.l d3,a6 restore dsp
Forth{ inline }
End-Code
\ Postlude code for floating ops with GetCC
Asm F.PostCC
exg d0,tos preserve condition codes
move.l $4,a6 _ExecBase
jsr.l $-210(a6) GetCC
move.l d3,a6 restore dsp
forth{ fpstat ] aliteral [ }
move.w d0,$0(org,tos.l)
move.l (dsp)+,tos
Forth{ inline }
End-Code
\ Move condition code to variable FPStat
Asm CC.To.FPStat
exg d3,a6 preserve condition codes
move.l $4,a6 _ExecBase
jsr.l $-210(a6) GetCC
move.l d3,a6 restore dsp
forth{ fpstat ] aliteral [ }
move.w d0,$0(org,tos.l)
move.l (dsp)+,tos
Forth{ inline }
End-Code
\ Jump subroutine instructions for floating +,-,*,/
Asm FJ.+
jsr $-42(a6)
Forth{ inline }
End-Code
Asm FJ.-
jsr $-48(a6)
Forth{ inline }
End-Code
Asm FJ.*
jsr $-4E(a6)
Forth{ inline }
End-Code
Asm FJ./
jsr $-54(a6)
Forth{ Inline }
End-Code
: F/0Msg fpwarn @ IF cr ." Floating Point Divide by Zero !!!!" THEN inline ;
Asm F/0Err
CallCFA F/0Msg
addq.l #4,dsp
moveq.l #0,tos
ori-ccr #2
Forth{ inline }
End-Code
\ Subroutines for floating point arithmetic operators with no GetCC
: F.+ f.pre2 fj.+ f.post Both ;
: F.- f.pre2 fj.- f.post Both ;
: F.* f.pre2 fj.* f.post Both ;
Asm F./
tst.l tos Test for zero divisor
bne.s 1$ Branch on not zero
CallCFA f/0err Give error message
bra.s 2$
1$: CallCFA f.pre2
CallCFA fj./
CallCFA f.post
2$: Forth{ both }
End-Code
\ Subroutines for floating point arithmetic operators with GetCC
: FCC.+ f.pre2 fj.+ f.postcc Both ;
: FCC.- f.pre2 fj.- f.postcc Both ;
: FCC.* f.pre2 fj.* f.postcc Both ;
: FCC./ F./ CC.to.fpstat ;
\ Conditionally compile floating ops with or without GetCC,
\ or if interpreting just execute the function with GetCC.
: Fop.c/x ( fop-cfa fopcc-cfa -- )
compiling?
IF fp-status? @ IF nip cfa, ELSE drop cfa, THEN
ELSE nip execute THEN ;
: F+ ' f.+ ' fcc.+ Fop.c/x ; immediate
: F- ' f.- ' fcc.- Fop.c/x ; immediate
: F* ' f.* ' fcc.* Fop.c/x ; immediate
: F/ ' f./ ' fcc./ Fop.c/x ; immediate
\ -------------------------- INT - Convert Floating Point to Integer
Asm INT
move.b tos,d1 Sign and exponent
bge.s 7$ Go handle positive case
clr.b tos Negative case, clear lsb
sub.b #$C1,d1 Subtract off sign bit and bias+1
bmi.s 4$ Underflow, go return zero
sub.b #$1F,d1 Make shift count
bpl.s 1$ Branch on probable overflow
neg.b d1
lsr.l d1,tos Fix it and
neg.l tos make negative
bra.s 9$
1$: bne.s 2$ Branch on overflow
neg.l tos Check for max neg that can be fixed
bmi.s 9$ Was $ 800000E0 and is $80000000, so exit
2$: move.l #$80000000,tos Overflow neg infinite
3$: ori-ccr #2 Set overflow bit
bra.s 9$
4$: moveq.l #0,tos
bra.s 9$
5$: move.l #$7FFFFFFF,tos Overflow pos infinite
bra.s 3$
7$: clr.b tos Positive, clear lsb
sub.b #$41,d1 Subtract off bias+1
bmi.s 4$ Branch on underflow
sub.b #$1F,d1 Make shift count
bpl.s 5$ Branch on overflow
neg.b d1
lsr.l d1,tos Fix pos number
9$: Forth{ both }
End-Code
\ -------------------------- FLOAT - Convert Integer to Floating Point
Asm FLOAT
moveq.l #$5F,d1 Positive start exponent
tst.l tos
beq.s 9$ Zero in, zero out
bgt.s 2$ Go handle positive case
neg.l tos Make negative positive
bpl.s 1$ Go handle negative case
moveq.l #$E0,d1 $80000000 in, $800000E0 out
bra.s 4$
1$: moveq.l #$df,d1 Negative start exponet
cmp.l #$7FFF,tos
bhi.s 3$ Avoid normalizing 16 high order 0 bits
swap tos Fast left shift 16 places
moveq.l #$cf,d1 And new negative start exponent
bra.s 3$ Go normalize
2$: cmp.l #$7FFF,tos
bhi.s 3$ Avoid normalizing 16 high order 0 bits
swap tos Fast left shift 16 places
moveq.l #$4F,d1 and new positive start exponent
3$: add.l tos,tos Normalization
dbmi.w d1,3$ loop
add.l #$40,tos Round result
bcc.s 4$ Branch if rounding did not overflow
roxr.l #$1,tos Else handle overflow caused by rounding
addq.l #1,d1
4$: move.b d1,tos Stuff exponent and set condition code
9$: Forth{ both }
End-Code
\ --------------------------- Floating Point Add .5 to values >= .5
Asm >=.5+.5
move.b tos,d0 Isolate exponent
bclr #7,d0
sub.b #$40,d0
blt.s 2$ Branch on too small to round
sub.b #$17,d0
bgt.s 2$ Branch on too big to round
neg.b d0 Make int .5 aligned with float .5
addq.b #8,d0
moveq.l #0,d1
bset d0,d1
move.l tos,d0
add.l d1,tos Add the int .5
bcc.s 1$
roxr.l #1,tos Handle overflow
addq.b #1,d0
1$: move.b d0,tos Replace exponent
2$: Forth{ both }
End-Code
\ --------------------------- FIX - Floating Point rounded INT
max-inline @ 90 max-inline !
: FIX >=.5+.5 int both ;
max-inline !
\ --------------------------- Floating Point Multiply by 2.
Asm F.2*
move.l tos,d0
beq.s 2$ If zero, do nothing
addq.l #1,tos Increment exponent
eor.b tos,d0 If sign bit changed, then overflow
bgt.s 1$ Branch on no overflow
subq.l #1,tos Get back original value
or.l #$FFFFFF7F,tos Max number with original sign bit
tst.b tos Set condition code
ori-ccr #2 Set overflow condition
bra.s 2$
1$: tst.b tos Set condition code
2$: Forth{ Inline }
End-Code
: FCC.2* F.2* CC.To.FPStat Both ;
: F2* ' F.2* ' FCC.2* Fop.c/x ; immediate
\ --------------------------- Floating Point Divide by 2.
Asm F.2/
move.l tos,d0
subq.l #1,tos Decrement exponent
eor.b tos,d0 If sign bit changed, then underflow
bgt.s 1$ Branch if no underflow
moveq.l #0,tos If underflow, return zero
1$: tst.b tos Set Condition Code
Forth{ Inline }
End-Code
: FCC.2/ F.2/ CC.To.FPStat Both ;
: F2/ ' F.2/ ' FCC.2/ Fop.c/x ; immediate
\ --------------------------- Floating Point Condition Checking
: FP.Cond.Err
cr ." Floating point conditional used while FP-STATUS? is false" ;
\ If fp condition codes are being saved, then compile conditional test
\ code or execute if interpreting, otherwise give error message.
: Fcond.c/x ( test-cfa -- )
fp-status? @
if compiling? if cfa, else execute then
else fp.cond.err drop then ;
: FEQ ' feq fcond.c/x ; immediate
: FLT ' flt fcond.c/x ; immediate
: FGT ' fgt fcond.c/x ; immediate
: FNE ' fne fcond.c/x ; immediate
: FLE ' fle fcond.c/x ; immediate
: FGE ' fge fcond.c/x ; immediate
: FVS ' fvs fcond.c/x ; immediate
: FVC ' fvc fcond.c/x ; immediate
\ --------------------------- Floating Point Angular Conversions
$ E52E,E146 Constant Deg/Rad
$ 8EFA,353B Constant Rad/Deg
: DEG>RAD rad/deg f* ;
: RAD>DEG deg/rad f* ;