Merge pull request #13 from philburk/fixrom
[pforth] / fth / locals.fth
CommitLineData
bb6b2dcd 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
19anew task-locals.fth\r
20\r
21private{\r
22variable loc-temp-mode \ if true, declaring temporary variables\r
23variable loc-comment-mode \ if true, in comment section\r
24variable 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
68privatize\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