From Newsgroup: comp.lang.forth

Download from:

https://drive.google.com/drive/folders/1kh2WcPUc3hQpLcz7TQ-YQiowrozvxfGw

File: SF4FPOUT.F

Documentation is in the source file.


What can be done with it? That's up to you. I've used the following
in an application.


\ Trim trailing chars from string. Factor of -TRAILING.
: TRIM ( a u1 char -- a u2 )
>R BEGIN DUP WHILE 1- 2DUP CHARS + C@ R@ - UNTIL
1+ THEN R> DROP ;

\ Skip leading sign if exists; leave true if negative
: /SIGN ( a u -- a' u' f )
DUP IF OVER C@ DUP [CHAR] + = SWAP [CHAR] - =
DUP >R OR NEGATE /STRING R> EXIT THEN 0 ;

\ Convert string to double number; stop at invalid char
: /NUMBER ( a u -- a' u' d|ud )
/SIGN >R 0 0 2SWAP >NUMBER 2SWAP R> IF DNEGATE THEN ;

\ Convert string to integer; no checks
: >INT ( a u -- n|u ) /NUMBER 2NIP DROP ;


\ Display r using SI notation

-? CREATE SI CHAR y C, CHAR z C, CHAR a C, CHAR f C,
CHAR p C, CHAR n C, CHAR u C, CHAR m C, CHAR _ C,
CHAR k C, CHAR M C, CHAR G C, CHAR T C, CHAR P C,
CHAR E C, CHAR Z C, CHAR Y C,

\ Convert r to string in engineering notation with SI prefix
: (ENG.) ( r prec 0|1 -- adr len ) \ 0|1 prefix spacing
>R PRECISION FDP @ 2>R ( save) FDP OFF SET-PRECISION
-1 (FE.) ( a u) 2R> FDP ! SET-PRECISION ( restore)
2DUP [CHAR] E SCAN DUP IF ( not NAN/INF)
2DUP 1 /STRING >INT #24 + 3 / DUP 0 #17 WITHIN IF ( SI)
SI + C@ -ROT OVER SWAP BLANK R> + C!
-TRAILING [CHAR] _ TRIM EXIT
THEN DROP
THEN 2DROP R> DROP ;


: TEST ( -- )
cr cr ." (ENG.) ..." cr
2e-4 3e f/ 3 1 (eng.) cr type
2e-4 3e f/ 3 0 (eng.) cr type
2e8 3e f/ 3 0 (eng.) cr type
2e-99 3e f/ 3 0 (eng.) cr type ." ... out of SI range"
1e 0e f/ 3 0 (eng.) cr type ." ... not finite number"
;

test

\\

(ENG.) ...

66.7 u
66.7u
66.7M
667E-102 ... out of SI range
+Inf ... not finite number ok

--- Synchronet 3.21a-Linux NewsLink 1.2