\ Automatic checker for stack integrity.
\ Use as:  
\   : name  (s param -- param2 param3 param4 )
\       ...
\   ;
\ The (s counts parameters in the stack comment, and checks at run
\ time for the proper change in stack depth between the start of
\ the word and the end.  Params must be separated by spaces.
\ '--' and ')' must be spelled as shown and separated by spaces.
\
\ This feature is enabled or disabled with:
\     stackcheck on  -or-  stackcheck off
\
\ Default value is OFF

variable stackcheck  stackcheck off

: check-stack	( -- )	( rs: next-acf expected-depth bogus-acf -- )
	r> drop depth r> =
	if	['] ;   compile,
	else	error-output cr ." Stack error detected." cr
		rp0 @  rp@  [ also hidden ] (rstrace [ previous ]
		restore-output abort
	then ;
variable checker	\ Dummy variable, to hold acf of check-stack
' check-stack checker !

: pcomp		( pstr1 pstr2 -- n )	\ 0 if the same
	count  rot count  ( addr2 len2 addr1 len1 )
	rot max  comp ;

: read-stack  ( -- +-depth )
	0
	begin	blword  p" --"  pcomp
	while	1-
	repeat
	begin	blword  p" )"   pcomp
	while  1+
	repeat ;

alias old-(s  (s

\ At compile time, count stack items in the comment for expected offset
\ At run time, push current-depth +-offset onto rs:, then push check-acf
: (s	\ stack-in -- stack-out )  ( -- )
	( rs: -- proper-depth check-acf )
	stackcheck @
	if	postpone depth
		read-stack do-literal
		postpone +  postpone >r
		checker  do-literal  postpone >r
	else	postpone old-(s
	then ; immediate

