home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / forth040.zip / LOCALS.4TH < prev    next >
Text File  |  1993-05-21  |  3KB  |  86 lines
  1. \ LOCALS.4TH  -  Local variable extensions to Forth/2     3/14/93 bbm
  2. \ Copyright (c) 1993  BLUE STAR SYSTEMS
  3. \
  4. \
  5. \ Locals enhance Forth by reducing the complexity of stack operations,
  6. \   and allow you to assign descriptive labels to the numbers passed 
  7. \   to the word on the stack.
  8. \
  9. \ Usage:
  10. \
  11. \ : WordName  LOCALS|  local1  local2  local3  ...  local8 |
  12. \                      ...  local1  ...
  13. \                      ...  local2  ...  local3  ... etc.  ;
  14. \
  15. \ The entire  LOCALS| ... |  must be on the same line.
  16. \
  17. \
  18. \ Example:
  19. \
  20. \ : DIGITS    LOCALS|  digit1 digit2 digit3 |
  21. \
  22. \                      digit1  100 *
  23. \                      digit2   10 *
  24. \                      digit3  + + ;   \ turns  1 2 3 DIGITS  into  123
  25.  
  26.  
  27. FORTH ONLY
  28. DECIMAL
  29.  
  30. : LOCALS.4TH ;
  31.  
  32. 36 CONSTANT NAME_LENGTH    \ Length of names as stored in dictionary
  33.  8 CONSTANT #LOCALS_MAX    \ Maximum number of LOCALS
  34.    VARIABLE #LOCALS
  35.    VARIABLE LOCAL_NAMES_BUF   #LOCALS_MAX NAME_LENGTH * ALLOT
  36.  
  37.  
  38. : !LOCALBUF ( " -- )  LOCAL_NAMES_BUF
  39.                       #LOCALS @ NAME_LENGTH *  +  "MOVE  1 #LOCALS +! ;
  40.  
  41. : @LOCALBUF ( n -- " ) NAME_LENGTH *  LOCAL_NAMES_BUF + ;
  42.  
  43. USER LOCAL_BASE  #LOCALS_MAX CELLS UDP +!
  44.  
  45.  
  46. VOCABULARY LOCALS  LOCALS DEFINITIONS
  47.  
  48. : LOCAL8  LOCAL_BASE 28 + @ ;
  49. : LOCAL7  LOCAL_BASE 24 + @ ;
  50. : LOCAL6  LOCAL_BASE 20 + @ ;
  51. : LOCAL5  LOCAL_BASE 16 + @ ;
  52. : LOCAL4  LOCAL_BASE 12 + @ ;
  53. : LOCAL3  LOCAL_BASE  8 + @ ;
  54. : LOCAL2  LOCAL_BASE  4 + @ ;
  55. : LOCAL1  LOCAL_BASE      @ ;
  56.  
  57. FORTH ONLY
  58.  
  59. : !LOCALS  SP@  LOCAL_BASE  I @ CELLS CMOVE
  60.            I @ DROPS  R> CELL+ >R ;
  61.  
  62.  
  63. : LOCALS|  [COMPILE] LOCALS   ?COMPILE   0 #LOCALS !
  64.            LOCAL_NAMES_BUF  #LOCALS_MAX NAME_LENGTH *  0 FILL
  65.            BEGIN
  66.               BL WORD
  67.               DUP " ;" =" ABORT" Missing final | after locals."
  68.               DUP @    0= ABORT" Missing final | on same line as LOCALS|"
  69.               DUP " |" =" NOT WHILE  !LOCALBUF  
  70.               #Locals @  #LOCALS_MAX > ABORT" Too many locals"
  71.            REPEAT DROP
  72.            CONTEXT @  +VLINK @
  73.            #LOCALS @ 0 DO
  74.               #LOCALS @ 1- I - @LOCALBUF  OVER NFA NAME_LENGTH CMOVE
  75.            @ LOOP  DROP
  76.            COMPILE !LOCALS  #LOCALS @ , ;    IMMEDIATE
  77.  
  78. \ REMOVEVOC  removes the top vocabulary from CONTEXT:  LOCALS RemoveVoc
  79. : REMOVEVOC ( -- ) CONTEXT CELL+  CONTEXT  ContextSize 1- CELLS CMOVE ;
  80.  
  81.  
  82. \ Redefine  ;  to hide the  LOCALS  so they don't interfere later
  83. : ;  #LOCALS @ IF  POSTPONE LOCALS  REMOVEVOC   0 #LOCALS !
  84.              THEN  POSTPONE ;  ;    IMMEDIATE
  85.  
  86.