Commit 99e7d120 authored by Jeffrey Lee's avatar Jeffrey Lee
Browse files

Increase accuracy of 5-byte float to string conversion

Detail:
  This change rewrites the BASIC105 version of the FCONA routine so that it converts the value to FPA packed decimal format, with ~16 decimal digits of accuracy. To avoid adding an FPA dependency to BASIC105 this is done via a new, custom routine.
  Apart from improving the accuracy of the result, converting to packed decimal allows the rest of the function body to be shared with the BASIC64 variant of the routine.
  File changes:
  s/fp2 - Updated as above. New FACCtoBCD function added to perform the BCD/packed decimal conversion. MAXDIGS for BASIC105 increased to 11+2. Minor FRDFPEXPBIN optimisation.
Admin:
  Tested on BB-xM
  Although the new FCONA implementation is known not to be fully accurate, testing with Test.Math.Decimal shows a marked improvement over the previous implementation, with ~100m random float -> string -> float conversions being performed without any loss of accuracy


Version 1.65. Tagged as 'BASIC-1_65'
parent 78e98596
......@@ -11,13 +11,13 @@
GBLS Module_HelpVersion
GBLS Module_ComponentName
GBLS Module_ComponentPath
Module_MajorVersion SETS "1.64"
Module_Version SETA 164
Module_MajorVersion SETS "1.65"
Module_Version SETA 165
Module_MinorVersion SETS ""
Module_Date SETS "04 Mar 2017"
Module_ApplicationDate SETS "04-Mar-17"
Module_Date SETS "30 Mar 2017"
Module_ApplicationDate SETS "30-Mar-17"
Module_ComponentName SETS "BASIC"
Module_ComponentPath SETS "castle/RiscOS/Sources/Programmer/BASIC"
Module_FullVersion SETS "1.64"
Module_HelpVersion SETS "1.64 (04 Mar 2017)"
Module_FullVersion SETS "1.65"
Module_HelpVersion SETS "1.65 (30 Mar 2017)"
END
/* (1.64)
/* (1.65)
*
* This file is automatically maintained by srccommit, do not edit manually.
* Last processed by srccommit version: 1.1.
*
*/
#define Module_MajorVersion_CMHG 1.64
#define Module_MajorVersion_CMHG 1.65
#define Module_MinorVersion_CMHG
#define Module_Date_CMHG 04 Mar 2017
#define Module_Date_CMHG 30 Mar 2017
#define Module_MajorVersion "1.64"
#define Module_Version 164
#define Module_MajorVersion "1.65"
#define Module_Version 165
#define Module_MinorVersion ""
#define Module_Date "04 Mar 2017"
#define Module_Date "30 Mar 2017"
#define Module_ApplicationDate "04-Mar-17"
#define Module_ApplicationDate "30-Mar-17"
#define Module_ComponentName "BASIC"
#define Module_ComponentPath "castle/RiscOS/Sources/Programmer/BASIC"
#define Module_FullVersion "1.64"
#define Module_HelpVersion "1.64 (04 Mar 2017)"
#define Module_LibraryVersionInfo "1:64"
#define Module_FullVersion "1.65"
#define Module_HelpVersion "1.65 (30 Mar 2017)"
#define Module_LibraryVersionInfo "1:65"
......@@ -329,17 +329,15 @@ FRANGE MOV FWGRD,FACC,LSL #30
; to cope with the leading zeros that 'G' format might add (0.0XXXX) before it
; switches to 'E' format.
[ FPOINT=0
MAXDIGS * 10 ; There are some accuracy issues to resolve before we can sensibly use 11 + 2, so stick with historic value of 10
MAXDIGS * 11 + 2
|
MAXDIGS * 17 + 2
]
;format 0: General format nnnn.nnn fixes maximum number of digits [or use 1]
;format 1: Exponent format n.nnEnn fixes number of digits
;format 2: Fixed format nnnnnn.nnn fixes number of digits after . [or use 1]
FMAT RN R5
FMAT RN R5 ;Format number
FDIGS RN R4 ;(no harm the way currently written)
FPRTDX RN R7
FPRTWN RN R6
FCONFP TEQ R5,#0
BNE FCONHX
MOV FMAT,R4,LSR #16
......@@ -359,212 +357,15 @@ FCONFP TEQ R5,#0
BNE FCONA
TEQ FMAT,#2
ORRNE FDIGS,FDIGS,#MAXDIGS ;if not in format 2 use maximum digits instead of 0
FCONA MOV FPRTDX,#0
STMFD SP!,{FDIGS,R14} ;May need fdigs again
FCONA STMFD SP!,{FDIGS,R14} ;May need fdigs again
BL FLOATY
ADD TYPE,ARGP,#STRACC
[ FPOINT=0
CMP FACC,#0
BNE FPRTA
TEQ FMAT,#0
MOVEQ R6,#"0"
STREQB R6,[TYPE],#1
LDMEQFD SP!,{R6,PC} ;discard fdigs and return for 0 in E format
TEQ FMAT,#1
BEQ FPRTH
B FPRTZR
FPRTA MOV FGRD,#0
TEQ FSIGN,#0
MOVMI FSIGN,#"-"
STRMIB FSIGN,[TYPE],#1
MOVMI FSIGN,#0
FPRTC CMP FACCX,#&81
BCS FPRTD
BL FTENFX
SUB FPRTDX,FPRTDX,#1
B FPRTC
FPRTD CMP FACCX,#&84
BCC FPRTF
BNE FPRTE
CMP FACC,#&A0000000
BCC FPRTF
FPRTE BL FTENFQ
ADD FPRTDX,FPRTDX,#1
B FPRTC
FPRTEE BL FONE
ADD FPRTDX,FPRTDX,#1
B FPRTC
;table of round up constant values
FPRTROUNDTAB
& &A0000000
& &00000083
& &00000000
& &00000000
& &80000000
& &00000080
& &00000000
& &00000000
& &CCCCCCCC
& &0000007C
& &CCCCCCCD
& &00000000
& &A3D70A3D
& &00000079
& &70A3D707
& &00000000
& &83126E97
& &00000076
& &8D4FDF38
& &00000000
& &D1B71758
& &00000072
& &E2196525
& &00000000
& &A7C5AC47
& &0000006F
& &1B47841B
& &00000000
& &8637BD05
& &0000006C
& &AF6C69AE
& &00000000
& &D6BF94D5
& &00000068
& &E57A42AE
& &00000000
& &ABCC7711
& &00000065
& &8461CEEF
& &00000000
& &89705F41
& &00000062
& &36B4A589
& &00000000
FPRTF LDR FDIGS,[SP] ;stacked fdigs
CMP FMAT,#2
BNE FPRTFH
AND R6,FDIGS,#255
ADCS R6,R6,FPRTDX ;fix up precision by adding exponent digit count
BMI FPRTZR
CMP R6,#MAXDIGS+1 ;how many digits?
MOVCS R6,#MAXDIGS
MOVCS FMAT,#0 ;treat as G10 format if unreasonable
BIC FDIGS,FDIGS,#255
ORR FDIGS,FDIGS,R6
FPRTFH STMFD SP!,{FMAT,FPRTDX,FDIGS,FACC,FGRD,FSIGN,FACCX} ;facc stuff closest
[ {FALSE}
;code to compute round up constants if FTENFQ precision changes
MOV FACC,#&A0000000
MOV FACCX,#&83
MOV FGRD,#0
MOV FSIGN,#0 ;5 to acc
BL FSHOW
ANDS FWACCX,FDIGS,#255
BEQ FPRTGJ
FPRTGG BL FTENFQ
BL FSHOW
SUBS FWACCX,FWACCX,#1
BNE FPRTGG
|
ADR FACC,FPRTROUNDTAB
AND R7,FDIGS,#255
ADD FACC,FACC,R7,LSL #4
LDMIA FACC,{FACC,FACCX,FGRD,FSIGN}
]
FPRTGJ LDMFD SP!,{FWACCX,FWSIGN,FWGRD,FWACC} ;since facc stuff was closest
BL FADDW1
FPRTFF CMP FACCX,#&84
BLCC FTENFA
BCC FPRTFF ;note that this relies on ftenfa preserving C on exit
LDMFD SP!,{FDIGS,FPRTDX,FMAT}
CMP FACC,#&A0000000
BCS FPRTEE ;see if unnormalised: fix up if so
TST FDIGS,#255
BNE FPRTH
FPRTZR LDR FDIGS,[SP]
ADD FDIGS,FDIGS,#1
BL FCLR
MOV FPRTDX,#0
FPRTH MOV FPRTWN,#1
TEQ FMAT,#1
BEQ FPRTK
TEQ FPRTDX,#0
BMI FPRTKK
AND FSIGN,FDIGS,#255
CMP FPRTDX,FSIGN
BCS FPRTK
ADD FPRTWN,FPRTDX,#1
MOV FPRTDX,#0
B FPRTK
FPRTKK TEQ FMAT,#2
BEQ FPRTKL
CMN FPRTDX,#1
CMNNE FPRTDX,#2
BNE FPRTK
FPRTKL MOV FPRTWN,FDIGS,LSR #24 ;get . or ,
STRB FPRTWN,[TYPE,#1] ;store "0." in string (interestingly!)
MOV FPRTWN,#"0"
STRB FPRTWN,[TYPE],#2 ;put the zero at the beginning and then skip the .
FPRTKM ADDS FPRTDX,FPRTDX,#1
STRNEB FPRTWN,[TYPE],#1 ;put in 0 if ne 0
BNE FPRTKM ;round again
MOV FPRTWN,#&80
FPRTK MOV FSIGN,FACC,LSR #32-4
ORR FSIGN,FSIGN,#"0"
STRB FSIGN,[TYPE],#1
BIC FACC,FACC,#&F0000000
ADDS FGRD,FGRD,FGRD ;40 bit mantissa * 10.0
ADC FACC,FACC,FACC
MOV FSIGN,FGRD,LSR #32-2
ORR FSIGN,FSIGN,FACC,LSL #2
ADDS FGRD,FGRD,FGRD,LSL #2
ADCS FACC,FACC,FSIGN
SUBS FPRTWN,FPRTWN,#1
MOVEQ FSIGN,FDIGS,LSR #24
STREQB FSIGN,[TYPE],#1
SUB FDIGS,FDIGS,#1
TST FDIGS,#255
BNE FPRTK
TEQ FMAT,#1
BEQ FPRTTX
TEQ FMAT,#2
BEQ FPRTTY
FPRTTZ LDRB FSIGN,[TYPE,#-1]!
CMP FSIGN,#"0"
BEQ FPRTTZ
CMP FSIGN,FDIGS,LSR #24
ADDNE TYPE,TYPE,#1
FPRTTY TEQ FPRTDX,#0
BEQ FPRTX
FPRTTX MOV FSIGN,#"E"
STRB FSIGN,[TYPE],#1
ADDS FPRTWN,FPRTDX,#0
MOVMI FSIGN,#"-"
STRMIB FSIGN,[TYPE],#1
RSBMI FPRTWN,FPRTWN,#0
MOV FSIGN,#"0"
IPRTA SUBS FPRTWN,FPRTWN,#10
ADDCS FSIGN,FSIGN,#1
BCS IPRTA
TEQ FSIGN,#"0"
STRNEB FSIGN,[TYPE],#1
ADD FPRTWN,FPRTWN,#"0"+10
STRB FPRTWN,[TYPE],#1
TEQ FMAT,#0
BEQ FPRTX
MOV FGRD,#" "
TEQ FPRTDX,#0
STRPLB FGRD,[TYPE],#1
TEQ FSIGN,#"0"
STREQB FGRD,[TYPE],#1
FPRTX LDMFD SP!,{FDIGS,PC}
|
;format 0: General format nnnn.nnn fixes maximum number of digits [or use 1]
;format 1: Exponent format n.nnEnn fixes number of digits
;format 2: Fixed format nnnnnn.nnn fixes number of digits after . [or use 1]
;FDIGS=R4, FMAT=R5
[ FPOINT=1
STFP FACC,[SP,#-12]!
LDMFD SP,{R0,R1,R2}
LDMFD SP!,{R0,R1,R2}
|
BL FACCtoBCD
]
ADD TYPE,ARGP,#STRACC
TEQ R0,#0
MOVMI R6,#"-"
STRMIB R6,[TYPE],#1
......@@ -632,13 +433,15 @@ FPRTFGO MOV R6,R0,LSR #8
BL FPRTBYTE
MOV R7,R2,LSR #8
BL FPRTBYTE
[ FPOINT <> 0 ; Last two digits known to be zero for FPOINT=0
MOV R7,R2
BL FPRTBYTE
]
; For rounding to work we must make sure we have more digits in the
; buffer than MAXDIGS. So just add an extra zero.
MOV R6,#0
BL FPRTNIBBLEDOT
LDR R2,[SP],#4
LDR R2,[SP],#4 ;Recover stashed buffer ptr (could just use ARGP,#STRACC again??)
AND R7,FDIGS,#255
ADD TYPE,R2,R7
ADD TYPE,TYPE,#1 ;. must be somewhere
......@@ -686,12 +489,15 @@ FPRTTX MOV R6,#"E"
MOV R6,#" "
TST R0,#TINTEGER
STREQB R6,[TYPE],#1
[ FPOINT <> 0 ;1 less char of exponent padding for 5-byte
TST R0,#&F00000
STREQB R6,[TYPE],#1
TSTEQ R0,#&F0000
|
TST R0,#&F0000
]
STREQB R6,[TYPE],#1
FPRTNOEXPNT
ADD SP,SP,#12
LDMFD SP!,{FDIGS,PC}
FPRTRNDPANIC
MOV R6,TYPE
......@@ -727,8 +533,132 @@ FPRTNIBBLE
ADD R6,R6,#&30
STRB R6,[TYPE],#1
MOV PC,R14
]
[ FPOINT=0
; In: FACC = 5-byte float
; Out: R0-R2 = FPA format packed decimal
; R3,R6-R7,R9 corrupt
; Although packed decimal has room for 19 digits, we only calculate to a precision of 16, to keep things within two registers (and the accuracy of anything beyond digit 11 is questionable anyway)
; Note that no rounding is performed when the mantissa grows to over 16 decimal digits in length; the result is truncated
FACCtoBCD ROUT
AND FSIGN,FSIGN,#&80000000
STMFD R13!,{FSIGN,FDIGS,FMAT,LR}
MOV R2,#0 ; Digits 0-7
MOV R3,#0 ; Digits 8-15
MOVS R4,FACC
BEQ %FT90
; Convert FACC to BCD
ADR R5,tens
MOV R7,#0
MOV R9,#&80000000
LDR R6,[R5],#4
10
CMP R0,R6
ADDHS R3,R3,R9,LSR #3
ADDHS R2,R2,R7
BEQ %FT20
SUBHI R0,R0,R6
BHI %BT10
MOVS R9,R9,LSR #4
MOV R7,R7,RRX
MOV R7,R7,LSR #3
LDR R6,[R5],#4
B %BT10
20
MOV R4,#9 ; Decimal exponent
SUBS R1,R1,#129+31
LDR R9,=&88888888
LDRGT R7,=&33333333
BGT %FT50
BEQ %FT90
MOV R7,R9,LSR #3 ; &11111111
; Divide BCD number by two
30
AND R0,R3,R7
BIC R3,R3,R7
MOVS R0,R0,LSR #1
MOV R3,R3,LSR #1
ORR R0,R0,R0,LSR #2
ADD R3,R3,R0,LSR #1
AND R0,R2,R7
BIC R2,R2,R7
MOV R0,R0,RRX
MOV R2,R2,LSR #1
ORR R0,R0,R0,LSR #2
ADD R2,R2,R0,LSR #1
; Shift left one digit to keep first digit non-zero
TST R3,#&F0000000
SUBEQ R4,R4,#1
MOVEQ R3,R3,LSL #4
ORREQ R3,R3,R2,LSR #28
MOVEQ R2,R2,LSL #4
ADDS R1,R1,#1
BNE %BT30
B %FT90
; Multiply BCD number by two
50
ADD R2,R2,R7
MVN R0,R2
AND R0,R0,R9
MOVS R2,R2,LSL #1
ORR R0,R0,R0,LSR #1
SUB R2,R2,R0,LSR #1
ADD R3,R3,R7
MVN R0,R3
AND R0,R0,R9
ADCS R3,R3,R3
ORR R0,R0,R0,LSR #1
SUB R3,R3,R0,LSR #1
; Shift right one digit if we overflowed
MOVCS R2,R2,LSR #4
ORRCS R2,R2,R3,LSL #28
MOVCS R3,R3,LSR #4
ORRCS R3,R3,#&10000000
ADDCS R4,R4,#1
SUBS R1,R1,#1
BNE %BT50
; Now convert to STFP format
90
LDR R0,[R13],#4
MOV R1,R3,LSL #12
ORR R0,R0,R3,LSR #32-12
ORR R1,R1,R2,LSR #32-12
MOV R2,R2,LSL #12
CMP R4,#0
ORRLT R0,R0,#1:SHL:30
RSBLT R4,R4,#0
BEQ %FT99
; Convert exponent to BCD, noddy approach
91
CMP R4,#100
SUBHS R4,R4,#100
ADDHS R0,R0,#1:SHL:20
BHI %BT91
92
CMP R4,#10
SUBHS R4,R4,#10
ADDHS R0,R0,#1:SHL:16
BHI %BT92
ADD R0,R0,R4,LSL #12
99
LDMFD R13!,{FDIGS,FMAT,PC}
tens
DCD 1000000000
DCD 100000000
DCD 10000000
DCD 1000000
DCD 100000
DCD 10000
DCD 1000
DCD 100
DCD 10
DCD 1
;40 bit FACC:=FACC*10
;uses only FWGRD
FTENFX MOV FWGRD,FACC,ASL #30
......@@ -1067,10 +997,7 @@ FRDFPEXPBIN2
SUBHS R7,R7,#10
ADDHS R3,R3,#1:SHL:16
BHS FRDFPEXPBIN2
FRDFPEXPBIN3
SUBS R7,R7,#1
ADDHS R3,R3,#1:SHL:12
BHS FRDFPEXPBIN3
ADD R3,R3,R7,LSL #12
STR R3,[SP]
B FRDFPDONE
]
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment