Forums before death by AOL, social media and spammers... "We can't have nice things"
|    comp.lang.forth    |    Forth programmers eat a lot of Bratwurst    |    117,927 messages    |
[   << oldest   |   < older   |   list   |   newer >   |   newest >>   ]
|    Message 117,635 of 117,927    |
|    dxf to All    |
|    Replacement F/P output for SwiftForth 4    |
|    25 Oct 25 19:41:13    |
      From: dxforth@gmail.com              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              --- SoupGate-Win32 v1.05        * Origin: you cannot sedate... all the things you hate (1:229/2)    |
[   << oldest   |   < older   |   list   |   newer >   |   newest >>   ]
(c) 1994, bbs@darkrealms.ca