\ safe 98.10.23 3:58 pm NAB
\ An elective adding error-checking
\ for a number of common errors.

decimal
: unique  variable ;

unique colon-tag

: matchtag  rot <>  -22 and throw ;

: ;;  postpone ;  ; immediate

: ;   colon-tag matchtag
  postpone ;  ; immediate

: :noname colon-tag :noname ;;
: :  colon-tag  :  ;;

: compiletime ( xt "name" --)
  create ,  does>
  @ >r  begin
  >in @  dup  source nip  < while
    >r  :  r> >in !  r@ compile,
      postpone postpone
    postpone ;  immediate
  repeat r> 2drop ;

: anytime ( xt "name" --)
  create ,  does>
  @ >r  begin
  >in @  dup  source nip  < while
    >r  :  r> >in !  r@ compile,
    ' compile,
    postpone ;
  repeat  r> 2drop ;

: comp?  state @ 0=  -14 and throw ;

: checkaddr
  dup  1 and  over -32768  and  or
  0 <> -9 and throw ;

: check0  dup 0= -10 and throw ;

: checkbase
  base @  dup 2 <  swap  36 > or
  abort" ? Base out of range 2..36" ;

' comp? compiletime comp:
' checkbase anytime base:
' checkaddr anytime addr:
' check0 anytime zero:

comp: +loop ; ." abort" begin do
comp: does> else exit i if j leave
comp: literal loop postpone r> >r r@
comp: recurse repeat s" then
comp: until while [ ['] [char] a0 d0

base: >number <# . d.r u.

addr: ! @ 2@ 2!

zero: / mod /mod fm/mod sm/rem
zero: um/mod