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, David Rosenboom
   7 \
   8 \ Permission to use, copy, modify, and/or distribute this
   9 \ software for any purpose with or without fee is hereby granted.
  10 \
  11 \ THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL
  12 \ WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED
  13 \ WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL
  14 \ THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR
  15 \ CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING
  16 \ FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF
  17 \ CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
  18 \ OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
  19
  20 \ MOD: PLB 2/11/00 Allow EOL and \ between { }.
  21
  22 anew task-locals.fth
  23
  24 private{
  25 variable loc-temp-mode    \ if true, declaring temporary variables
  26 variable loc-comment-mode \ if true, in comment section
  27 variable loc-done
  28 }private
  29
  30 : { ( <local-declaration}> -- )
  31     loc-done off
  32     loc-temp-mode off
  33     loc-comment-mode off
  34     BEGIN
  35         bl word count
  36         dup 0>           \ make sure we are not at the end of a line
  37         IF
  38             over c@
  39             CASE
  40     \ handle special characters
  41             ascii }  OF  loc-done on          2drop  ENDOF
  42             ascii |  OF  loc-temp-mode on     2drop  ENDOF
  43             ascii -  OF  loc-comment-mode on  2drop  ENDOF
  44             ascii )  OF  ." { ... ) imbalance!" cr abort  ENDOF
  45             ascii \  OF  postpone \  2drop ENDOF   \ Forth comment
  46
  47     \ process name
  48             >r  ( save char )
  49             ( addr len )
  50             loc-comment-mode @
  51             IF
  52                 2drop
  53             ELSE
  54     \ if in temporary mode, assign local var = 0
  55                 loc-temp-mode @
  56                 IF compile false
  57                 THEN
  58     \ otherwise take value from stack
  59                 (local)
  60             THEN
  61             r>
  62             ENDCASE
  63         ELSE
  64             2drop refill 0= abort" End of input while defining local variables!"
  65         THEN
  66         loc-done @
  67     UNTIL
  68     0 0 (local)
  69 ; immediate
  70
  71 privatize
  72
  73 \ tests
  74 : tlv1  { n -- }  n  dup n *  dup n *  ;
  75
  76 : tlv2 { v1 v2 | l1 l2 -- }
  77     v1 . v2 . cr
  78     v1 v2 + -> l1
  79     l1 . l2 . cr
  80 ;