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: src/sys/boot/ficl/softwords/jhlocal.fr,v 1.5 2007/03/23 22:26:01 jkim Exp $
  18 \ $DragonFly: src/sys/boot/ficl/softwords/jhlocal.fr,v 1.4 2008/03/29 23:31:07 swildner Exp $
  19
  20 hide
  21
  22 0 constant zero
  23
  24
  25 : ?--   ( c-addr u -- c-addr u flag )
  26     2dup s" --" compare 0= ;
  27 : ?}    ( c-addr u -- c-addr u flag )
  28     2dup s" }"  compare 0= ;
  29 : ?|    ( c-addr u -- c-addr u flag )
  30     2dup s" |"  compare 0= ;
  31
  32 \ examine name - if it's a 2local (starts with "2:"),
  33 \ nibble the prefix (the "2:") off the name and push true.
  34 \ Otherwise push false
  35 \ Problem if the local is named "2:" - we fall off the end...
  36 : ?2loc ( c-addr u -- c-addr u flag )
  37     over dup c@ [char] 2 =
  38         swap 1+  c@ [char] : = and
  39     if
  40         2 - swap char+ char+ swap  \ dcs/jws: nibble the '2:'
  41         true
  42     else
  43             false
  44     endif
  45 ;
  46
  47 : ?delim   ( c-addr u -- state | c-addr u 0 )
  48     ?|  if  2drop 1 exit endif
  49     ?-- if  2drop 2 exit endif
  50     ?}  if  2drop 3 exit endif
  51     dup 0=
  52         if  2drop 4 exit endif
  53     0
  54 ;
  55
  56 set-current
  57
  58 : {
  59     0 dup locals| locstate |
  60
  61     \ stack locals until we hit a delimiter
  62     begin
  63         parse-word      \ ( nLocals c-addr u )
  64         ?delim dup to locstate
  65     0= while
  66         rot 1+          \ ( c-addr u ... c-addr u nLocals )
  67     repeat
  68
  69     \ now unstack the locals
  70     0 ?do
  71             ?2loc if (2local) else (local) endif
  72         loop   \ ( )
  73
  74     \ zero locals until -- or }
  75     locstate 1 = if
  76         begin
  77             parse-word
  78             ?delim dup to locstate
  79         0= while
  80             ?2loc if
  81                 postpone zero postpone zero (2local)
  82             else
  83                 postpone zero (local)
  84             endif
  85         repeat
  86     endif
  87
  88     0 0 (local)
  89
  90     \ toss words until }
  91     \ (explicitly allow | and -- in the comment)
  92     locstate 2 = if
  93         begin
  94             parse-word
  95             ?delim dup  to locstate
  96         3 < while
  97             locstate 0=  if 2drop endif
  98         repeat
  99     endif
 100
 101     locstate 3 <> abort" syntax error in { } local line"
 102 ; immediate compile-only
 103
 104 previous
 105 \ #endif
 106