(FG.) FG.R (was Re: Bring your Forth to work)

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