Merge pull request #13 from philburk/fixrom

[pforth] / fth / forget.fth

\ @(#) forget.fth 98/01/26 1.2\r
\ forget.fth\r
\\r
\ forget part of dictionary\r
\\r
\ Author: Phil Burk\r
\ Copyright 1994 3DO, Phil Burk, Larry Polansky, Devid Rosenboom\r
\\r
\ The pForth software code is dedicated to the public domain,\r
\ and any third party may reproduce, distribute and modify\r
\ the pForth software code or any derivative works thereof\r
\ without any compensation or license.  The pForth software\r
\ code is provided on an "as is" basis without any warranty\r
\ of any kind, including, without limitation, the implied\r
\ warranties of merchantability and fitness for a particular\r
\ purpose and their equivalents under the laws of any jurisdiction.\r
\\r
\ 19970701 PLB Use unsigned compares for machines with "negative" addresses.\r
\r
variable RFENCE    \ relocatable value below which we won't forget\r
\r
: FREEZE  ( -- , protect below here )\r
	here rfence a!\r
;\r
\r
: FORGET.NFA  ( nfa -- , set DP etc. )\r
	dup name> >code dp !\r
	prevname ( dup current ! ) dup context ! n>nextlink headers-ptr !\r
;\r
\r
: VERIFY.FORGET  ( nfa -- , ask for verification if below fence )\r
	dup name> >code rfence a@ u<  \ 19970701\r
	IF\r
		>newline dup id. ."  is below fence!!" cr\r
		drop\r
	ELSE forget.nfa\r
	THEN\r
;\r
\r
: (FORGET)  ( <name> -- )\r
	BL word findnfa\r
	IF	verify.forget\r
	ELSE ." FORGET - couldn't find " count type cr abort\r
	THEN\r
;\r
\r
variable LAST-FORGET   \ contains address of last if.forgotten frame\r
0 last-forget !\r
\r
: IF.FORGOTTEN  ( <name> -- , place links in dictionary without header )\r
	bl word find\r
	IF	( xt )\r
		here                \ start of frame\r
		last-forget a@ a,   \ Cell[0] = rel address of previous frame\r
		last-forget a!      \ point to this frame\r
		compile,            \ Cell[1] = xt for this frame\r
	ELSE ." IF.FORGOTTEN - couldn't find " dup 9 dump cr count type cr abort\r
	THEN\r
;\r
if.forgotten noop\r
\r
: [FORGET]  ( <name> -- , forget then exec forgotten words )\r
	(forget)\r
	last-forget\r
	BEGIN a@ dup 0<>   \ 19970701\r
		IF dup here u>   \ 19970701\r
			IF dup cell+ x@ execute false\r
			ELSE dup last-forget a! true\r
			THEN\r
		ELSE true\r
		THEN\r
	UNTIL drop\r
;\r
\r
: FORGET ( <name> -- , execute latest [FORGET] )\r
	" [FORGET]" find\r
	IF  execute\r
	ELSE ." FORGET - couldn't find " count type cr abort\r
	THEN\r
;\r
\r
: ANEW ( -- , forget if defined then redefine )\r
	>in @\r
	bl word find\r
	IF over >in ! forget\r
	THEN drop\r
	>in ! variable\r
;\r
\r
: MARKER  ( <name> -- , define a word that forgets itself when executed, ANS )\r
	CREATE\r
		latest namebase -  \ convert to relocatable\r
		,                  \ save for DOES>\r
	DOES>  ( -- body )\r
		@ namebase +       \ convert back to NFA\r
		verify.forget\r
;\r