Commit db8c7df0 authored by Jeffrey Lee's avatar Jeffrey Lee
Browse files

Restore old number formatting logic

Detail:
  The BASIC64 number formatting code was found to be significantly different to the BASIC105 formatting code, and a potential source of compatibility issues due to the various bugs and quirks it seemed to contain
  To resolve this, the BASIC105 number formatting code has been resurrected and adapted to allow it to be used by both BASIC105 and BASIC64
  The formatting code still uses BCD internally, so accuracy will be the same as BASIC 1.65. It's just the formatting discrepancies (for both BASIC versions) which will have been affected.
  MAXDIGS has also been revised again; the +2 is no longer required (was a BASIC64 quirk), so BASIC105 is down to 11 (up from 10 in pre-1.65 versions) and BASIC64 has reverted to the historic value of 18 (which is technically one more than necessary)
  File changes:
  s/fp2 - Updated as described above
  Tests/Math/AtPercent,ffb - New test program which compares the E/F/G number formatting code against a (BASIC105-style) reference model for the number formatting implemented in BASIC
Admin:
  Tested on Raspberry Pi
  Fixes issue reported on forums:
  https://www.riscosopen.org/forum/forums/4/topics/9199


Version 1.66. Tagged as 'BASIC-1_66'
parent 99e7d120
......@@ -11,13 +11,13 @@
GBLS Module_HelpVersion
GBLS Module_ComponentName
GBLS Module_ComponentPath
Module_MajorVersion SETS "1.65"
Module_Version SETA 165
Module_MajorVersion SETS "1.66"
Module_Version SETA 166
Module_MinorVersion SETS ""
Module_Date SETS "30 Mar 2017"
Module_ApplicationDate SETS "30-Mar-17"
Module_Date SETS "13 Apr 2017"
Module_ApplicationDate SETS "13-Apr-17"
Module_ComponentName SETS "BASIC"
Module_ComponentPath SETS "castle/RiscOS/Sources/Programmer/BASIC"
Module_FullVersion SETS "1.65"
Module_HelpVersion SETS "1.65 (30 Mar 2017)"
Module_FullVersion SETS "1.66"
Module_HelpVersion SETS "1.66 (13 Apr 2017)"
END
/* (1.65)
/* (1.66)
*
* This file is automatically maintained by srccommit, do not edit manually.
* Last processed by srccommit version: 1.1.
*
*/
#define Module_MajorVersion_CMHG 1.65
#define Module_MajorVersion_CMHG 1.66
#define Module_MinorVersion_CMHG
#define Module_Date_CMHG 30 Mar 2017
#define Module_Date_CMHG 13 Apr 2017
#define Module_MajorVersion "1.65"
#define Module_Version 165
#define Module_MajorVersion "1.66"
#define Module_Version 166
#define Module_MinorVersion ""
#define Module_Date "30 Mar 2017"
#define Module_Date "13 Apr 2017"
#define Module_ApplicationDate "30-Mar-17"
#define Module_ApplicationDate "13-Apr-17"
#define Module_ComponentName "BASIC"
#define Module_ComponentPath "castle/RiscOS/Sources/Programmer/BASIC"
#define Module_FullVersion "1.65"
#define Module_HelpVersion "1.65 (30 Mar 2017)"
#define Module_LibraryVersionInfo "1:65"
#define Module_FullVersion "1.66"
#define Module_HelpVersion "1.66 (13 Apr 2017)"
#define Module_LibraryVersionInfo "1:66"
......@@ -325,19 +325,20 @@ FRANGE MOV FWGRD,FACC,LSL #30
; Pmin(bf) = 1+ceiling(p*log10(2))
; where p is the number of significant bits (i.e. p == number of bits used for
; storing mantissa + 1)
; This gives base values of 11 and 17, however we add two extra digits on top
; to cope with the leading zeros that 'G' format might add (0.0XXXX) before it
; switches to 'E' format.
; This gives base values of 11 and 17, however BASIC64 has historically used 18
; so we'll stick with that for now.
[ FPOINT=0
MAXDIGS * 11 + 2
MAXDIGS * 11
|
MAXDIGS * 17 + 2
MAXDIGS * 18
]
;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 ;Format number
FDIGS RN R4 ;(no harm the way currently written)
FPRTDX RN R7 ;Decimal exponent
FPRTWN RN R6 ;Work register
FCONFP TEQ R5,#0
BNE FCONHX
MOV FMAT,R4,LSR #16
......@@ -369,170 +370,181 @@ FCONA STMFD SP!,{FDIGS,R14} ;May need fdigs again
TEQ R0,#0
MOVMI R6,#"-"
STRMIB R6,[TYPE],#1
STR TYPE,[SP,#-4]!
MOV R3,R0,LSR #12
AND R6,R3,#&FF0
AND R3,R3,#15
CMP R6,#&10
ADDEQ R3,R3,#10
MOVHI R3,#0
AND R7,FDIGS,#255
CMP R3,R7 ;maximum number of digits!
MOVCS R3,#0
CMP FMAT,#0
BNE FPRTFA
CMP R3,#3
BCS FPRTFA
CMP R3,#0
TSTNE R0,#TINTEGER
BEQ FPRTFA
MOV R7,R3
MOV R6,#0
MOV R3,#1
BL FPRTNIBBLEDOT ;0.
CMP R7,#2
MOV R6,#0
BLEQ FPRTNIBBLE
BIC R0,R0,#&F000 ;remove 1 or 2
B FPRTFGO
FPRTFA TST R0,#TINTEGER
MOVNE R3,#0
CMP FMAT,#1
MOVEQ R3,#0
; Get the exponent into FPRTDX
AND FPRTDX,R0,#&F:SHL:20
AND LR,R0,#&F:SHL:16
ADD FPRTDX,FPRTDX,FPRTDX,LSR #2
ADD FPRTDX,LR,FPRTDX,LSR #1
AND LR,R0,#&F:SHL:12
ADD FPRTDX,FPRTDX,FPRTDX,LSR #2
ADD FPRTDX,LR,FPRTDX,LSR #1
TST R0,#1:SHL:30
MOV FPRTDX,FPRTDX,LSR #12
RSBNE FPRTDX,FPRTDX,#0
MOV R0,R0,LSL #20
MOVS R0,R0,LSR #20
ORREQS LR,R2,R1
BNE FPRTA
TEQ FMAT,#0
MOVEQ R6,#"0"
STREQB R6,[TYPE],#1
LDMEQFD SP!,{R6,PC} ;discard fdigs and return for 0 in G format
TEQ FMAT,#1
BEQ FPRTH
B FPRTZR
FPRTA
FPRTF LDR FDIGS,[SP] ;stacked fdigs
CMP FMAT,#2
BNE FPRTFH
ADC FDIGS,FDIGS,R3 ;fix up precision
AND R7,FDIGS,#255
CMP R7,#MAXDIGS+1 ;how many digits?
BICCS FDIGS,FDIGS,#255
ORRCS FDIGS,FDIGS,#MAXDIGS
MOVCS FMAT,#0 ;treat as G18 format if unreasonable
FPRTFH
;subtract from exponent
MOV R7,R3
CMP R3,#10
SUBCS R0,R0,#1 :SHL: 16
SUBCS R7,R7,#10
SUB R0,R0,R7,LSL #12
ADD R3,R3,#1
FPRTFGO MOV R6,R0,LSR #8
BL FPRTNIBBLEDOT
MOV R7,R0
BL FPRTBYTE
MOV R7,R1,LSR #24
BL FPRTBYTE
MOV R7,R1,LSR #16
BL FPRTBYTE
MOV R7,R1,LSR #8
BL FPRTBYTE
MOV R7,R1
BL FPRTBYTE
MOV R7,R2,LSR #24
BL FPRTBYTE
MOV R7,R2,LSR #16
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 ;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
ADD R6,TYPE,#1 ;round position
MOV R3,#5
FPRTRND CMP R2,R6 ;reached the first digit?
BLEQ FPRTRNDPANIC ;yes: number has another digit!
LDRB R7,[R6,#-1]!
CMP R7,FDIGS,LSR #24 ;check for ./,
BEQ FPRTRND ;don't round the ./, (!)
ADD R7,R7,R3 ;add the round value
CMP R7,#"9"+1 ;is there a carry?
MOVCS R3,#1 ;yes: propogate up
SUBCS R7,R7,#10 ;yes: and reduce back to digit
STRB R7,[R6] ;put rounded number back
BCS FPRTRND ;go round again if carry
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 Push "r0"
Push "r1"
Push "r2"
; Round to R1 sig figures
AND R1,FDIGS,#255
MOV R1,R1,LSL #2
RSB R1,R1,#18*4
MOV R2,#0
12
LDRB R0,[SP,R2,LSR #3]
MOV R0,R0,ROR #4
TST R2,#4
MOVNE R0,R0,ROR #4
CMP R1,R2
BLO %FT15
CMPEQ R0,#5:SHL:28
BIC R0,R0,#&F:SHL:28
B %FT20
15
CMP R0,#9:SHL:28
BICCS R0,R0,#&F:SHL:28
ADDCC R0,R0,#1:SHL:28
20
MOV R0,R0,ROR #28
TST R2,#4
MOVNE R0,R0,ROR #28
STRB R0,[SP,R2,LSR #3]
BCC %FT30
; Move on to next digit
CMP R2,#18*4
ADDNE R2,R2,#4
BNE %BT12
; Ran out of digits!
MOV R0,#1
STRB R0,[SP,R2,LSR #3]
ADD FPRTDX,FPRTDX,#1
Pull "r2"
Pull "r1"
Pull "r0"
B FPRTF
30
Pull "r2"
Pull "r1"
Pull "r0"
TST FDIGS,#255
BNE FPRTH
FPRTZR LDR FDIGS,[SP]
ADD FDIGS,FDIGS,#1
MOV R0,#0
MOV R1,#0
MOV R2,#0
MOV FPRTDX,#0
FPRTH MOV FPRTWN,#1
TEQ FMAT,#1
BEQ FPRTK
TEQ FPRTDX,#0
BMI FPRTKK
AND LR,FDIGS,#255
CMP FPRTDX,LR
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 LR,R0,LSR #8
ORR LR,LR,#"0"
STRB LR,[TYPE],#1
; Shift in the next digit
MOV R0,R0,LSL #4
ORR R0,R0,R1,LSR #28
MOV R1,R1,LSL #4
BIC R0,R0,#&F000
ORR R1,R1,R2,LSR #28
MOV R2,R2,LSL #4
SUBS FPRTWN,FPRTWN,#1
MOVEQ LR,FDIGS,LSR #24
STREQB LR,[TYPE],#1
SUB FDIGS,FDIGS,#1
TST FDIGS,#255
BNE FPRTK
TEQ FMAT,#1
BEQ FPRTTX
TEQ FMAT,#2
BEQ FPRTTY
FPRTTZ LDRB R6,[TYPE,#-1]! ;remove trailing 0s
CMP R6,#"0"
FPRTTZ LDRB LR,[TYPE,#-1]!
CMP LR,#"0"
BEQ FPRTTZ
CMP R6,FDIGS,LSR #24 ;stopped at ./,?
ADDNE TYPE,TYPE,#1 ;if didn't put back the character (else remove ./,)
FPRTTY MOV R7,R0,LSR #12
ORR R6,R7,R7,LSR #4
ANDS R6,R6,#255
BEQ FPRTNOEXPNT
FPRTTX MOV R6,#"E"
STRB R6,[TYPE],#1
TST R0,#TINTEGER
MOVNE R6,#"-"
STRNEB R6,[TYPE],#1
MOV R6,R0,LSR #20
ANDS R6,R6,#15
BLNE FPRTNIBBLE
MOV R6,R0,LSR #16
ANDEQS R6,R6,#15
BLNE FPRTNIBBLE
MOV R6,R0,LSR #12
BL FPRTNIBBLE
CMP LR,FDIGS,LSR #24
ADDNE TYPE,TYPE,#1
FPRTTY TEQ FPRTDX,#0
BEQ FPRTX
FPRTTX MOV LR,#"E"
STRB LR,[TYPE],#1
ADDS FPRTWN,FPRTDX,#0
MOVMI LR,#"-"
STRMIB LR,[TYPE],#1
RSBMI FPRTWN,FPRTWN,#0
MOV LR,#"0"
[ FPOINT<>0
IPRTB SUBS FPRTWN,FPRTWN,#100
ADDCS LR,LR,#1
BCS IPRTB
TEQ LR,#"0"
STRNEB LR,[TYPE],#1
ADD FPRTWN,FPRTWN,#100
MOV LR,#"0"
ORRNE LR,LR,#256
]
IPRTA SUBS FPRTWN,FPRTWN,#10
ADDCS LR,LR,#1
BCS IPRTA
TEQ LR,#"0"
STRNEB LR,[TYPE],#1
ADD FPRTWN,FPRTWN,#"0"+10
STRB FPRTWN,[TYPE],#1
TEQ FMAT,#0
BEQ FPRTNOEXPNT
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
LDMFD SP!,{FDIGS,PC}
FPRTRNDPANIC
MOV R6,TYPE
FPRTRNDPANICCOPY
LDRB R7,[R6,#-1]
STRB R7,[R6],#-1
CMP R6,R2
BNE FPRTRNDPANICCOPY
MOV R7,#"0"
STRB R7,[R6]
ADD R6,R2,#1
ADD TYPE,TYPE,#1
MOV PC,R14
FPRTBYTE
MOV R6,R7,LSR #4
AND R6,R6,#15
ADD R6,R6,#&30
STRB R6,[TYPE],#1
SUBS R3,R3,#1
MOVEQ R6,FDIGS,LSR #24
STREQB R6,[TYPE],#1
MOV R6,R7
FPRTNIBBLEDOT
AND R6,R6,#15
ADD R6,R6,#&30
STRB R6,[TYPE],#1
SUBS R3,R3,#1
MOVEQ R6,FDIGS,LSR #24
STREQB R6,[TYPE],#1
MOV PC,R14
FPRTNIBBLE
AND R6,R6,#15
ADD R6,R6,#&30
STRB R6,[TYPE],#1
MOV PC,R14
BEQ FPRTX
MOV R3,#" "
TEQ FPRTDX,#0
STRPLB R3,[TYPE],#1
[ FPOINT<>0
TST LR,#256
STREQB R3,[TYPE],#1
]
TEQ LR,#"0"
STREQB R3,[TYPE],#1
FPRTX LDMFD SP!,{FDIGS,PC}
[ FPOINT=0
; In: FACC = 5-byte float
; Out: R0-R2 = FPA format packed decimal
......
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