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

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