libs/dbl-parse.f

   1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   2 ;; UrForth level 1: self-hosting 32-bit Forth compiler
   3 ;; Copyright (C) 2020 Ketmar Dark // Invisible Vector
   4 ;; GPLv3 ONLY
   5 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   6 ;; supports base prefixes, but not DPL
   7 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   8
   9 ;; convert a character string left at addr to a signed number, using the current numeric base
  10 : NUMBER-DBL  ( addr count -- ud 1 // d -1 // addr count false )
  11   ;; check length
  12   dup 0<= if false exit endif
  13   2dup 2>r  ;; for failure exit
  14   ;; ok, we have at least one valid char
  15   number-parse-pfx-sfx-sign
  16   base @ >r ?dup if base ! endif
  17   nrot ;; ( negflag addr count )
  18   ;; zero count means "nan"
  19   dup 0> ifnot  ;; no number chars besides a prefix
  20     r> base !   ;; restore base
  21     2drop drop 2r> false exit  ;; exit with failure
  22   endif
  23   ;; ( negflag addr count | oldbase )
  24   0 u>d 2swap >number  ;; ( negflag ud addr count | oldbase )
  25   ?dup ifnot  ;; no more chars
  26     r> base !  2drop
  27     swap if negate endif
  28     2rdrop true
  29   else  ;; have some more chars
  30     over c@ [char] . = ifnot r> base ! 2drop 2drop 2r> false exit endif
  31     /char >number r> base !  ;; ( negflag ud addr count )
  32     if 2drop 2drop 2r> false exit endif  ;; too many chars
  33     drop rot if dnegate endif
  34     2rdrop -1
  35   endif
  36 ;
  37
  38 ..: interpret-not-found  ( addr count -- true // addr count false )
  39   number-dbl dup if
  40     state @ if
  41       -if swap [compile] literal endif [compile] literal
  42     else drop endif
  43     true exit
  44   endif
  45 ;..