home bbs files messages ]

Forums before death by AOL, social media and spammers... "We can't have nice things"

   comp.lang.forth      Forth programmers eat a lot of Bratwurst      117,927 messages   

[   << oldest   |   < older   |   list   |   newer >   |   newest >>   ]

   Message 117,126 of 117,927   
   dxf to dxf   
   (FG.) FG.R (was Re: Bring your Forth to    
   07 Mar 25 12:43:32   
   
   From: dxforth@gmail.com   
      
   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   
      
   --- SoupGate-DOS v1.05   
    * Origin: you cannot sedate... all the things you hate (1:229/2)   

[   << oldest   |   < older   |   list   |   newer >   |   newest >>   ]


(c) 1994,  bbs@darkrealms.ca