6/sys/boot/ficl/softwords/jhlocal.fr

   1 \ #if FICL_WANT_LOCALS
   2 \ ** ficl/softwords/jhlocal.fr
   3 \ ** stack comment style local syntax...
   4 \ { a b c | cleared -- d e }
   5 \ variables before the "|" are initialized in reverse order
   6 \ from the stack. Those after the "|" are zero initialized.
   7 \ Anything between "--" and "}" is treated as comment
   8 \ Uses locals...
   9 \ locstate: 0 = looking for | or -- or }}
  10 \           1 = found |
  11 \           2 = found --
  12 \           3 = found }
  13 \           4 = end of line
  14 \
  15 \ revised 2 June 2000 - { | a -- } now works correctly
  16 \
  17 \ $FreeBSD$
  18
  19 hide
  20 0 constant zero
  21
  22 : ?--   ( c-addr u -- c-addr u flag )
  23     2dup s" --" compare 0= ;
  24 : ?}    ( c-addr u -- c-addr u flag )
  25     2dup s" }"  compare 0= ;
  26 : ?|    ( c-addr u -- c-addr u flag )
  27     2dup s" |"  compare 0= ;
  28
  29 \ examine name - if it's a 2local (starts with "2:"),
  30 \ nibble the prefix (the "2:") off the name and push true.
  31 \ Otherwise push false
  32 \ Problem if the local is named "2:" - we fall off the end...
  33 : ?2loc ( c-addr u -- c-addr u flag )
  34     over dup c@ [char] 2 =
  35         swap 1+  c@ [char] : = and
  36     if
  37         2 - swap char+ char+ swap  \ dcs/jws: nibble the '2:'
  38         true
  39     else
  40             false
  41     endif
  42 ;
  43
  44 : ?delim   ( c-addr u -- state | c-addr u 0 )
  45     ?|  if  2drop 1 exit endif
  46     ?-- if  2drop 2 exit endif
  47     ?}  if  2drop 3 exit endif
  48     dup 0=
  49         if  2drop 4 exit endif
  50     0
  51 ;
  52
  53 set-current
  54
  55 : {
  56     0 dup locals| locstate |
  57
  58     \ stack locals until we hit a delimiter
  59     begin
  60         parse-word      \ ( nLocals c-addr u )
  61         ?delim dup to locstate
  62     0= while
  63         rot 1+          \ ( c-addr u ... c-addr u nLocals )
  64     repeat
  65
  66     \ now unstack the locals
  67     0 ?do
  68             ?2loc if (2local) else (local) endif
  69         loop   \ ( )
  70
  71     \ zero locals until -- or }
  72     locstate 1 = if
  73         begin
  74             parse-word
  75             ?delim dup to locstate
  76         0= while
  77                     ?2loc if
  78                             postpone zero postpone zero  (2local)
  79                         else
  80                 postpone zero  (local)
  81                     endif
  82         repeat
  83     endif
  84
  85     0 0 (local)
  86
  87     \ toss words until }
  88     locstate 2 = if
  89         begin
  90             parse-word
  91             ?delim dup to locstate
  92         0= while
  93             2drop
  94         repeat
  95     endif
  96
  97     locstate 3 <> abort" syntax error in { } local line"
  98 ; immediate compile-only
  99
 100 previous
 101 \ #endif
 102