home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / forth040.zip / EXTRAS.4TH < prev    next >
Text File  |  1993-05-21  |  2KB  |  59 lines
  1. \ Extra Forth Definitions for Forth/2            3/08/93 bbm
  2. \ Copyright (c) 1993  BLUE STAR SYSTEMS
  3.  
  4.  
  5. 1 constant IMMEDIATE_BIT
  6. 2 constant COMPILE_ONLY_BIT
  7. 4 constant HIDDEN_BIT
  8.  
  9. : HIDDEN  ( -- )  \ Marks latest word as hidden from WORDS listing
  10.           Current @ +VLink @  FFA  DUP @  HIDDEN_BIT OR  SWAP ! ;
  11.  
  12. : IMMEDIATE? ( lfa -- f )  FFA @  IMMEDIATE_BIT AND ;
  13. : HIDDEN?    ( lfa -- f )  FFA @  HIDDEN_BIT    AND ;
  14.  
  15.  
  16. \ For TO variables or VALUE's
  17.  
  18. : VALUE ( n -- )  INTEGER  HERE CELL - ! ;    \ For compatibility
  19. : !>             TO ;
  20. : +>            +TO ;
  21. : INCR>       1 +TO ;
  22. : DECR>      -1 +TO ;
  23. : ON>       TRUE TO ;
  24. : OFF>     FALSE TO ;
  25.  
  26.  
  27.  
  28. -1 constant ?DOFlag       \ Flag signals a ?DO versus a DO
  29. : DoCheck  2DUP > ;       \ Check if DO can be called
  30. : ?DOLoop  SP@ CSP @ U< IF  DUP ?DOFlag <> IF 0 THEN
  31.            ELSE  0  THEN ;
  32.  
  33. : ?DO   POSTPONE DoCheck  POSTPONE IF  ?DOFlag
  34.         POSTPONE DO ;  IMMEDIATE
  35.  
  36. : LOOP   POSTPONE LOOP
  37.          ?DOLoop IF          \ Only if ?DO was issued
  38.              POSTPONE ELSE   POSTPONE 2DROP   POSTPONE THEN
  39.          THEN ;  IMMEDIATE
  40.  
  41. : +LOOP  POSTPONE +LOOP      \ ?DO will not work with a negative index
  42.          ?DOLoop IF          \ Only if ?DO was issued
  43.              POSTPONE ELSE   POSTPONE 2DROP   POSTPONE THEN
  44.          THEN ;  IMMEDIATE
  45.  
  46.  
  47. \ REMOVEVOC  removes the top vocabulary from CONTEXT:  LOCALS RemoveVoc
  48. : REMOVEVOC ( -- ) CONTEXT CELL+  CONTEXT  ContextSize 1- CELLS CMOVE ;
  49.  
  50.  
  51. \ Planned support:
  52.  
  53. : .VOCS  ( -- )  ( Show names of all vocabularies currently defined ) ;
  54.  
  55.  
  56. : COMMENT:  ( like     0 #if   )  ;
  57. : COMMENT;  ( like  \  #endif  )  ; 
  58.  
  59.