[BACK]Return to stuff.fs CVS log [TXT] [DIR] Up to [gforth] / gforth

Diff for /gforth/stuff.fs between versions 1.26 and 1.29

version 1.26, 2003/01/24 22:03:20 version 1.29, 2003/01/26 20:56:37
Line 166  AUser CSP Line 166  AUser CSP
   
 \ f.rdp  \ f.rdp
   
 : move-right ( c-addr u1 u2 cfill -- )  : push-right ( c-addr u1 u2 cfill -- )
     \ move string at c-addr u1 right by u2 chars (without exceeding      \ move string at c-addr u1 right by u2 chars (without exceeding
     \ the original bound); fill the gap with cfill      \ the original bound); fill the gap with cfill
     >r dup >r rot dup >r ( u1 u2 c-addr R: cfill u2 c-addr )      >r over min dup >r rot dup >r ( u1 u2 c-addr R: cfill u2 c-addr )
     dup 2swap /string cmove>      dup 2swap /string cmove>
     r> r> r> fill ;      r> r> r> fill ;
   
 : f>buf-rdp { f: rf c-addr ur nd up -- } \ gforth  : f>buf-rdp-try { f: rf c-addr ur nd up um1 -- um2 }
 \G Convert @i{rf} into a string at @i{c-addr ur}.  The conversion      \ um1 is the mantissa length to try, um2 is the actual mantissa length
 \G rules and the meanings of @i{ur nd up} are the same as for      c-addr ur um1 /string '0 fill
 \G @code{f.rdp}.      rf c-addr um1 represent if { nexp fsign }
     rf c-addr ur represent if { nexp fsign }  
         nd nexp + up >=          nd nexp + up >=
         ur nd - 1- dup { beforep } fsign + nexp 0 max >= and if          ur nd - 1- dup { beforep } fsign + nexp 0 max >= and if
             \ fixed-point notation              \ fixed-point notation
             c-addr ur beforep nexp - dup { befored } '0 move-right              c-addr ur beforep nexp - dup { befored } '0 push-right
             c-addr beforep 1- befored min dup { beforez } 0 max bl fill              c-addr beforep 1- befored min dup { beforez } 0 max bl fill
             fsign if              fsign if
                 '- c-addr beforez 1- 0 max + c!                  '- c-addr beforez 1- 0 max + c!
             endif              endif
             c-addr ur beforep /string 1 '. move-right              c-addr ur beforep /string 1 '. push-right
               nexp nd +
         else \ exponential notation          else \ exponential notation
             c-addr ur 1 /string 1 '. move-right              c-addr ur 1 /string 1 '. push-right
             fsign if              fsign if
                 c-addr ur 1 '- move-right                  c-addr ur 1 '- push-right
             endif              endif
             nexp 1- s>d tuck dabs <<# #s rot sign 'E hold #> { explen }              nexp 1- s>d tuck dabs <<# #s rot sign 'E hold #> { explen }
             explen 1+ fsign - ur > if \ exponent too large              ur explen - 1- fsign + { mantlen }
               mantlen 0< if \ exponent too large
                 drop c-addr ur '* fill                  drop c-addr ur '* fill
             else              else
                 c-addr ur + 0 explen negate /string move                  c-addr ur + 0 explen negate /string move
             endif              endif
             #>>              #>> mantlen
         endif          endif
     else \ inf or nan      else \ inf or nan
         if \ negative          if \ negative
             c-addr ur 1 '- move-right              c-addr ur 1 '- push-right
         endif          endif
         drop          drop ur
         \ !! align in some way?          \ !! align in some way?
     endif ;      endif
       1 max ur min ;
   
 : f>str-rdp ( rf ur +nd up -- c-addr ur ) \ gforth  : f>buf-rdp ( rf c-addr +nr +nd +np -- ) \ gforth
 \G Convert @i{rf} into a string at @i{c-addr ur}.  The conversion  \G Convert @i{rf} into a string at @i{c-addr nr}.  The conversion
 \G rules and the meanings of @i{ur +nd up} are the same as for  \G rules and the meanings of @i{nr nd np} are the same as for
   \G @code{f.rdp}.
       \ first, get the mantissa length, then convert for real.  The
       \ mantissa length is wrong in a few cases because of different
       \ rounding; In most cases this does not matter, because the
       \ mantissa is shorter than expected and the final digits are 0;
       \ but in a few cases the mantissa gets longer.  Then it is
       \ conceivable that you will see a result that is rounded too much.
       \ However, I have not been able to construct an example where this
       \ leads to an unexpected result.
       swap 0 max swap 0 max
       fdup 2over 2over 2 pick f>buf-rdp-try f>buf-rdp-try drop ;
   
   : f>str-rdp ( rf +nr +nd +np -- c-addr nr ) \ gforth
   \G Convert @i{rf} into a string at @i{c-addr nr}.  The conversion
   \G rules and the meanings of @i{nr +nd np} are the same as for
 \G @code{f.rdp}.  The result in in the pictured numeric output buffer  \G @code{f.rdp}.  The result in in the pictured numeric output buffer
 \G and will be destroyed by anything destroying that buffer.  \G and will be destroyed by anything destroying that buffer.
     rot holdptr @ 1- 0 rot negate /string ( rf +nd up c-addr ur )      rot holdptr @ 1- 0 rot negate /string ( rf +nd np c-addr nr )
     over holdbuf u< -&17 and throw      over holdbuf u< -&17 and throw
     2tuck 2>r f>buf-rdp 2r> ;      2tuck 2>r f>buf-rdp 2r> ;
   
 : f.rdp ( rf ur +nd up -- ) \ gforth  : f.rdp ( rf +nr +nd +np -- ) \ gforth
 \G Print float @i{rf} formatted.  The total width of the output is  \G Print float @i{rf} formatted.  The total width of the output is
 \G @i{nr}, the number of digits after the decimal point is @i{+nd},  \G @i{nr}, the number of digits after the decimal point is @i{+nd},
 \G the minimum number of significant digits for fixed-point notation  \G the minimum number of significant digits for fixed-point notation
 \G is @i{up}.  @code{Set-precision} has no effect on @code{f.rdp}.  \G is @i{np}.  @code{Set-precision} has no effect on @code{f.rdp}.
 \G Fixed-point notation is used if the number of siginicant digits  \G Fixed-point notation is used if the number of siginicant digits
 \G would be larger than @i{up} and if the number of digits before the  \G would be at least @i{np} and if the number of digits before the
 \G decimal point would fit.  If fixed-point notation is not used,  \G decimal point would fit.  If fixed-point notation is not used,
 \G exponential notation is used, and if that does not fit, asterisks  \G exponential notation is used, and if that does not fit, asterisks
 \G are printed.  We recommend using @i{ur}>=7 to avoid the risk of  \G are printed.  We recommend using @i{nr}>=7 to avoid the risk of
 \G numbers not fitting at all.  We recommend @i{ur}>=@i{up}+5 to avoid  \G numbers not fitting at all.  We recommend @i{nr}>=@i{np}+5 to avoid
 \G cases where @code{f.rdp} switches to exponential notation because  \G cases where @code{f.rdp} switches to exponential notation because
 \G fixed-point notation would have too few significant digits, yet  \G fixed-point notation would have too few significant digits, yet
 \G exponential notation offers fewer significant digits.  We recomment  \G exponential notation offers fewer significant digits.  We recommend
 \G @i{ur}>=@i{nd}+2, if you want to have fixed-point notation for some  \G @i{nr}>=@i{nd}+2, if you want to have fixed-point notation for some
 \G numbers.  Currently, trailing digits are cut off.  \G numbers.  We recommend @i{np}>@i{nr}, if you want to have
   \G exponential notation for all numbers.
     f>str-rdp type ;      f>str-rdp type ;
   
 0 [if]  0 [if]
Removed from v.1.26  
changed lines
  Added in v.1.29

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>