File:  [gforth] / gforth / assert.fs
Revision 1.1: download - view: text, annotated - select for diffs
Fri Jul 8 15:00:28 1994 UTC (25 years, 7 months ago) by anton
Branches: MAIN
CVS tags: HEAD
signals are now translated into THROWs
A number of bug fixes (make a diff of BUGS for details)
added assert.fs and debugging.fs
made .s nicer
keep names of included files (in loadfilename) and print them upon error

    1: \ assertions
    2: 
    3: \ !! factor out line number printing, share with debugging.fs
    4: 
    5: variable assert-level \ all assertions above this level are turned off
    6: 1 assert-level !
    7: 
    8: : assertn ( n -- )
    9:     assert-level @ >
   10:     if
   11: 	POSTPONE (
   12:     then ;
   13: 
   14: : assert0( ( -- )
   15:     0 assertn ; immediate
   16: : assert1( ( -- )
   17:     1 assertn ; immediate
   18: : assert2( ( -- )
   19:     2 assertn ; immediate
   20: : assert3( ( -- )
   21:     3 assertn ; immediate
   22: : assert( ( -- )
   23:     POSTPONE assert1( ; immediate
   24: 
   25: : (endassert) ( flag -- )
   26:     \ three inline arguments
   27:     if
   28: 	r> 3 cells + >r EXIT
   29:     else
   30: 	r>
   31: 	dup 2@ type ." :" cell+ cell+
   32: 	@ 0 .r ." : failed assertion"
   33: 	true abort" assertion failed" \ !! or use a new throw code?
   34:     then ;
   35: 
   36: : ) ( -- )
   37:     POSTPONE (endassert) loadfilename 2@ 2, loadline @ , ; immediate

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