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'

VersionASM

@@ -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

VersionNum

-/* (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"

s/fp2

@@ -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