\ 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