home bbs files messages ]

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