\ @(#) forget.fth 98/01/26 1.2
\ forget part of dictionary
\ Copyright 1994 3DO, Phil Burk, Larry Polansky, David Rosenboom
\ Permission to use, copy, modify, and/or distribute this
\ software for any purpose with or without fee is hereby granted.
\ THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL
\ WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED
\ WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL
\ THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR
\ CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING
\ FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF
\ CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
\ OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
\ 19970701 PLB Use unsigned compares for machines with "negative" addresses.
variable RFENCE \ relocatable value below which we won't forget
: FREEZE ( -- , protect below here )
: FORGET.NFA ( nfa -- , set DP etc. )
prevname ( dup current ! ) dup context ! n>nextlink headers-ptr !
: VERIFY.FORGET ( nfa -- , ask for verification if below fence )
dup name> >code rfence a@ u< \ 19970701
>newline dup id. ." is below fence!!" cr
ELSE ." FORGET - couldn't find " count type cr abort
variable LAST-FORGET \ contains address of last if.forgotten frame
: IF.FORGOTTEN ( <name> -- , place links in dictionary without header )
last-forget a@ a, \ Cell[0] = rel address of previous frame
last-forget a! \ point to this frame
compile, \ Cell[1] = xt for this frame
ELSE ." IF.FORGOTTEN - couldn't find " dup 9 dump cr count type cr abort
: [FORGET] ( <name> -- , forget then exec forgotten words )
BEGIN a@ dup 0<> \ 19970701
IF dup here u> \ 19970701
IF dup cell+ x@ execute false
ELSE dup last-forget a! true
: FORGET ( <name> -- , execute latest [FORGET] )
ELSE ." FORGET - couldn't find " count type cr abort
: ANEW ( -- , forget if defined then redefine )
: MARKER ( <name> -- , define a word that forgets itself when executed, ANS )
latest namebase - \ convert to relocatable
@ namebase + \ convert back to NFA