Initial implementation of lround().
This should work, and mostly does. However, it is affected by a bug in FX2L (and FX2C) which can sometimes give the wrong results for certain negative integers (such as -2147483648). I believe this can occur when at least the lower 16 bits if the integer (in two's-complement representation) are zeros.
This commit is contained in:
parent
88a7bbebcc
commit
503182e435
80
math2.asm
80
math2.asm
|
@ -882,6 +882,86 @@ ret creturn 4:x return it
|
||||||
rtl
|
rtl
|
||||||
end
|
end
|
||||||
|
|
||||||
|
****************************************************************
|
||||||
|
*
|
||||||
|
* long lround(double x);
|
||||||
|
*
|
||||||
|
* Rounds x to the nearest integer, rounding halfway cases
|
||||||
|
* away from 0, and returns it as a long (if representable).
|
||||||
|
*
|
||||||
|
****************************************************************
|
||||||
|
*
|
||||||
|
lround start
|
||||||
|
lroundf entry
|
||||||
|
lroundl entry
|
||||||
|
result equ 1 result value
|
||||||
|
|
||||||
|
csubroutine (10:x),4
|
||||||
|
|
||||||
|
phb
|
||||||
|
phk
|
||||||
|
plb
|
||||||
|
|
||||||
|
pha save env & set to default
|
||||||
|
tsc
|
||||||
|
inc a
|
||||||
|
pea 0
|
||||||
|
pha
|
||||||
|
FPROCENTRY
|
||||||
|
|
||||||
|
tdc round to integer with default rounding
|
||||||
|
clc
|
||||||
|
adc #x
|
||||||
|
pea 0
|
||||||
|
pha
|
||||||
|
adc #result-x
|
||||||
|
pea 0
|
||||||
|
pha
|
||||||
|
FX2L
|
||||||
|
|
||||||
|
pea INEXACT
|
||||||
|
FTESTXCP if there was no inexact exception
|
||||||
|
beq ret we are done: x was an integer/nan/inf
|
||||||
|
|
||||||
|
FGETENV
|
||||||
|
txa
|
||||||
|
ora #TOWARDZERO*$4000 set rounding direction to "toward zero"
|
||||||
|
pha
|
||||||
|
FSETENV
|
||||||
|
|
||||||
|
lda x+8
|
||||||
|
pha save sign of x
|
||||||
|
ora #$8000
|
||||||
|
sta x+8 x = -abs(x)
|
||||||
|
|
||||||
|
ph4 #onehalf x = x - 0.5 (rounded toward 0)
|
||||||
|
tdc
|
||||||
|
clc
|
||||||
|
adc #x
|
||||||
|
pea 0
|
||||||
|
pha
|
||||||
|
FSUBS
|
||||||
|
tdc round to integer
|
||||||
|
clc
|
||||||
|
adc #x
|
||||||
|
pea 0
|
||||||
|
pha
|
||||||
|
adc #result-x
|
||||||
|
pea 0
|
||||||
|
pha
|
||||||
|
FX2L
|
||||||
|
|
||||||
|
pla if x was positive
|
||||||
|
bmi ret
|
||||||
|
sub4 #0,result,result negate result
|
||||||
|
|
||||||
|
ret FPROCEXIT restore env & raise any new exceptions
|
||||||
|
plb
|
||||||
|
creturn 4:result return the result
|
||||||
|
|
||||||
|
onehalf dc f'0.5'
|
||||||
|
end
|
||||||
|
|
||||||
****************************************************************
|
****************************************************************
|
||||||
*
|
*
|
||||||
* float modff(float x, float *iptr);
|
* float modff(float x, float *iptr);
|
||||||
|
|
116
math2.macros
116
math2.macros
|
@ -281,6 +281,82 @@
|
||||||
bne ~&SYSCNT
|
bne ~&SYSCNT
|
||||||
inc 2+&a
|
inc 2+&a
|
||||||
~&SYSCNT ~restm
|
~&SYSCNT ~restm
|
||||||
|
mend
|
||||||
|
macro
|
||||||
|
&l sub4 &m1,&m2,&m3
|
||||||
|
lclb &yistwo
|
||||||
|
lclc &c
|
||||||
|
&l ~setm
|
||||||
|
aif c:&m3,.a
|
||||||
|
&c amid "&m2",1,1
|
||||||
|
aif "&c"<>"#",.a
|
||||||
|
&c amid "&m1",1,1
|
||||||
|
aif "&c"="{",.a
|
||||||
|
aif "&c"="[",.a
|
||||||
|
&c amid "&m2",2,l:&m2-1
|
||||||
|
aif &c>=65536,.a
|
||||||
|
sec
|
||||||
|
~lda &m1
|
||||||
|
~op sbc,&m2
|
||||||
|
~sta &m1
|
||||||
|
bcs ~&SYSCNT
|
||||||
|
~op.h dec,&m1
|
||||||
|
~&SYSCNT anop
|
||||||
|
ago .c
|
||||||
|
.a
|
||||||
|
aif c:&m3,.b
|
||||||
|
lclc &m3
|
||||||
|
&m3 setc &m1
|
||||||
|
.b
|
||||||
|
sec
|
||||||
|
~lda &m1
|
||||||
|
~op sbc,&m2
|
||||||
|
~sta &m3
|
||||||
|
~lda.h &m1
|
||||||
|
~op.h sbc,&m2
|
||||||
|
~sta.h &m3
|
||||||
|
.c
|
||||||
|
~restm
|
||||||
|
mend
|
||||||
|
macro
|
||||||
|
&l ~sta &op
|
||||||
|
lclc &c
|
||||||
|
&c amid "&op",1,1
|
||||||
|
aif "&c"<>"{",.b
|
||||||
|
&c amid "&op",l:&op,1
|
||||||
|
aif "&c"="}",.a
|
||||||
|
mnote "Missing closing '}'",2
|
||||||
|
&op setc &op}
|
||||||
|
.a
|
||||||
|
&op amid "&op",2,l:&op-2
|
||||||
|
&op setc (&op)
|
||||||
|
.b
|
||||||
|
&l sta &op
|
||||||
|
mend
|
||||||
|
macro
|
||||||
|
&l ~sta.h &op
|
||||||
|
&l anop
|
||||||
|
lclc &c
|
||||||
|
&c amid "&op",1,1
|
||||||
|
aif "&c"="[",.b
|
||||||
|
aif "&c"<>"{",.d
|
||||||
|
&c amid "&op",l:&op,1
|
||||||
|
aif "&c"="}",.a
|
||||||
|
mnote "Missing closing '}'",2
|
||||||
|
&op setc &op}
|
||||||
|
.a
|
||||||
|
&op amid "&op",2,l:&op-2
|
||||||
|
&op setc (&op)
|
||||||
|
.b
|
||||||
|
aif &yistwo,.c
|
||||||
|
&yistwo setb 1
|
||||||
|
ldy #2
|
||||||
|
.c
|
||||||
|
&op setc "&op,y"
|
||||||
|
sta &op
|
||||||
|
mexit
|
||||||
|
.d
|
||||||
|
sta 2+&op
|
||||||
mend
|
mend
|
||||||
MACRO
|
MACRO
|
||||||
&LAB FCLASSS
|
&LAB FCLASSS
|
||||||
|
@ -439,12 +515,6 @@
|
||||||
JSL $E10000
|
JSL $E10000
|
||||||
MEND
|
MEND
|
||||||
MACRO
|
MACRO
|
||||||
&LAB FX2D
|
|
||||||
&LAB PEA $0110
|
|
||||||
LDX #$090A
|
|
||||||
JSL $E10000
|
|
||||||
MEND
|
|
||||||
MACRO
|
|
||||||
&LAB FNEXTD
|
&LAB FNEXTD
|
||||||
&LAB PEA $011E
|
&LAB PEA $011E
|
||||||
LDX #$090A
|
LDX #$090A
|
||||||
|
@ -474,7 +544,33 @@
|
||||||
LDX #$090A
|
LDX #$090A
|
||||||
JSL $E10000
|
JSL $E10000
|
||||||
MEND
|
MEND
|
||||||
|
MACRO
|
||||||
|
&LAB FPROCENTRY
|
||||||
|
&LAB PEA $0017
|
||||||
|
LDX #$090A
|
||||||
|
JSL $E10000
|
||||||
|
MEND
|
||||||
|
MACRO
|
||||||
|
&LAB FPROCEXIT
|
||||||
|
&LAB PEA $0019
|
||||||
|
LDX #$090A
|
||||||
|
JSL $E10000
|
||||||
|
MEND
|
||||||
|
MACRO
|
||||||
|
&LAB FTESTXCP
|
||||||
|
&LAB PEA $001B
|
||||||
|
LDX #$090A
|
||||||
|
JSL $E10000
|
||||||
|
MEND
|
||||||
|
MACRO
|
||||||
|
&LAB FADDS
|
||||||
|
&LAB PEA $0200
|
||||||
|
LDX #$090A
|
||||||
|
JSL $E10000
|
||||||
|
MEND
|
||||||
|
MACRO
|
||||||
|
&LAB FSUBS
|
||||||
|
&LAB PEA $0202
|
||||||
|
LDX #$090A
|
||||||
|
JSL $E10000
|
||||||
|
MEND
|
||||||
|
|
Loading…
Reference in New Issue