/fth/locals.fth

https://github.com/philburk/pforth · Forth · 80 lines · 71 code · 8 blank · 1 comment · 5 complexity · 163478dd6d511db8a87a5b6ebf1d04f0 MD5 · raw file

  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. \ MOD: PLB 2/11/00 Allow EOL and \ between { }.
  20. anew task-locals.fth
  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. : { ( <local-declaration}> -- )
  27. loc-done off
  28. loc-temp-mode off
  29. loc-comment-mode off
  30. BEGIN
  31. bl word count
  32. dup 0> \ make sure we are not at the end of a line
  33. IF
  34. over c@
  35. CASE
  36. \ handle special characters
  37. ascii } OF loc-done on 2drop ENDOF
  38. ascii | OF loc-temp-mode on 2drop ENDOF
  39. ascii - OF loc-comment-mode on 2drop ENDOF
  40. ascii ) OF ." { ... ) imbalance!" cr abort ENDOF
  41. ascii \ OF postpone \ 2drop ENDOF \ Forth comment
  42. \ process name
  43. >r ( save char )
  44. ( addr len )
  45. loc-comment-mode @
  46. IF
  47. 2drop
  48. ELSE
  49. \ if in temporary mode, assign local var = 0
  50. loc-temp-mode @
  51. IF compile false
  52. THEN
  53. \ otherwise take value from stack
  54. (local)
  55. THEN
  56. r>
  57. ENDCASE
  58. ELSE
  59. 2drop refill 0= abort" End of input while defining local variables!"
  60. THEN
  61. loc-done @
  62. UNTIL
  63. 0 0 (local)
  64. ; immediate
  65. privatize
  66. \ tests
  67. : tlv1 { n -- } n dup n * dup n * ;
  68. : tlv2 { v1 v2 | l1 l2 -- }
  69. v1 . v2 . cr
  70. v1 v2 + -> l1
  71. l1 . l2 . cr
  72. ;