-\ @(#) 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
+\ @(#) forget.fth 98/01/26 1.2
+\ forget.fth
+\
+\ forget part of dictionary
+\
+\ Author: Phil Burk
+\ 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 )
+ here rfence a!
+;
+
+: FORGET.NFA ( nfa -- , set DP etc. )
+ dup name> >code dp !
+ 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
+ IF
+ >newline dup id. ." is below fence!!" cr
+ drop
+ ELSE forget.nfa
+ THEN
+;
+
+: (FORGET) ( <name> -- )
+ BL word findnfa
+ IF verify.forget
+ ELSE ." FORGET - couldn't find " count type cr abort
+ THEN
+;
+
+variable LAST-FORGET \ contains address of last if.forgotten frame
+0 last-forget !
+
+: IF.FORGOTTEN ( <name> -- , place links in dictionary without header )
+ bl word find
+ IF ( xt )
+ here \ start of frame
+ 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
+ THEN
+;
+if.forgotten noop
+
+: [FORGET] ( <name> -- , forget then exec forgotten words )
+ (forget)
+ last-forget
+ BEGIN a@ dup 0<> \ 19970701
+ IF dup here u> \ 19970701
+ IF dup cell+ x@ execute false
+ ELSE dup last-forget a! true
+ THEN
+ ELSE true
+ THEN
+ UNTIL drop
+;
+
+: FORGET ( <name> -- , execute latest [FORGET] )
+ " [FORGET]" find
+ IF execute
+ ELSE ." FORGET - couldn't find " count type cr abort
+ THEN
+;
+
+: ANEW ( -- , forget if defined then redefine )
+ >in @
+ bl word find
+ IF over >in ! forget
+ THEN drop
+ >in ! variable
+;
+
+: MARKER ( <name> -- , define a word that forgets itself when executed, ANS )
+ CREATE
+ latest namebase - \ convert to relocatable
+ , \ save for DOES>
+ DOES> ( -- body )
+ @ namebase + \ convert back to NFA
+ verify.forget
+;
projects / pforth / blobdiff