git.gag.com Git - debian/pforth/blob - fth/locals.fth

   1 \ @(#) $M$ 98/01/26 1.2
   2 \ standard { v0 v1 ... vn | l0 l1 .. lm -- } syntax
   3 \ based on ANSI basis words (LOCAL) and TO
   4 \
   5 \ Author: Phil Burk
   6 \ Copyright 1994 3DO, Phil Burk, Larry Polansky, Devid Rosenboom
   7 \
   8 \ The pForth software code is dedicated to the public domain,
   9 \ and any third party may reproduce, distribute and modify
  10 \ the pForth software code or any derivative works thereof
  11 \ without any compensation or license.  The pForth software
  12 \ code is provided on an "as is" basis without any warranty
  13 \ of any kind, including, without limitation, the implied
  14 \ warranties of merchantability and fitness for a particular
  15 \ purpose and their equivalents under the laws of any jurisdiction.
  16
  17 \ MOD: PLB 2/11/00 Allow EOL and \ between { }.
  18
  19 anew task-locals.fth
  20
  21 private{
  22 variable loc-temp-mode    \ if true, declaring temporary variables
  23 variable loc-comment-mode \ if true, in comment section
  24 variable loc-done
  25 }private
  26
  27 : { ( <local-declaration}> -- )
  28     loc-done off
  29     loc-temp-mode off
  30     loc-comment-mode off
  31     BEGIN
  32         bl word count
  33         dup 0>           \ make sure we are not at the end of a line
  34         IF
  35             over c@
  36             CASE
  37     \ handle special characters
  38             ascii }  OF  loc-done on          2drop  ENDOF
  39             ascii |  OF  loc-temp-mode on     2drop  ENDOF
  40             ascii -  OF  loc-comment-mode on  2drop  ENDOF
  41             ascii )  OF  ." { ... ) imbalance!" cr abort  ENDOF
  42             ascii \  OF  postpone \  2drop ENDOF   \ Forth comment
  43
  44     \ process name
  45             >r  ( save char )
  46             ( addr len )
  47             loc-comment-mode @
  48             IF
  49                 2drop
  50             ELSE
  51     \ if in temporary mode, assign local var = 0
  52                 loc-temp-mode @
  53                 IF compile false
  54                 THEN
  55     \ otherwise take value from stack
  56                 (local)
  57             THEN
  58             r>
  59             ENDCASE
  60         ELSE
  61             2drop refill 0= abort" End of input while defining local variables!"
  62         THEN
  63         loc-done @
  64     UNTIL
  65     0 0 (local)
  66 ; immediate
  67
  68 privatize
  69
  70 \ tests
  71 : tlv1  { n -- }  n  dup n *  dup n *  ;
  72
  73 : tlv2 { v1 v2 | l1 l2 -- }
  74     v1 . v2 . cr
  75     v1 v2 + -> l1
  76     l1 . l2 . cr
  77 ;