version 1.24, 2003/01/22 17:12:49

version 1.30, 2003/02/03 08:59:29

Line 129 AUser CSP

Line 129 AUser CSP

repeat 
repeat 
 + dup >r resize throw r> ; 
 + dup >r resize throw r> ; 



\ ]] ... [[ 



: compileliteral ( n  ) 

postpone literal ; 



: [[ (  ) 

\G switch from postpone state to compile state 

\ this is only a marker; it is never really interpreted 

compileonlyerror ; immediate 



: postponer ( caddr u  ) 

2dup findname dup if ( caddr u nt ) 

nip nip name>comp 

2dup [comp'] [[ d= if 

2drop ['] compiler is parser 

else 

postpone, 

endif 

else 

drop 

2dup snumber? dup if 

0> IF 

swap postpone literal postpone compileliteral 

THEN 

postpone Literal postpone compileliteral 

2drop 

ELSE 

drop no.extensions 

THEN 

then ; 



: ]] (  ) 

\ switch into postpone state 

['] postponer is parser state on ; immediate restrict 



\ f.rdp 



: pushright ( caddr u1 u2 cfill  ) 

\ move string at caddr u1 right by u2 chars (without exceeding 

\ the original bound); fill the gap with cfill 

>r over min dup >r rot dup >r ( u1 u2 caddr R: cfill u2 caddr ) 

dup 2swap /string cmove> 

r> r> r> fill ; 



: f>bufrdptry { f: rf caddr ur nd up um1  um2 } 

\ um1 is the mantissa length to try, um2 is the actual mantissa length 

caddr ur um1 /string '0 fill 

rf caddr um1 represent if { nexp fsign } 

nd nexp + up >= 

ur nd  1 dup { beforep } fsign + nexp 0 max >= and if 

\ fixedpoint notation 

caddr ur beforep nexp  dup { befored } '0 pushright 

caddr beforep 1 befored min dup { beforez } 0 max bl fill 

fsign if 

' caddr beforez 1 0 max + c! 

endif 

caddr ur beforep /string 1 '. pushright 

nexp nd + 

else \ exponential notation 

caddr ur 1 /string 1 '. pushright 

fsign if 

caddr ur 1 ' pushright 

endif 

nexp 1 s>d tuck dabs <<# #s rot sign 'E hold #> { explen } 

ur explen  1 fsign + { mantlen } 

mantlen 0< if \ exponent too large 

drop caddr ur '* fill 

else 

caddr ur + 0 explen negate /string move 

endif 

#>> mantlen 

endif 

else \ inf or nan 

if \ negative 

caddr ur 1 ' pushright 

endif 

drop ur 

\ !! align in some way? 

endif 

1 max ur min ; 



: f>bufrdp ( rf caddr +nr +nd +np  ) \ gforth 

\G Convert @i{rf} into a string at @i{caddr nr}. The conversion 

\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>bufrdptry f>bufrdptry drop ; 



: f>strrdp ( rf +nr +nd +np  caddr nr ) \ gforth 

\G Convert @i{rf} into a string at @i{caddr 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 and will be destroyed by anything destroying that buffer. 

rot holdptr @ 1 0 rot negate /string ( rf +nd np caddr nr ) 

over holdbuf u< &17 and throw 

2tuck 2>r f>bufrdp 2r> ; 



: f.rdp ( rf +nr +nd +np  ) \ gforth 

\G Print float @i{rf} formatted. The total width of the output is 

\G @i{nr}. For fixedpoint notation, the number of digits after the 

\G decimal point is @i{+nd} and the minimum number of significant 

\G digits is @i{np}. @code{Setprecision} has no effect on 

\G @code{f.rdp}. Fixedpoint notation is used if the number of 

\G siginicant digits would be at least @i{np} and if the number of 

\G digits before the decimal point would fit. If fixedpoint notation 

\G is not used, exponential notation is used, and if that does not 

\G fit, asterisks are printed. We recommend using @i{nr}>=7 to avoid 

\G the risk of numbers not fitting at all. We recommend 

\G @i{nr}>=@i{np}+5 to avoid cases where @code{f.rdp} switches to 

\G exponential notation because fixedpoint notation would have too 

\G few significant digits, yet exponential notation offers fewer 

\G significant digits. We recommend @i{nr}>=@i{nd}+2, if you want to 

\G have fixedpoint notation for some numbers. We recommend 

\G @i{np}>@i{nr}, if you want to have exponential notation for all 

\G numbers. 

f>strrdp type ; 



0 [if] 

: testx ( rf ur nd up  ) 

' emit f.rdp ; 



: test (  ) 

0.123456789123456789e20 

40 0 ?do 

cr 

fdup 7 3 1 testx 

fdup 7 3 4 testx 

fdup 7 3 0 testx 

fdup 7 7 1 testx 

fdup 7 5 1 testx 

fdup 7 0 2 testx 

fdup 5 2 1 testx 

fdup 4 2 1 testx 

fdup 18 8 5 testx 

' emit 

10e f* 

loop ; 

[then] 