Path: ...!eternal-september.org!feeder3.eternal-september.org!i2pn.org!i2pn2.org!.POSTED!not-for-mail From: dxf 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: 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: 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