Path: ...!eternal-september.org!feeder3.eternal-september.org!i2pn.org!i2pn2.org!.POSTED!not-for-mail
From: dxf <dxforth@gmail.com>
Newsgroups: comp.lang.forth
Subject: Re: (FG.) FG.R (was Re: Bring your Forth to work)
Date: Sat, 8 Mar 2025 12:57:50 +1100
Organization: i2pn2 (i2pn.org)
Message-ID: <932430feaabe2b354e9eabaa0239a520e47b1fde@i2pn2.org>
References: <ea7cb66aa2699a5038e525bff68bb96ace214265@i2pn2.org>
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 7bit
Injection-Date: Sat, 8 Mar 2025 01:57:52 -0000 (UTC)
Injection-Info: i2pn2.org;
	logging-data="3366099"; mail-complaints-to="usenet@i2pn2.org";
	posting-account="XPw7UV90Iy7EOhY4YuUXhpdoEf5Vz7K+BsxA/Cx8bVc";
User-Agent: Mozilla Thunderbird
X-Spam-Checker-Version: SpamAssassin 4.0.0
In-Reply-To: <ea7cb66aa2699a5038e525bff68bb96ace214265@i2pn2.org>
Content-Language: en-GB
Bytes: 2997
Lines: 55

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