From e00c21dd70af24b1e0d4ea2696048f1a659ee3cf Mon Sep 17 00:00:00 2001 From: Stephen Heumann Date: Sat, 27 Nov 2021 22:16:54 -0600 Subject: [PATCH] Work around bug in FX2C and FX2L. These SANE operations can sometimes return incorrect values for certain negative integers such as -2147483648 and -53021371269120 (numbers with at least 16 low-order zero bits in their two's-complement representation). To work around this, we now avoid calling FX2C or FX2L on negative numbers, generally by saving and restoring the sign separately. These workarounds are used in several of the new rounding functions, and also for code that converts floating-point values to comp or long long. There are some places in SysFloat that should be patched similarly, so we may still hit this problem in certain situations until that is done. --- fpextra.asm | 19 ++++++++-- int64.asm | 31 ++++++++++++++-- math2.asm | 102 +++++++++++++++++++++++++++++++++++++++++---------- math2.macros | 22 +++++++---- 4 files changed, 139 insertions(+), 35 deletions(-) diff --git a/fpextra.asm b/fpextra.asm index ac9f035..798e680 100644 --- a/fpextra.asm +++ b/fpextra.asm @@ -75,12 +75,20 @@ fpextra private dummy segment * Inputs: * extended-format real on stack * +* Note: This avoids calling FX2C on negative numbers, +* because it is buggy for certain values. +* **************************************************************** * ~CompPrecision start - tsc + lda 4+8,s + pha save original sign + asl a force sign to positive + lsr a + sta 6+8,s + tsc limit precision clc - adc #4 + adc #6 ldy #0 phy pha @@ -92,6 +100,11 @@ fpextra private dummy segment pha FX2C FC2X - rtl + pla restore original sign + bpl ret + lda 4+8,s + ora #$8000 + sta 4+8,s +ret rtl end diff --git a/int64.asm b/int64.asm index 0be044c..926a7d1 100644 --- a/int64.asm +++ b/int64.asm @@ -646,6 +646,9 @@ ret pld * Outputs: * signed long long int on stack * +* Note: This avoids calling FX2C on negative numbers, +* because it is buggy for certain values. +* **************************************************************** * ~CnvRealLongLong start @@ -668,11 +671,16 @@ ret pld sta 10,s sta 8,s sta 6,s - bra done + bra done otherwise -convert tsc if it is not LONG_MIN, call fx2c: +convert lda 4+8,s + pha save original sign + asl a force sign to positive + lsr a + sta 6+8,s + tsc clc - adc #4 + adc #6 pea 0 push src address for fx2c pha pea 0 push dst address for fx2c @@ -680,7 +688,22 @@ convert tsc if it is not LONG_MIN, call fx2c: inc a pha fx2c convert - + pla if original value was negative + bpl done + sec + lda #0 negate result + sbc 6,s + sta 6,s + lda #0 + sbc 6+2,s + sta 6+2,s + lda #0 + sbc 6+4,s + sta 6+4,s + lda #0 + sbc 6+6,s + sta 6+6,s + done phb move return address pla plx diff --git a/math2.asm b/math2.asm index cca4a1d..3f57bb6 100644 --- a/math2.asm +++ b/math2.asm @@ -16,7 +16,7 @@ math2 private dummy segment copy equates.asm end -INVALID gequ $0001 exceptions +INVALID gequ $0001 exceptions UNDERFLOW gequ $0002 OVERFLOW gequ $0004 DIVBYZERO gequ $0008 @@ -682,6 +682,9 @@ ret creturn 2:x return it * Rounds x to an integer using current rounding direction * and returns it as a long long (if representable). * +* Note: This avoids calling FX2C on negative numbers, +* because it is buggy for certain values. +* **************************************************************** * llrint start @@ -706,7 +709,7 @@ retptr equ 1 FCPXX compare with LLONG_MIN bne convert - lda #$8000 if it is LONG_MIN, use that value + lda #$8000 if it is LLONG_MIN, use that value ldy #6 sta [retptr],y asl a @@ -717,16 +720,40 @@ retptr equ 1 dey sta [retptr],y sta [retptr] - bra done + bra done otherwise -convert tdc if it is not LONG_MIN, call fx2c: +convert pei x+8 save sign of x + asl x+8 x = abs(x) + lsr x+8 + tdc clc adc #x pea 0 push src address for fx2c pha pei retptr+2 push dst address for fx2c pei retptr - FX2C convert + FX2C convert x + + pla if x was negative + bpl done + 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 done creturn @@ -861,6 +888,9 @@ logbl entry * Rounds x to an integer using current rounding direction * and returns it as a long (if representable). * +* Note: This avoids calling FX2L or FX2C on negative numbers, +* because they are buggy for certain values. +* **************************************************************** * lrint start @@ -869,6 +899,10 @@ lrintl entry csubroutine (10:x),0 + pei x+8 save sign of x + asl x+8 x = abs(x) + lsr x+8 + tdc convert to integer clc adc #x @@ -876,7 +910,22 @@ lrintl entry pha pea 0 pha - FX2L + FX2C + + lda x+4 if x is out of range of long + ora x+6 + bne flag_inv + cmpl x,#$80000000 + blt chk_neg + bne flag_inv + lda 1,s + bmi chk_neg +flag_inv pea INVALID raise "invalid" exception + FSETXCP + +chk_neg pla if x was negative + bpl ret + sub4 #0,x,x negate result ret creturn 4:x return it rtl @@ -889,6 +938,9 @@ ret creturn 4:x return it * Rounds x to the nearest integer, rounding halfway cases * away from 0, and returns it as a long (if representable). * +* Note: This avoids calling FX2L or FX2C on negative numbers, +* because they are buggy for certain values. +* **************************************************************** * lround start @@ -896,7 +948,7 @@ lroundf entry lroundl entry result equ 1 result value - csubroutine (10:x),4 + csubroutine (10:x),8 phb phk @@ -909,6 +961,10 @@ result equ 1 result value pha FPROCENTRY + pei x+8 save sign of x + asl x+8 x = abs(x) + lsr x+8 + tdc round to integer with default rounding clc adc #x @@ -917,30 +973,25 @@ result equ 1 result value adc #result-x pea 0 pha - FX2L + FX2C pea INEXACT FTESTXCP if there was no inexact exception - beq ret we are done: x was an integer/nan/inf + beq chkrange 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) + + ph4 #onehalf x = x + 0.5 (rounded toward 0) tdc clc adc #x pea 0 pha - FSUBS + FADDS tdc round to integer clc adc #x @@ -949,10 +1000,21 @@ result equ 1 result value adc #result-x pea 0 pha - FX2L + FX2C + +chkrange lda result+4 if x is out of range of long + ora result+6 + bne flag_inv + cmpl result,#$80000000 + blt chk_neg + bne flag_inv + lda 1,s + bmi chk_neg +flag_inv pea INVALID raise "invalid" exception + FSETXCP - pla if x was positive - bmi ret +chk_neg pla if x was negative + bpl ret sub4 #0,result,result negate result ret FPROCEXIT restore env & raise any new exceptions diff --git a/math2.macros b/math2.macros index 5035dbe..8c11b43 100644 --- a/math2.macros +++ b/math2.macros @@ -358,6 +358,18 @@ .d sta 2+&op mend + macro +&l cmpl &n1,&n2 + lclb &yistwo +&l ~setm + ~lda.h &n1 + ~op.h cmp,&n2 + bne ~a&SYSCNT + ~lda &n1 + ~op cmp,&n2 +~a&SYSCNT anop + ~restm + mend MACRO &LAB FCLASSS &LAB PEA $021C @@ -443,12 +455,6 @@ JSL $E10000 MEND MACRO -&LAB FX2L -&LAB PEA $0310 - LDX #$090A - JSL $E10000 - MEND - MACRO &LAB FXPWRY &LAB PEA $0012 LDX #$0B0A @@ -569,8 +575,8 @@ JSL $E10000 MEND MACRO -&LAB FSUBS -&LAB PEA $0202 +&LAB FSETXCP +&LAB PEA $0015 LDX #$090A JSL $E10000 MEND