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