| |
|
| \ !! factor out line number printing, share with debugging.fs |
\ !! factor out line number printing, share with debugging.fs |
| |
|
| variable assert-level \ all assertions above this level are turned off |
variable assert-level ( -- a-addr ) \ new |
| |
\G all assertions above this level are turned off |
| 1 assert-level ! |
1 assert-level ! |
| |
|
| : assertn ( n -- ) |
: assertn ( n -- ) \ new |
| \ this is internal (it is not immediate) |
\ this is internal (it is not immediate) |
| assert-level @ > |
assert-level @ > |
| if |
if |
| POSTPONE ( |
POSTPONE ( |
| then ; |
then ; |
| |
|
| : assert0( ( -- ) |
: assert0( ( -- ) \ new |
| \ important assertions that should always be turned on |
\G important assertions that should always be turned on |
| 0 assertn ; immediate |
0 assertn ; immediate |
| : assert1( ( -- ) |
: assert1( ( -- ) \ new |
| \ normal assertions; turned on by default |
\G normal assertions; turned on by default |
| 1 assertn ; immediate |
1 assertn ; immediate |
| : assert2( ( -- ) |
: assert2( ( -- ) \ new |
| \ debugging assertions |
\G debugging assertions |
| 2 assertn ; immediate |
2 assertn ; immediate |
| : assert3( ( -- ) |
: assert3( ( -- ) \ new |
| \ slow assertions that you may not want to turn on in normal debugging; |
\G slow assertions that you may not want to turn on in normal debugging; |
| \ you would turn them on mainly for thorough checking |
\G you would turn them on mainly for thorough checking |
| 3 assertn ; immediate |
3 assertn ; immediate |
| : assert( ( -- ) |
: assert( ( -- ) \ new |
| \ equivalent to assert1( |
\G equivalent to assert1( |
| POSTPONE assert1( ; immediate |
POSTPONE assert1( ; immediate |
| |
|
| : (endassert) ( flag -- ) |
: (endassert) ( flag -- ) \ new |
| \ three inline arguments |
\ three inline arguments |
| if |
if |
| r> 3 cells + >r EXIT |
r> 3 cells + >r EXIT |
| true abort" assertion failed" \ !! or use a new throw code? |
true abort" assertion failed" \ !! or use a new throw code? |
| then ; |
then ; |
| |
|
| : ) ( -- ) |
: ) ( -- ) \ new |
| POSTPONE (endassert) loadfilename 2@ 2, loadline @ , ; immediate |
POSTPONE (endassert) loadfilename 2@ 2, loadline @ , ; immediate |