diff --git a/VersionASM b/VersionASM
index 09b03f0fcc12ac2f287b78516a6c704da8c1fadd..aff3c95a52190665e70abe729b99c600425a8fac 100644
--- a/VersionASM
+++ b/VersionASM
@@ -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
diff --git a/VersionNum b/VersionNum
index 98227ca397abf42559a9fa33aea4cc03a5991932..667714277a5de1830f37295ac5344cfd9415ca8b 100644
--- a/VersionNum
+++ b/VersionNum
@@ -1,23 +1,23 @@
-/* (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"
diff --git a/s/fp2 b/s/fp2
index 3594b2c9ee2962ecdc5b39203d99a1904773e804..06e49d71b4ba7d8d4b55345e8e9ebc3b393b181b 100644
--- a/s/fp2
+++ b/s/fp2
@@ -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
]