home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Professional / OS2PRO194.ISO / os2 / prgramer / forth_32 / extras.4th < prev    next >
Text File  |  1993-03-19  |  2KB  |  61 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 W- ! ;    \ 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. : CELL   W  ;         : CELLS  W* ;         : CELL+  W+ ;
  28.  
  29.  
  30. -1 constant ?DOFlag       \ Flag signals a ?DO versus a DO
  31. : DoCheck  2DUP > ;       \ Check if DO can be called
  32. : ?DOLoop  SP@ CSP @ U< IF  DUP ?DOFlag <> IF 0 THEN
  33.            ELSE  0  THEN ;
  34.  
  35. : ?DO    COMPILE DoCheck  [COMPILE] IF  ?DOFlag
  36.         [COMPILE] DO ;  IMMEDIATE
  37.  
  38. : LOOP   [COMPILE] LOOP
  39.          ?DOLoop IF          \ Only if ?DO was issued
  40.             [COMPILE] ELSE   COMPILE 2DROP   [COMPILE] THEN
  41.          THEN ;  IMMEDIATE
  42.  
  43. : +LOOP  [COMPILE] +LOOP     \ ?DO will not work with a negative index
  44.          ?DOLoop IF          \ Only if ?DO was issued
  45.             [COMPILE] ELSE   COMPILE 2DROP   [COMPILE] THEN
  46.          THEN ;  IMMEDIATE
  47.  
  48.  
  49. \ REMOVEVOC  removes the top vocabulary from CONTEXT:  LOCALS RemoveVoc
  50. : REMOVEVOC ( -- ) CONTEXT W+  CONTEXT  ContextSize 1- W* CMOVE ;
  51.  
  52.  
  53. \ Planned support:
  54.  
  55. : .VOCS  ( -- )  ( Show names of all vocabularies currently defined ) ;
  56.  
  57.  
  58. : COMMENT:  ( like  0 #if   )  ;
  59. : COMMENT;  ( like  #endif  )  ;
  60.  
  61.