Converting Floating Point Numbers into Text in ASM

[Charles Pegge]

The fformat function works about 3.5 to 7 times faster than STR$ or FORMAT$.
You can specify from 0 to 9 decimal places but this fformat function does not support E notation.


PowerBasic v8 supports extended precision floats but FreeBasic v0.16b does not, so the Freebasic example is shown with double precision.

For PowerBasic

UPDATE: Supporting up to 18 decimal places see next posting below. 10 Jan 2007

Code Select Expand


'------------------------------------------------------------------------
' fformat
' Assembler function for converting floating point numbers to text
'------------------------------------------------------------------------

' 26 June 2007
' Charles E V Pegge
' Using PowerBasic 8x

#COMPILE EXE
#DIM ALL

'-----------------------'
'  DIAGNOSIC FUNCTIONS  '
'-----------------------'

FUNCTION displayhex(s AS STRING) AS STRING
DIM c AS LONG,i AS LONG, j AS LONG , l AS LONG: : c=0: i=0: j=3: l=LEN(s)
DIM t AS STRING: t=CHR$(13)+CHR$(10)+SPACE$(l*3.125 +1)
DO
  INCR i: IF i>l THEN EXIT DO
  MID$(t,j)=RIGHT$("0"+HEX$(ASC(s,i)),2):j=j+3:INCR c
  IF c>15 THEN c=0:MID$(t$,j)=CHR$(13)+CHR$(10):j=j+2
LOOP
FUNCTION=LEFT$(t,j-1)
END FUNCTION


FUNCTION displayoct(s AS STRING) AS STRING
DIM c AS LONG ,i AS LONG, j AS LONG,l AS LONG
c=0:i=0:j=3:l=LEN(s)
DIM t AS STRING: t=CHR$(13)+CHR$(10)+SPACE$(l*4.125 +1)
DO
  INCR i:IF i>l THEN EXIT DO
  MID$(t,j)=RIGHT$("00"+OCT$(ASC(s,i)),3):j=j+4:INCR c
  IF c>15 THEN c=0:MID$(t$,j)=CHR$(13)+CHR$(10):j=j+2
LOOP
FUNCTION=LEFT$(t,j-1)
END FUNCTION


FUNCTION fformat(BYVAL  v AS EXTENDED PTR, BYVAL d AS LONG, BYVAL s AS BYTE PTR) AS LONG
ASM
'======================'
!mov ebx,v             ' double precision value ptr
!mov edx,s             ' work and output buffer ptr
!mov eax,d             ' decimal places required
!mov eax,[edx+eax*4+16]' lookup decimal places multiplier
!mov [edx+12],eax      ' store the multiplier selected
'======================'
aa:                    '
'fstcw [edx+60]        ' save copy of control word
'fstcw [edx+64]        ' save another copy to alter
''or dword ptr [edx+64], &hc00 ' set bits 10 & 11 to truncate reals
'and dword ptr [edx+64], &hfffff3ff ' clear bits 10 & 11 for default rounding up
'fldcw [edx+64]        ' load control word with new rounding rule
'!fld qword ptr [ebx]   ' load double preciion
!db &hdb               ' load extended precision
!db &h2b               ' [ebx]
'cmp dword ptr d,0     ' are ther decimal places
'jz a1                 ' bypass multiplier if not
!fimul dword ptr [edx+12] ' multiply by number of dplaces
a1:
'!fbstp  [edx]         ' store result in packed binary coded decimal
!db &hdf               ' PB wont accept the above line so these are the opcodes
!db &h32
'fldcw [edx+60]        ' restore control word to previous setting
'----------------------'
!                      ' set up pointers
!mov ebx,edx           ' dest pointer
!add ebx,64            ' offset from base
'----------------------'
                       ' check if negative
!mov al,[edx+9]        ' load sign byte
!cmp al,&h80           ' check negative sign bit ?
!mov al,32             ' assume not by loading space
!jnz bb                '
!mov al,45             ' ascii '-' if it is negative
bb:                    '
!mov [ebx],al          ' store the neg sign or space
!inc ebx               ' next dest
!mov ecx,8             ' number of packed bcd pairs
'----------------------'
!                      ' unpack bcd, most signficant digits first
cc:                    ' { do loop
!mov al,[edx+ecx]      ' load bcd pair
!mov ah,al             ' for upper
!shr ah,4              ' reposition upper
!and eax,&h0f0f        ' mask bcd bits
!or eax,&h3030         ' add 48 for ascii numbers
!mov [ebx],ah          ' dest upper
!inc ebx               ' inc dest
!mov [ebx],al          ' dest lower
!inc ebx               ' inc dest
!dec ecx               ' bcd pair down count
!jge cc                ' } repeat
!mov dword ptr [ebx],0 ' end marker quad null
'jmp xit1              ' no-formatting test
'----------------------'
'                      ' format:
'      FORMAT          ' remove leading zeros
'                      ' insert decimal point
'                      ' nul byte termination
'                      ' return length of string
'----------------------'
!mov ecx,18            ' number of digits
!add edx,64            ' set up src pointer (base+64)
!mov ebx,edx           ' dest pointer
!add ebx,32            ' (offset= base+96)
!                      ' set sign
!mov al, [edx]         ' load src
!inc edx               ' next src
!cmp al,45 '           ' is it neg '-'
!jnz e1                '
!mov byte ptr [ebx],45 ' set '-' sign
!inc ebx               ' next dest
'----------------------'
!                      ' strip leading zeros
e1:                    ' do {
!                      ' check for decimal point placement
!cmp ecx,d           '
!jnz e11               '
!mov byte ptr [ebx],48 ' set 0
!inc ebx               ' dest
!jmp wholenum          ' left of decimal place
e11:                   '
!cmp byte ptr [edx],48 ' is it 0 ?
!jnz wholenum          ' to transfer
!                      ' continuing zero skip loop
!inc edx               ' src
!dec ecx               ' digit down count
!jg e1                 '  } repeat
!jmp xit1              ' finish
'----------------------'
!                      ' before decimal pt loop
wholenum:              '
'cmp dword ptr d,0     ' any decimal points ?
'jz qcopy              ' bypass if no decimal point
e2:                    ' { do
!                      ' decimal point test
!cmp ecx,d             '
!jz decimalpt          ' exit for decimal point insertion
!mov al,[edx]          ' transfer byte by byte
!mov [ebx],al          '
!inc edx               ' next src
!inc ebx               ' next dest
!dec ecx               ' digit count down
!jg e2                 ' } repeat
!jmp xit1              ' finish
'----------------------'
!                      ' decimal point onward
decimalpt:             ' insert decimal point
!mov byte ptr [ebx],46 ' decimal point ascii 46
!inc ebx               ' next dest
qcopy:                 '
!add ecx,ebx           ' ptr to end of number
!inc ecx               ' offset by 1
e24:                   ' { rapid transfer loop with 4 byte chunks
!mov eax,[edx]         ' src
!mov [ebx],eax         ' store dest incl end null quad
!cmp eax,0             ' was it a null quad?
!jz xit                ' then finish
!add edx,4             ' else next src quad
!add ebx,4             ' and next dest quad
!jmp e24               ' } repeat
'======================'
xit:                   ' finishing procedures
!mov ebx,ecx           ' to get length of number
xit1:                  '
!mov byte ptr [ebx],0  ' set null boundary byte
!sub ebx,s             ' calc offset from beginning of data
!sub ebx,96            ' minus start of num offset
!mov function,ebx      ' gives length of string (excluding null terminator byte)
'======================'

END FUNCTION


'--------------------'
'  MAP OF WORKSPACE  '
'--------------------'
'
' 00..08  packed bcd result
' 09      sign of packed bcd result
' 10..11  unused
' 12..15  selected fp multiplier
' 16..59  multiplier lookup table (for decimal point)
' 60 .63  original fpu control word
' 64..67  temp storage for altered fpu control word
' 64..82  unpacked decimal text
' 83..95  unused
' 96..127 formatted number text including null terminating bytes

' length of  number text, excluding terminator is returned by the function.


'--------'
'  MAIN  '
'--------'

FUNCTION PBMAIN()

DIM fv AS EXTENDED    ' value to convert
DIM rs AS STRING    ' workspace
DIM ps AS BYTE PTR  ' pointer to workspace
DIM le AS LONG      ' length of converted number string
DIM ss AS STRING    ' string copy of result
DIM sp AS STRING    ' to display results

rs=STRING$(128,CHR$(0)): ps=STRPTR(rs)
MID$(rs,17)=MKL$(1)+MKL$(10)+MKL$(1e2)+MKL$(1e3)+MKL$(1e4) _
+MKL$(1e5)+MKL$(1e6)+MKL$(1e7)+MKL$(1e8)+MKL$(1e9)

'  test values '

fv=-123.636666666666
'fv=5.12345678

le=fformat(VARPTR(fv),8,ps):ss=MID$(rs,97,le):ss=LEFT$(ss,LEN(ss)-1)


sp="" _
+ "fformat: "+displayhex(rs)+$CR _
+ ""+$CR _
+ "Result: "+ss+$CR _
+""+$CR

'--------------'
'  TIME TRIAL  '
'--------------'

DIM t AS DOUBLE, tf AS DOUBLE, ts AS DOUBLE
DIM i AS LONG
t=TIMER
FOR i=1 TO 100000
le=fformat(VARPTR(fv),8,ps)
NEXT
tf=TIMER-t

t=TIMER
FOR i=1 TO 100000
le=LEN(FORMAT$(fv,8))
NEXT
ts=TIMER-t

sp=sp _
+ "speed test using 100,000 conversions:"+$CR _
+ "fformat "+STR$(tf)+$CR _
+ "format$ "+STR$(ts)+$CR _
+ "Speed factor "+STR$(ts/tf)+$CR _
+ ""

MSGBOX sp


END FUNCTION





For FreeBasic

Code Select Expand


'------------------------------------------------------------------------
' fformat
' Assembler function for converting floating point numbers to text
'------------------------------------------------------------------------

' 26 June 2007
' Charles E V Pegge
' Using FreeBasic 0.16b


'-----------------------'
'  DIAGNOSIC FUNCTIONS  '
'-----------------------'

function displayhex(s as string) as string
dim as long c=0,i=0,j=3,l=len(s)
dim as string t=chr$(13)+chr$(10)+space(l*3.125 +1)
do
  i+=1:if i>l then exit do
  mid$(t,j)=right$("0"+hex$(asc(s,i)),2):j+=3:c+=1
  if c>15 then c=0:mid$(t$,j)=chr$(13)+chr$(10):j+=2
loop
function=left$(t,j-1)
end function


function displayoct(s as string) as string
dim as long c=0,i=0,j=3,l=len(s)
dim as string t=chr$(13)+chr$(10)+space(l*4.125 +1)
do
  i+=1:if i>l then exit do
  mid$(t,j)=right$("00"+oct$(asc(s,i)),3):j+=4:c+=1
  if c>15 then c=0:mid$(t$,j)=chr$(13)+chr$(10):j+=2
loop
function=left$(t,j-1)
end function


function fformat(byval  v as double ptr, byval d as long, byval s as byte ptr) as long
asm
'======================'
mov ebx,[v]           ' double precision value ptr
mov edx,[s]           ' work and output buffer ptr
mov eax,[d]           ' decimal places required
mov eax,[edx+eax*4+16]' lookup decimal places multiplier
mov [edx+12],eax      ' store the multiplier selected
'======================'
aa:                    '
'fstcw [edx+60]        ' save copy of control word
'fstcw [edx+64]        ' save another copy to alter
''or dword ptr [edx+64], &hc00 ' set bits 10 & 11 to truncate reals
'and dword ptr [edx+64], &hfffff3ff ' clear bits 10 & 11 for default rounding up
'fldcw [edx+64]        ' load control word with new rounding rule
fld qword ptr [ebx]   ' load double preciion
'fld xword ptr [ebx]   ' load extended precision
'cmp dword ptr [d],0   ' are ther decimal places
'jz a1                 ' bypass multiplier if not
fimul dword ptr [edx+12] ' multiply by number of dplaces
a1:
fbstp [edx]           ' store result in packed binary coded decimal
'fldcw [edx+60]        ' restore control word to previous setting
'----------------------'
                       ' set up pointers 
mov ebx,edx           ' dest pointer
add ebx,64            ' offset from base
'----------------------'
                       ' check if negative
mov al,[edx+9]        ' load sign byte
cmp al,&h80           ' check negative sign bit ?
mov al,32             ' assume not by loading space
jnz bb                '
mov al,45             ' ascii '-' if it is negative
bb:                    '
mov [ebx],al          ' store the neg sign or space
inc ebx               ' next dest
mov ecx,8             ' number of packed bcd pairs
'----------------------'
                       ' unpack bcd, most signficant digits first
cc:                    ' { do loop
mov al,[edx+ecx]      ' load bcd pair
mov ah,al             ' for upper
shr ah,4              ' reposition upper
and eax,&h0f0f        ' mask bcd bits
or eax,&h3030         ' add 48 for ascii numbers
mov [ebx],ah          ' dest upper
inc ebx               ' inc dest
mov [ebx],al          ' dest lower
inc ebx               ' inc dest
dec ecx               ' bcd pair down count
jge cc                ' } repeat
mov dword ptr [ebx],0 ' end marker quad null
'jmp xit1              ' no-formatting test
'----------------------'
'                      ' format:
'      FORMAT          ' remove leading zeros
'          T           ' insert decimal point
'                      ' nul byte termination
'                      ' return length of string
'----------------------'
mov ecx,18            ' number of digits
add edx,64            ' set up src pointer (base+64)
mov ebx,edx           ' dest pointer
add ebx,32            ' (offset= base+96)
                       ' set sign
mov al, [edx]         ' load src
inc edx               ' next src
cmp al,45 '           ' is it neg '-'
jnz e1                '
mov byte ptr [ebx],45 ' set '-' sign
inc ebx               ' next dest
'----------------------'
                       ' strip leading zeros
e1:                    ' do {
                       ' check for decimal point placement
cmp ecx,[d]           '
jnz e11               '
mov byte ptr [ebx],48 ' set 0
inc ebx               ' dest
jmp wholenum          ' left of decimal place
e11:                   '
cmp byte ptr [edx],48 ' is it 0 ?
jnz wholenum          ' to transfer
                       ' continuing zero skip loop
inc edx               ' src
dec ecx               ' digit down count
jg e1                 '  } repeat
jmp xit1              ' finish
'----------------------'
                       ' before decimal pt loop
wholenum:              '
'cmp dword ptr [d],0   ' any decimal points ?
'jz qcopy              ' bypass if no decimal point
e2:                    ' { do
                       ' decimal point test
cmp ecx,[d]           '
jz decimalpt          ' exit for decimal point insertion
mov al,[edx]          ' transfer byte by byte
mov [ebx],al          '
inc edx               ' next src
inc ebx               ' next dest
dec ecx               ' digit count down
jg e2                 ' } repeat
jmp xit1              ' finish
'----------------------'
                       ' decimal point onward
decimalpt:             ' insert decimal point
mov byte ptr [ebx],46 ' decimal point ascii 46
inc ebx               ' next dest
qcopy:                 '
add ecx,ebx           ' ptr to end of number
inc ecx               ' offset by 1
e24:                   ' { rapid transfer loop with 4 byte chunks
mov eax,[edx]         ' src
mov [ebx],eax         ' store dest incl end null quad
cmp eax,0             ' was it a null quad?
jz xit                ' then finish
add edx,4             ' else next src quad
add ebx,4             ' and next dest quad
jmp e24               ' } repeat
'======================'
xit:                   ' finishing procedures
mov ebx,ecx            ' to get length of number
xit1:                  '
mov byte ptr [ebx],0  ' set null boundary byte
sub ebx,[s]           ' calc offset from beginning of data
sub ebx,96            ' minus start of num offset
mov [function],ebx    ' gives length of string (excluding null terminator byte)
'======================'
end asm
end function


'--------------------'
'  MAP OF WORKSPACE  '
'--------------------'
'
' 00..08  packed bcd result
' 09      sign of packed bcd result
' 10..11  unused
' 12..15  selected fp multiplier
' 16..59  multiplier lookup table (for decimal point)
' 60 .63  original fpu control word
' 64..67  temp storage for altered fpu control word
' 64..82  unpacked decimal text
' 83..95  unused
' 96..127 formatted number text including null terminating bytes

' length of  number text, excluding terminator is returned by the function.


'--------'
'  MAIN  '
'--------'

dim fv as double    ' value to convert
dim rs as string    ' workspace
dim ps as byte ptr  ' pointer to workspace
dim le as long      ' length of converted number string
dim ss as string    ' string copy of result

rs=string$(128,chr$(0)): ps=strptr(rs)
mid$(rs,17)=mkl$(1)+mkl$(10)+mkl$(1e2)+mkl$(1e3)+mkl$(1e4) _
+mkl$(1e5)+mkl$(1e6)+mkl$(1e7)+mkl$(1e8)+mkl$(1e9)

'  test values '

fv=-123.636666666666
'fv=5.12345678

le=fformat(varptr(fv),8,ps):ss=mid$(rs,97,le)

print "fformat: "+displayhex(rs)
print
print "Result: "+ss
print

'--------------'
'  TIME TRIAL  '
'--------------'

dim as double t,tf,ts
dim as long i
t=timer
for i=1 to 100000
le=fformat(varptr(fv),8,ps)
next
tf=timer-t

t=timer
for i=1 to 100000
le=len(str$(fv))
next
ts=timer-t

print "speed test using 100,000 conversions:"
print "fformat ",tf
print "str$ ",ts
print "Speed factor ",ts/tf
print


end


[Charles Pegge]

This version will support up to 18 decimal places

PowerBasic

Code Select Expand


'------------------------------------------------------------------------
' fformat
' Assembler function for converting floating point numbers to text
'------------------------------------------------------------------------
' Whole numbers accurate to 18 digits
' Fractions to at least 15 digits precision
' 18 decimal places

' 10 January 2008
' Charles E V Pegge
' Using PowerBasic 8x

#COMPILE EXE
#DIM ALL

'-----------------------'
'  DIAGNOSIC FUNCTIONS  '
'-----------------------'

FUNCTION displayhex(s AS STRING) AS STRING
DIM c AS LONG,i AS LONG, j AS LONG , l AS LONG: : c=0: i=0: j=3: l=LEN(s)
DIM t AS STRING: t=CHR$(13)+CHR$(10)+SPACE$(l*3.125 +1)
DO
  INCR i: IF i>l THEN EXIT DO
  MID$(t,j)=RIGHT$("0"+HEX$(ASC(s,i)),2):j=j+3:INCR c
  IF c>15 THEN c=0:MID$(t$,j)=CHR$(13)+CHR$(10):j=j+2
LOOP
FUNCTION=LEFT$(t,j-1)
END FUNCTION


FUNCTION displayoct(s AS STRING) AS STRING
DIM c AS LONG ,i AS LONG, j AS LONG,l AS LONG
c=0:i=0:j=3:l=LEN(s)
DIM t AS STRING: t=CHR$(13)+CHR$(10)+SPACE$(l*4.125 +1)
DO
  INCR i:IF i>l THEN EXIT DO
  MID$(t,j)=RIGHT$("00"+OCT$(ASC(s,i)),3):j=j+4:INCR c
  IF c>15 THEN c=0:MID$(t$,j)=CHR$(13)+CHR$(10):j=j+2
LOOP
FUNCTION=LEFT$(t,j-1)
END FUNCTION


FUNCTION fformat(v AS EXTENDED, BYVAL d AS LONG, st AS STRING) AS LONG
#REGISTER NONE
LOCAL s AS LONG
s=STRPTR(st)
ASM
'======================'
! mov ebx,v            ' double precision value ptr
! mov edx,s            ' work and output buffer ptr
'======================'
aa:                    '
'! fstcw [edx+60]      ' save copy of control word
'! fstcw [edx+64]      ' save another copy to alter
'! or dword ptr [edx+64], &hc00 ' set bits 10 & 11 to truncate reals
'! and dword ptr [edx+64], &hfffff3ff ' clear bits 10 & 11 for default rounding up
'! fldcw [edx+64]      ' load control word with new rounding rule
'! fld qword ptr [ebx] ' load double preciion
! db &hdb              ' load extended precision
! db &h2b              ' [ebx]
! mov eax,d            '
! cmp eax,9            '
! jl m1                '
! fimul dword ptr [edx+52] ' pre multiply by 1e9
! sub eax,9            '
m1:                    '
! cmp eax,0            '
! jle a1               '
! shl eax,2            '
! add eax,edx          '
! fimul dword ptr [eax+16] ' multiply by number of dplaces
a1:                    '
'! fbstp  [edx]        ' store result in packed binary coded decimal
! db &hdf,&h32         ' PB wont accept the above line so these are the opcodes
' fldcw [edx+60]       ' restore control word to previous setting
'======================'
!                      ' set up pointers
! mov ebx,edx          ' dest pointer
! add ebx,64           ' offset from base
                       ' check if negative
! mov al,[edx+9]       ' load sign byte
! cmp al,&h80          ' check negative sign bit ?
! mov al,32            ' assume not by loading space
! jnz bb               '
! mov al,45            ' ascii '-' if it is negative
bb:                    '
! mov [ebx],al         ' store the neg sign or space
! inc ebx              ' next dest
! mov ecx,8            ' number of packed bcd pairs
! add edx,8
'======================'
!                      ' unpack bcd, most signficant digits first
cc:                    ' { do loop
! mov al,[edx]         ' load bcd pair
! dec edx              ' work backwards
! mov ah,al            ' for upper
! shr ah,4             ' reposition upper
! and eax,&h0f0f       ' mask bcd bits
! or eax,&h3030        ' add 48 for ascii numbers
! mov [ebx],ah         ' dest upper
! inc ebx              ' inc dest
! mov [ebx],al         ' dest lower
! inc ebx              ' inc dest
! dec ecx              ' bcd pair down count
! jge cc               ' } repeat
! mov edx,s            ' restore pointer to base
! mov dword ptr [ebx],0' end marker quad null
' jmp xit1             ' no-formatting test
'----------------------'
'                      ' format:
'      FORMAT          ' remove leading zeros
'                      ' insert decimal point
'                      ' nul byte termination
'                      ' return length of string
'----------------------'
! mov ecx,18           ' number of digits
! add edx,64           ' set up src pointer (base+64)
! mov ebx,edx          ' dest pointer
! add ebx,32           ' (offset= base+96)
                       ' set sign
! mov al, [edx]        ' load src
! inc edx              ' next src
! mov byte ptr [ebx],al'
! inc ebx              ' next dest
'----------------------'
                       ' strip leading zeros
                       '
e1:                    ' do {
                       ' check for decimal point placement
! cmp ecx,d            '
! jnz e11              '
! mov byte ptr [ebx],48' set 0
! inc ebx              ' dest
! jmp wholenum         ' left of decimal place
e11:                   '
! cmp byte ptr [edx],48' is it 0 ?
! jnz wholenum         ' to transfer
!                      ' continuing zero skip loop
! inc edx              ' src
! dec ecx              ' digit down count
! jg e1                '  } repeat
! jmp xit1             ' finish
'----------------------'
wholenum:              '
e2:                    ' { do
!                      ' decimal point test
! cmp ecx,d            '
! jz decimalpt         ' exit for decimal point insertion
! mov al,[edx]         ' transfer byte by byte
! mov [ebx],al         '
! inc edx              ' next src
! inc ebx              ' next dest
! dec ecx              ' digit count down
! jg e2                ' } repeat
! inc ebx              '
! jmp xit1             ' finish
'----------------------'
                       ' decimal point onward
decimalpt:             ' insert decimal point
! mov byte ptr [ebx],46' decimal point ascii 46
! inc ebx              ' next dest
! add ecx,ebx          ' ptr to end of number
! inc ecx              ' offset by 1
e24:                   ' { rapid transfer loop with 4 byte chunks
! mov eax,[edx]        ' src
! mov [ebx],eax        ' store dest incl end null quad
! cmp eax,0            ' was it a null quad?
! jz xit               ' then finish
! add edx,4            ' else next src quad
! add ebx,4            ' and next dest quad
! jmp e24              ' } repeat
'======================'
xit:                   ' finishing procedures
! mov ebx,ecx          ' to get length of number
xit1:                  '
! mov edx,s            '
! cmp byte ptr [edx+97],32 ' check for zero number
! jg nz1               '
! mov byte ptr [edx+97],48
! add ebx,2            '
nz1:                   '
'! mov byte ptr [ebx],&h20  ' set null boundary byte
! sub ebx,s            ' calc offset from beginning of data
! sub ebx,97           '
! mov function,ebx     ' gives length of string (excluding null terminator byte)
'======================'
! mov d,ebx
' local st as string: st=string$(d," ") ' test string loading
END FUNCTION


'--------------------'
'  MAP OF WORKSPACE  '
'--------------------'
'
' 00..08  packed bcd result
' 09      sign of packed bcd result
' 10..11  unused
' 12..15  selected fp multiplier
' 16..59  multiplier lookup table (for decimal point)
' 60 .63  original fpu control word
' 64..67  temp storage for altered fpu control word
' 64..82  unpacked decimal text
' 83..95  unused
' 96..127 formatted number text including null terminating bytes

' length of  number text, excluding terminator is returned by the function.


'--------'
'  MAIN  '
'--------'

FUNCTION PBMAIN()

DIM fv AS EXTENDED    ' value to convert
DIM rs AS STRING  ' workspace
DIM ps AS BYTE PTR    ' pointer to workspace
DIM le AS LONG        ' length of converted number string
DIM ss AS STRING      ' string copy of result
DIM sp AS STRING      ' to display results

' fformat workspce and lookup table
rs=STRING$(128,CHR$(0)): ps=STRPTR(rs)
MID$(rs,17)=MKL$(1)+MKL$(10)+MKL$(1e2)+MKL$(1e3)+MKL$(1e4) _
+MKL$(1e5)+MKL$(1e6)+MKL$(1e7)+MKL$(1e8)+MKL$(1e9)

'Test values '
'fv=-123.63666666666666666666666666
'fv=5.12345678
'fv=-12345678912345678.9
'fv=-1
'fv=0
'fv= -123456789.123456789
fv= -9.00000000000001

le=fformat(fv,14,rs)
ss=MID$(rs,97,le)+$CR+FORMAT$(fv,15)

sp="" _
+ "fformat: "+displayhex(rs)+$CR _
+ ""+$CR _
+ "Result: "+$CR+ss+$CR _
+"length: "+STR$(le)+$CR

'--------------'
'  TIME TRIAL  '
'--------------'

DIM t AS DOUBLE, tf AS DOUBLE, ts AS DOUBLE
DIM i AS LONG
t=TIMER
FOR i=1 TO 1000000
le=fformat(fv,8,rs)
NEXT
tf=TIMER-t

t=TIMER
FOR i=1 TO 1000000
le=LEN(FORMAT$(fv,8))
NEXT
ts=TIMER-t

sp=sp _
+ "speed test using 1000,000 conversions:"+$CR _
+ "fformat "+STR$(tf)+$CR _
+ "format$ "+STR$(ts)+$CR _
+ "Speed factor "+STR$(ts/tf)+$CR _
+ ""

MSGBOX sp


END FUNCTION