home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Tools / Languages / Yerk 3.6.6 / Float source / fInterpret < prev    next >
Encoding:
Text File  |  1993-12-27  |  2.1 KB  |  51 lines  |  [TEXT/YERK]
  1. lt t OR f) \ Attempts to convert token at addr to a float.
  2. : fnumber  { addr -- flt t OR f }
  3.     addr scan IF addr atof: floati/o ELSE false THEN ;
  4.  
  5. \ Write a float into dictionary: analogous to , or c, .
  6. \ ( flt -- )
  7. \ : f,   dup 2+ here 10 cmove 10 allot fdrop    ;
  8.  
  9. ( b flt -- )      \ Compiles an in-line float 
  10. : fLiteral  state IF compile flit f, ELSE swap THEN   ; immediate
  11.  
  12.  
  13. ( -- b) \ True means string at here is a float.
  14. : fFind     here fnumber dup          
  15.             IF  swap [compile] fLiteral THEN   ; 
  16.  
  17. ( -- )      \ Adds ability to interpret floats to INTERPRET.
  18. : fInterpret
  19.         BEGIN find
  20.               IF    state  <
  21.                     IF  cfa ,  ELSE cfa execute THEN
  22.                ELSE  fFind not           \ fFind returns true if float found.
  23.                     IF  here number dpl 1+
  24.                         IF      [compile] dliteral
  25.                         ELSE    drop [compile] literal
  26.                         THEN
  27.                     THEN
  28.               THEN  ?stack ?dp
  29.         AGAIN   ;
  30.  
  31. \ store this word in OBJINIT to start up with float enabled
  32. : FPinit   init: floatI/O init: fltMem ;
  33.  
  34. \ new error handler for use with floating point extensions
  35. : cleanFloat  clean2  init: fltMem  ;
  36.  
  37. \ Install finterpret as the new INTERPRET.
  38. : yerk>flt  'c finterpret -> interpret
  39.             'c cleanFloat -> abortVec ;
  40.  
  41. \ Install INTERPRET in nucleus, disabling floating-pt parsing
  42. : yerk>int  0 -> interpret
  43.             'c yerk -> objInit
  44.             'c clean2 -> abortVec ;
  45.  
  46. yerk>flt
  47.  
  48. 0. fvalue fpmodel
  49.  
  50. 'code fpmodel -> fvalcode       \ patch value in Args file
  51.