Apple-2gs-SW/ORCALib
1
0
Fork 0
mirror of https://github.com/byteworksinc/ORCALib.git synced 2025-02-06 13:30:40 +00:00
Code Issues Projects Releases Wiki Activity

Implement llround().

Browse Source
This commit is contained in:
Stephen Heumann 2021-11-28 18:30:20 -06:00
parent 66cfa0d406
commit eddf778f09
1 changed files with 128 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

128
math2.asm
View File

@ -760,6 +760,134 @@ done creturn
llmin dc e'-9223372036854775808'
end
****************************************************************
*
* long long llround(double x);
*
* Rounds x to the nearest integer, rounding halfway cases away
* from 0, and returns it as a long long (if representable).
*
* Note: This avoids calling FX2C on negative numbers,
* because it is buggy for certain values.
*
****************************************************************
*
llround start
llroundf entry
llroundl entry
retptr equ 1
csubroutine (10:x),4
stx retptr
stz retptr+2
pha save env & set to default
tsc
inc a
pea 0
pha
FPROCENTRY
tdc if x == LLONG_MIN
clc
adc #x
pea 0
pha
ph4 #llmin
FCMPX
beq retllmin return LLONG_MIN
tdc else if x == LLONG_MIN+0.5
clc
adc #x
pea 0
pha
ph4 #llminp05
FCPXX
bne convert
pea INEXACT raise "inexact" exception
FSETXCP
retllmin lda #$8000 return LLONG_MIN
ldy #6
sta [retptr],y
asl a
dey
dey
sta [retptr],y
dey
dey
sta [retptr],y
sta [retptr]
brl ret else
convert pei x+8 save sign of x
asl x+8 x = abs(x)
lsr x+8
tdc round to integer
clc
adc #x
pea 0
pha
pei retptr+2
pei retptr
FX2C
pea INEXACT
FTESTXCP if there was no inexact exception
beq chk_neg we're done: x was an integer/nan/inf
FGETENV else
txa
ora #TOWARDZERO*$4000 round toward zero
pha
FSETENV
ph4 #onehalf x = x + 0.5 (rounded toward 0)
tdc
clc
adc #x
pea 0
pha
FADDS
tdc round to integer
clc
adc #x
pea 0
pha
pei retptr+2
pei retptr
FX2C
chk_neg pla if x was negative
bpl ret
sec
lda #0 negate result
sbc [retptr]
sta [retptr]
ldy #2
lda #0
sbc [retptr],y
sta [retptr],y
iny
iny
lda #0
sbc [retptr],y
sta [retptr],y
iny
iny
lda #0
sbc [retptr],y
sta [retptr],y
ret FPROCEXIT restore env & raise any new exceptions
creturn
llmin dc e'-9223372036854775808'
llminp05 dc e'-9223372036854775807.5'
onehalf dc f'0.5'
end
****************************************************************
*
* double log1p(double x);