Forth NUMBER Implementation

.: set  s1 or! ;
.: clr  not s1 and! ;
.: bits  s1 @ and ;
.: set?  dup bits = ;
.: clr?  bits 0= ;
.: test  clr? swap set? and ;
.: assert  test 0>; 3 err [
.: set!  0 over assert or set ;

.: fwd  s3 1+! ;
.: peek  s3 @ c@ ;
.: get  fwd peek ;

: number  frame { 0 pre digits post 4 } ;
.: frame  0 wbuf 1+ 0 0 10 ;

.: pre  peek -? x? b? >digit ;
.: -?  45 .!=; drop 0 2 set! get ;
.: x?  120 .!=; 16 !: ;;
.: b?  98 .!=; two, colonbam, dosem2
.: :!  nip base! 58 need ;
.: need  get =; 1 err [

.: base!  1>? s0 ! 0 120 set ;
.: 1>?  1 .u>; 6 err [

.: digits  get \0?; handle me [
.: \0?;  ?dup 0=;; ;
.: handle  :? .? e? >digit ;
.: :?  58 .!=; drop base! 0 ;;
.: .?  46 .!=; drop 0 81 set! ;;
.: e?  101 .!=; post 0 64 36 set! ;;

.: post  neg? 2 clr final ;
.: neg?  2 set? 0=; negate ;
.: final  exp?; s4 ! ;
.: exp?;  5 clr? 0>; 5 err [

.: >digit  (digit) case? valid? absorb ;
.: (digit)  0-9? A-Z? a-z? 2 err
.: 0-9?  48 - 10 .u<;; ;
.: A-Z?  7 - 36 .u<;; ;
.: a-z?  6 - 62 .u<;; ;
.: case?  s0 @ 36 u>; 27 .u<; 26 - ;
.: valid?  s0 @ .u<; 2 err [
.: +dp?  1 bits and s2 +! ;
.: absorb  swap s0 @ * + +dp? ;