From Newsgroup: comp.lang.forth

Thunderbird wouldn't let me modify subject line, hence new thread...

On 6/03/2025 10:17 am, dxf wrote:

On 6/03/2025 6:46 am, Buzz McCool wrote:

...

Thanks for posting the code and printout! I'm always keen to test out
my f/p output functions to see whether I'm able to duplicate that of
others.

Turns out I needed a new function to duplicate the output. I must have
run into the same issue before as a decade ago I defined FG.R etc which simulates Fortran's 'G' format output. The original had some quirks so
I've taken the opportunity to update it.

\ Public domain

\ Assumes both '.' and 'E' are present (NAN/INFs excepted)
\ (FS.) ( r n -- a u ) cvt r to string in sci notation to n dec. places

\ Misc tools
\ SCAN ( a u char -- a2 u2 ) common usage
: (NUMBER) ( a u -- ud a' u' ) 0 0 2swap >number ;
: /SIGN ( a u -- a' u' f ) \ skip leading sign if exists
dup if over c@ dup [char] + = swap [char] - =
dup >r or negate /string r> exit then 0 ;
: /NUMBER ( a u -- a' u' d|ud )
/sign >r (number) 2swap r> if dnegate then ;
: CSKIP 1 /string ;
: 2NIP 2swap 2drop ;
: S.R ( a u wid -- ) over - spaces type ;

\ Main

0 value d 0 value e \ location of '.' 'E'

\ Convert real number r to string with n digits of precision.
\ Use fixed-point if exponent -1 to n or scientific otherwise.
: (FG.) ( r n -- c-addr u )
1 max 1- (fs.) 2dup [char] . scan dup if ( not nan/inf)
over to d [char] E scan over dup to e d - >r cskip
/number 2nip d>s dup -1 r@ within if ( fixed-point)
>r [char] . d dup r@ 0< 2* 1+ + over r@ abs move
r@ + c! ( a u) drop e over - ( trim) r>
then r>
then 2drop ;

\ Print right-justified
: FG.R ( r n u -- ) >r (fg.) r> s.r ;

\ behead d e

\ End

\ Mods to Buzz' CounterOutput:

: printf 5 swap fg.r ;

\ Change all instances of '9 PRINTF' to '11 PRINTF'

32.768E3 Hz Clock Input
1 Bit 16384. Hz 6.1035E-05 Sec 1.0173E-06 Min 1.6954E-08 Hour 7.0643E-10 Day
2 Bit 8192.0 Hz 1.2207E-04 Sec 2.0345E-06 Min 3.3908E-08 Hour 1.4129E-09 Day
3 Bit 4096.0 Hz 2.4414E-04 Sec 4.0690E-06 Min 6.7817E-08 Hour 2.8257E-09 Day
4 Bit 2048.0 Hz 4.8828E-04 Sec 8.1380E-06 Min 1.3563E-07 Hour 5.6514E-09 Day
5 Bit 1024.0 Hz 9.7656E-04 Sec 1.6276E-05 Min 2.7127E-07 Hour 1.1303E-08 Day
6 Bit 512.00 Hz 1.9531E-03 Sec 3.2552E-05 Min 5.4253E-07 Hour 2.2606E-08 Day
7 Bit 256.00 Hz 3.9063E-03 Sec 6.5104E-05 Min 1.0851E-06 Hour 4.5211E-08 Day
8 Bit 128.00 Hz 7.8125E-03 Sec 1.3021E-04 Min 2.1701E-06 Hour 9.0422E-08 Day
9 Bit 64.000 Hz 1.5625E-02 Sec 2.6042E-04 Min 4.3403E-06 Hour 1.8084E-07 Day
10 Bit 32.000 Hz 3.1250E-02 Sec 5.2083E-04 Min 8.6806E-06 Hour 3.6169E-07 Day
11 Bit 16.000 Hz 6.2500E-02 Sec 1.0417E-03 Min 1.7361E-05 Hour 7.2338E-07 Day
12 Bit 8.0000 Hz .12500 Sec 2.0833E-03 Min 3.4722E-05 Hour 1.4468E-06 Day
13 Bit 4.0000 Hz .25000 Sec 4.1667E-03 Min 6.9444E-05 Hour 2.8935E-06 Day
14 Bit 2.0000 Hz .50000 Sec 8.3333E-03 Min 1.3889E-04 Hour 5.7870E-06 Day
15 Bit 1.0000 Hz 1.0000 Sec 1.6667E-02 Min 2.7778E-04 Hour 1.1574E-05 Day
16 Bit .50000 Hz 2.0000 Sec 3.3333E-02 Min 5.5556E-04 Hour 2.3148E-05 Day
17 Bit .25000 Hz 4.0000 Sec 6.6667E-02 Min 1.1111E-03 Hour 4.6296E-05 Day
18 Bit .12500 Hz 8.0000 Sec .13333 Min 2.2222E-03 Hour 9.2593E-05 Day
19 Bit 6.2500E-02 Hz 16.000 Sec .26667 Min 4.4444E-03 Hour 1.8519E-04 Day
20 Bit 3.1250E-02 Hz 32.000 Sec .53333 Min 8.8889E-03 Hour 3.7037E-04 Day
21 Bit 1.5625E-02 Hz 64.000 Sec 1.0667 Min 1.7778E-02 Hour 7.4074E-04 Day
22 Bit 7.8125E-03 Hz 128.00 Sec 2.1333 Min 3.5556E-02 Hour 1.4815E-03 Day
23 Bit 3.9063E-03 Hz 256.00 Sec 4.2667 Min 7.1111E-02 Hour 2.9630E-03 Day
24 Bit 1.9531E-03 Hz 512.00 Sec 8.5333 Min .14222 Hour 5.9259E-03 Day
25 Bit 9.7656E-04 Hz 1024.0 Sec 17.067 Min .28444 Hour 1.1852E-02 Day
26 Bit 4.8828E-04 Hz 2048.0 Sec 34.133 Min .56889 Hour 2.3704E-02 Day
27 Bit 2.4414E-04 Hz 4096.0 Sec 68.267 Min 1.1378 Hour 4.7407E-02 Day
28 Bit 1.2207E-04 Hz 8192.0 Sec 136.53 Min 2.2756 Hour 9.4815E-02 Day
29 Bit 6.1035E-05 Hz 16384. Sec 273.07 Min 4.5511 Hour .18963 Day
30 Bit 3.0518E-05 Hz 32768. Sec 546.13 Min 9.1022 Hour .37926 Day
31 Bit 1.5259E-05 Hz 65536. Sec 1092.3 Min 18.204 Hour .75852 Day
32 Bit 7.6294E-06 Hz 1.3107E+05 Sec 2184.5 Min 36.409 Hour 1.5170 Day
33 Bit 3.8147E-06 Hz 2.6214E+05 Sec 4369.1 Min 72.818 Hour 3.0341 Day
34 Bit 1.9073E-06 Hz 5.2429E+05 Sec 8738.1 Min 145.64 Hour 6.0681 Day
35 Bit 9.5367E-07 Hz 1.0486E+06 Sec 17476. Min 291.27 Hour 12.136 Day

--- Synchronet 3.20c-Linux NewsLink 1.2

From Newsgroup: comp.lang.forth

On 7/03/2025 12:43 pm, dxf wrote:

...
Turns out I needed a new function to duplicate the output. I must have
run into the same issue before as a decade ago I defined FG.R etc which simulates Fortran's 'G' format output. The original had some quirks so
I've taken the opportunity to update it.
...

A slightly improved version that avoids a calculation. The latter
was always superfluous but I couldn't see a way of removing it without increasing code elsewhere ... until now. Also removed is the '1 MAX'
since 'zero significant digits' represents an ambiguous condition.

\ Purpose: derive a floating-point output function with
\ characteristics similar to Fortran's 'G' format. Useful
\ for displaying tables of formatted results.
\
\ Assumes the function:
\ (FS.) ( r n -- a u )
\ Convert r to a string a u in scientific notation to n
\ decimal places. Both '.' and 'E' must be present in the
\ returned string (NAN/INFs excepted).
\
\ Public domain (no warranty)

\ Misc tools
\ SCAN ( a u char -- a2 u2 ) common usage
: (NUMBER) ( a u -- ud a' u' ) 0 0 2swap >number ;
: /SIGN ( a u -- a' u' f ) \ skip leading sign if exists
dup if over c@ dup [char] + = swap [char] - =
dup >r or negate /string r> exit then 0 ;
: /NUMBER ( a u -- a' u' d|ud )
/sign >r (number) 2swap r> if dnegate then ;
: CSKIP 1 /string ;
: 2NIP 2swap 2drop ;
: S.R ( a u wid -- ) over - spaces type ;

\ Main

0 value d 0 value e \ location of '.' 'E'

\ Convert real number r to string with n digits of precision.
\ Use fixed-point if exponent -1 to n or scientific otherwise.
: (FG.) ( r n -- c-addr u )
dup >r 1- (fs.) 2dup [char] . scan ?dup if ( not nan/inf)
over to d [char] E scan over to e cskip
/number 2nip d>s dup -1 r@ within if ( fixed-point)
>r [char] . d dup r@ 0< 2* 1+ + over r@ abs move
r@ + c! ( a u) drop e over - r>
then
then r> 2drop ;

: FG.R ( r n u -- ) >r (fg.) r> s.r ; \ print right-justified

\ behead d e

--- Synchronet 3.20c-Linux NewsLink 1.2

From Newsgroup: comp.lang.forth

On 08-03-2025 02:57, dxf wrote:
Ed, as usual - thank you!
Of course, I had to iron out the /STRING and BOOL tricks - but I
managed. ;-)

BTW, I call ( a n -- a+1 n-1) CHOP and ( a n -- a n-1) CLIP. They're
dear and well respected friends of mine. I rarely use /STRING myself.

Hans Bezemer

On 7/03/2025 12:43 pm, dxf wrote:

...
Turns out I needed a new function to duplicate the output. I must have
run into the same issue before as a decade ago I defined FG.R etc which
simulates Fortran's 'G' format output. The original had some quirks so
I've taken the opportunity to update it.
...

A slightly improved version that avoids a calculation. The latter
was always superfluous but I couldn't see a way of removing it without increasing code elsewhere ... until now. Also removed is the '1 MAX'
since 'zero significant digits' represents an ambiguous condition.

\ Purpose: derive a floating-point output function with
\ characteristics similar to Fortran's 'G' format. Useful
\ for displaying tables of formatted results.
\
\ Assumes the function:
\ (FS.) ( r n -- a u )
\ Convert r to a string a u in scientific notation to n
\ decimal places. Both '.' and 'E' must be present in the
\ returned string (NAN/INFs excepted).
\
\ Public domain (no warranty)

\ Misc tools
\ SCAN ( a u char -- a2 u2 ) common usage
: (NUMBER) ( a u -- ud a' u' ) 0 0 2swap >number ;
: /SIGN ( a u -- a' u' f ) \ skip leading sign if exists
dup if over c@ dup [char] + = swap [char] - =
dup >r or negate /string r> exit then 0 ;
: /NUMBER ( a u -- a' u' d|ud )
/sign >r (number) 2swap r> if dnegate then ;
: CSKIP 1 /string ;
: 2NIP 2swap 2drop ;
: S.R ( a u wid -- ) over - spaces type ;

\ Main

0 value d 0 value e \ location of '.' 'E'

\ Convert real number r to string with n digits of precision.
\ Use fixed-point if exponent -1 to n or scientific otherwise.
: (FG.) ( r n -- c-addr u )
dup >r 1- (fs.) 2dup [char] . scan ?dup if ( not nan/inf)
over to d [char] E scan over to e cskip
/number 2nip d>s dup -1 r@ within if ( fixed-point)
>r [char] . d dup r@ 0< 2* 1+ + over r@ abs move
r@ + c! ( a u) drop e over - r>
then
then r> 2drop ;

: FG.R ( r n u -- ) >r (fg.) r> s.r ; \ print right-justified

\ behead d e

--- Synchronet 3.20c-Linux NewsLink 1.2

From Newsgroup: comp.lang.forth

On 9/03/2025 5:02 am, Hans Bezemer wrote:

On 08-03-2025 02:57, dxf wrote:
Ed, as usual - thank you!
Of course, I had to iron out the /STRING and BOOL tricks - but I managed. ;-)

BTW, I call ( a n -- a+1 n-1) CHOP and ( a n -- a n-1) CLIP. They're dear and well respected friends of mine. I rarely use /STRING myself.

One more without the temps to show anyone can write forth.
(Just don't ask me to explain it :)

\ Convert real number r to string with n digits of precision.
\ Use fixed-point if exponent -1 to n or scientific otherwise.
: (FG.) ( r n -- c-addr u )
dup >r 1- (fs.) 2dup [char] . scan ?dup if ( not nan/inf)
over swap [char] E scan over swap cskip
/number 2nip d>s dup -1 r@ within if ( fixed-point)
>r [char] . rot dup r@ 0< 2* 1+ + over r@ abs move
r> + c! nip over - r> drop exit
then 2drop
then r> 2drop ;

--- Synchronet 3.20c-Linux NewsLink 1.2