第四:如何创建一个编译其他单词直到找到特定分隔符的单词?

Forth: How to create a word that compiles other words until certain delimiter is found?

我通过I2C使用Forth(即Swapforth) to configure certain hardware。我有一句话:

i2c1-send ( reg-address byte -- )

即向某个芯片的特定内部寄存器写入一个字节。 初始化序列很长,因此由于内存消耗,如下实现是不可行的。

: i2c1-init
   01  i2c1-send
   30  i2c1-send
   [...]
   31  i2c1-send
;

我创建了一个实现,它创建了一个结构,在第一个单元格中保存序列的长度,在下一个单元格中保存三个字节。 (请注意,i2c1-send 只是一个占位符,允许您在没有我的硬件的情况下对其进行测试)。

: i2c1-send ( reg_addr byte -- )
  \ It is just a placeholder to show what will be written in HW
  swap
  ." addr=" hex . ." val=" . decimal CR
;    

: i2c1: ( "<spaces>name" -- )
  create here 6e9 0 ,
  does> dup cell+ swap 
  @ 0 do 
    dup c@ >r 1+
    dup c@ 8 lshift swap 1+
    dup c@ rot or r> i2c1-send
    1+
  loop 
  drop
; 

: i2c1-def ( addr val -- )
  c, ( adr )
  dup 8 rshift c,
  255 and c,
;

: i2c1; ( -- )
  \ Make sure that i2c1: was used before
  6e9 <> abort" i2c1; without i2c1:"
  dup cell+ here swap - ( first_cell length )
  \ Verify that the length is a multiple of 3
  3 /mod swap 0<> abort" illegal length - not a multiple of 3"
  swap !
; 

使用上面的代码,您可以类似地定义初始化列表:

i2c1: set1
  34  i2c1-def
  21  i2c1-def
  [...]
  13  i2c1-def
i2c1;

但内存消耗显着减少(在 J1B Forth 的情况下减少了 2 CPU)。

但是我不喜欢这种语法。我希望有一些东西可以仅通过数字定义初始化列表,直到找到特定的分隔符,如下所示:

i2c1-x: i2c1-init
  34  
  21  
  [...]
  13  
i2c1-x;

我创建了如下所示的单词:

: i2c-delim s" i2c1-x;" ;
: i2c1-x: create here 0 ,
  begin 
   parse-name
     2dup i2c-delim compare 0<> while
     evaluate \ We store the address later
   parse-name
     evaluate 
     c, 
     \ Now store the address
     dup 8 rshift c,
           255 and c,
  repeat
  2drop
  dup cell+ here swap - ( first_cell length )
  \ Verify that the length is a multiple of 3
  3 /mod swap 0<> abort" length not a multiple of 3"
  swap !
  does> dup cell+ swap 
  @ 0 do 
    dup c@ >r 1+ 
    dup c@ 8 lshift swap 1+ 
    dup c@ rot or r> i2c1-send 
    1+
  loop 
  drop
; 

它非常适合短定义:

i2c1-x: set2 34 $ac 43  71  40  i2c1-x;

但对于使用多行的较长的行则失败:

i2c1-x: set2 
   34 $ac
   43  
   71  
   40 
i2c1-x;

是否可以定义 i2c1-x 以便它处理多行,或者我是否必须使用基于单独的 i2c1:i2c1-defi2c1; 的解决方案?

REFILL 个词来解析多行。

\ Get the next name (lexeme) possibly from the next lines
\ NB: Use the result of parse-name-sure immediate
\ since it may be garbled after the next refill
\ (the buffer may be be overwritten by the next line).
: parse-name-sure ( -- c-addr u|0 )
  begin parse-name dup 0= while refill 0= if exit then 2drop repeat
;

\ Check if the first string equals to the second
: equals ( c-addr2 u2 c-addr1 u1 -- flag )
  dup 3 pick <> if 2drop 2drop false exit then
  compare 0=
;

将输入翻译成某个定界符是一种常见的方法。执行此方法的一般功能:

\ Translate the input till a delimiter
\ using xt as translator for a lexeme
2variable _delimiter
: translate-input-till-with ( i*x c-addr u xt -- j*x )
  >r _delimiter 2!
  begin parse-name-sure dup while
    2dup _delimiter 2@ equals 0= while
    r@ execute
  repeat then 2drop rdrop
;

将 16 位单元的操作也分解到库中是有意义的:

[undefined] w@ [if]
\ NB: little-endian endianness variant
: w! ( x addr -- ) dup 1+ >r >r dup 8 rshift r> c! r> c! ;
: w@ ( addr -- x ) dup c@ 8 lshift swap 1+ c@ or ;
: w, ( x -- ) here 2 allot w! ;
[then]

此外,将文本转换为数字的函数应该在库中。为此使用 evaluate 是不卫生的。请参阅 "How to enter numbers in Forth" 问题中 的示例。可以在您的 Forth-system.

中找到转换“$”前缀数字的助手
\ dummy definitions for test only
: s-to-n ( addr u -- x ) evaluate ;
: send-i2c1 ( addr x -- ) ." send: " . . CR ;

申请代码:

\ Translate the input numbers till the delimiter into the special format
\ (the code could be simplified using the quotations)

: i2c-delim s" i2c1-x;" ;

: translate-i2c-pair ( c-addr u -- )
  s-to-n
  parse-name-sure
  2dup i2c-delim equals abort" translate-i2c: unexpected delimiter"
  s-to-n c, w,
;
: translate-i2c-input ( -- )
  i2c-delim ['] translate-i2c-pair translate-input-till-with
;


\ Send data from the special format

: send-i2c1-bulk ( addr u -- )
  3 /  0 ?do
    dup c@ swap 1+
    dup w@ swap 2+ >r send-i2c1 r>
  loop drop
;


\ The defining word

: i2c1-x:
  create here >r 0 , here >r translate-i2c-input here r> - r> !
  does> dup cell+ swap @ send-i2c1-bulk
;

一个测试用例

i2c1-x: test
1 2
3 4
5
6
i2c1-x;

test