File:  [gforth] / gforth / assert.fs
Revision 1.3: download - view: text, annotated - select for diffs
Mon Mar 13 09:17:23 1995 UTC (24 years, 11 months ago) by anton
Branches: MAIN
CVS tags: HEAD
Added stuff for documenting Forth source and integrating it into the texi file
changed checks for DOMAINOS to checks for apollo (which is defined on apollos)
changed "-evaluate" (which did not work anyway) to "--evaluate"
added debugging.fs and assert.fs to startup.fs

    1: \ assertions
    2: 
    3: \ !! factor out line number printing, share with debugging.fs
    4: 
    5: variable assert-level ( -- a-addr ) \ new
    6: \G all assertions above this level are turned off
    7: 1 assert-level !
    8: 
    9: : assertn ( n -- ) \ new
   10:     \ this is internal (it is not immediate)
   11:     assert-level @ >
   12:     if
   13: 	POSTPONE (
   14:     then ;
   15: 
   16: : assert0( ( -- ) \ new
   17:     \G important assertions that should always be turned on
   18:     0 assertn ; immediate
   19: : assert1( ( -- ) \ new
   20:     \G normal assertions; turned on by default
   21:     1 assertn ; immediate
   22: : assert2( ( -- ) \ new
   23:     \G debugging assertions
   24:     2 assertn ; immediate
   25: : assert3( ( -- ) \ new
   26:     \G slow assertions that you may not want to turn on in normal debugging;
   27:     \G you would turn them on mainly for thorough checking
   28:     3 assertn ; immediate
   29: : assert( ( -- ) \ new
   30:     \G equivalent to assert1(
   31:     POSTPONE assert1( ; immediate
   32: 
   33: : (endassert) ( flag -- ) \ new
   34:     \ three inline arguments
   35:     if
   36: 	r> 3 cells + >r EXIT
   37:     else
   38: 	r>
   39: 	dup 2@ type ." :" cell+ cell+
   40: 	@ 0 .r ." : failed assertion"
   41: 	true abort" assertion failed" \ !! or use a new throw code?
   42:     then ;
   43: 
   44: : ) ( -- ) \ new
   45:     POSTPONE (endassert) loadfilename 2@ 2, loadline @ , ; immediate

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>