git.gag.com Git - debian/pforth/blob - 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 anew task-locals.fth
  18
  19 private{
  20 variable loc-temp-mode    \ if true, declaring temporary variables
  21 variable loc-comment-mode \ if true, in comment section
  22 variable loc-done
  23 }private
  24
  25 : { ( <local-declaration}> -- )
  26         loc-done off
  27         loc-temp-mode off
  28         loc-comment-mode off
  29         BEGIN
  30                 bl word count
  31                 over c@
  32                 CASE
  33 \ handle special characters
  34                 ascii }  OF  loc-done on          2drop  ENDOF
  35                 ascii |  OF  loc-temp-mode on     2drop  ENDOF
  36                 ascii -  OF  loc-comment-mode on  2drop  ENDOF
  37                 ascii )  OF  ." { ... ) imbalance!" cr abort  ENDOF
  38
  39 \ process name
  40                 >r  ( save char )
  41                 ( addr len )
  42                 loc-comment-mode @
  43                 IF
  44                         2drop
  45                 ELSE
  46 \ if in temporary mode, assign local var = 0
  47                         loc-temp-mode @
  48                         IF compile false
  49                         THEN
  50 \ otherwise take value from stack
  51                         (local)
  52                 THEN
  53                 r>
  54                 ENDCASE
  55                 loc-done @
  56         UNTIL
  57         0 0 (local)
  58 ; immediate
  59
  60 privatize
  61
  62 \ tests
  63 : tlv1  { n -- }  n  dup n *  dup n *  ;
  64
  65 : tlv2 { v1 v2 | l1 l2 -- }
  66         v1 . v2 . cr
  67         v1 v2 + -> l1
  68         l1 . l2 . cr
  69 ;