home *** CD-ROM | disk | FTP | other *** search
/ Dream 52 / Amiga_Dream_52.iso / RiscOS / APP / DEVS / FORTH / WIMPFO.ZIP / !WimpForth / forget < prev    next >
Text File  |  1996-03-21  |  2KB  |  60 lines
  1. \ $Id: forget.f 1.1 1994/04/01 07:53:05 andrew Exp $
  2.  
  3. cr .( Loading the Forget wordset...)
  4.  
  5. \   provides FORGET name
  6. \            MARK name
  7. \            MARKER
  8.  
  9. variable fence  \ cannot forget below this address
  10.  
  11. : trim-loadfile ( a1 -- a1 )
  12.                 dup loadfile trim ;
  13.  
  14. forget-chain chain-add trim-loadfile
  15.  
  16. : trim-defer    ( a1 -- a1 )    \ trim the defered word list to address a1
  17.                 dup defer-list trim
  18.                 defer-list
  19.                 begin   @ ?dup
  20.                 while   2dup cell - @ u<        \ if forward above, then
  21.                         if      dup  cell+  @
  22.                                 over cell - !   \ set default defer
  23.                         then
  24.                 repeat  ;
  25.  
  26. forget-chain chain-add trim-defer
  27.  
  28. : vtrim         ( a1 voc-thread -- )    \ trim VOC-THREAD back to a1
  29.                 dup voc#threads 0
  30.                 do      2dup i cells + trim
  31.                 loop    2drop ;
  32.  
  33. : (forget)      ( address-of-first-name-character -- )
  34.                 dup fence @ u< abort" in protected dictionary"
  35.                 voc-link (trim)  dup voc-link !
  36.                 begin   ?dup
  37.                 while   2dup vlink>voc vtrim
  38.                         @
  39.                 repeat
  40.                 forget-chain do-chain   \ execute the forget chain
  41.                 trim-chains             \ must be done after the chain
  42.                                         \ finishes executing
  43.                 dp !                    \ finally set DP to the resulting addr
  44.                 voc-also ;              \ reset look aside table if present
  45.  
  46. : forget        ( -<name>- )
  47.                 bl word ?uppercase count
  48.                 current @ search-wordlist 0= ?missing ( cfa )
  49.                 >name nfa-count drop (forget) ;
  50.  
  51. : mark          ( -<name>- )
  52.                 create does> (forget) forth definitions ;
  53.  
  54. : marker        ( -- )  ( ANS)
  55.                 here create ,
  56.                 does> @ (forget)  forth definitions ;
  57.  
  58. here fence !
  59.  
  60.