Colibri Forth
Colibri Forth is derived from zForth. Forth is a tiny programming language that is very suitable for embedded systems as it is easy to adapt, extend and tailor for any environment and doesn't depend on POSIX or other large libraries or operating systems. There is a Forth standard, called ANS Forth, which strives to unify the vocabulary used in sea of Forth implementations (there is a rumor of "there are more Forth implementations than Forth applications"). This unification work have led to a fairly large footprint of ANS Forth, and we don't have such luxury. And zForth is not following the ANS Forth standard,
Colibri Vocabulary
(to be defined, work-in-progress)
: i2c_write ( devaddr value8 -- ) : i2c_write_buf ( devaddr value8_addr n -- ) : i2c_read ( devaddr -- value8 ) : i2c_read_buf ( devaddr value8_addr n -- ) : scale (value16 k_float m_float -- value_float) : descale (value_float k_float m_float -- value16 )
zForth Vocabulary
Primitives
The primitives are words that are implemented in C. All other vocabulary words are built from these.
exit lit <0 : _; + - * / % drop dup pickr _immediate @@ !! swap rot jmp jmp0 ' _( >r r> = sys pick ,, key lits ## & | ^ << >>
Core
( system calls )
: emit 0 sys ;
: . 1 sys ;
: tell 2 sys ;
: quit 128 sys ;
: sin 129 sys ;
: include 130 sys ;
: save 131 sys ;
( dictionary access. These are shortcuts through the primitive operations are !!, @@ and ,, )
: ! 0 !! ;
: @ 0 @@ ;
: , 0 ,, ;
: # 0 ## ;
( compiler state )
: [ 0 compiling ! ; immediate
: ] 1 compiling ! ;
: postpone 1 _postpone ! ; immediate
( some operators and shortcuts )
: 1+ 1 + ;
: 1- 1 - ;
: over 1 pick ;
: +! dup @ rot + swap ! ;
: inc 1 swap +! ;
: dec -1 swap +! ;
: < - <0 ;
: > swap < ;
: <= over over >r >r < r> r> = + ;
: >= swap <= ;
: =0 0 = ;
: not =0 ;
: != = not ;
: cr 10 emit ;
: br 32 emit ;
: .. dup . ;
: here h @ ;
( memory management )
: allot h +! ;
: var : ' lit , here 5 allot here swap ! 5 allot postpone ; ;
: const : ' lit , , postpone ; ;
( 'begin' gets the current address, a jump or conditional jump back is generated
by 'again', 'until' )
: begin here ; immediate
: again ' jmp , , ; immediate
: until ' jmp0 , , ; immediate
( '{ ... ... ... n x}' repeat n times definition - eg. : 5hello { ." hello " 5 x} ; )
: { ( -- ) ' lit , 0 , ' >r , here ; immediate
: x} ( -- ) ' r> , ' 1+ , ' dup , ' >r , ' = , postpone until ' r> , ' drop , ; immediate
( vectored execution - execute XT eg. ' hello exe )
: exe ( XT -- ) ' lit , here dup , ' >r , ' >r , ' exit , here swap ! ; immediate
( execute XT n times e.g. ' hello 3 times )
: times ( XT n -- ) { >r dup >r exe r> r> dup x} drop drop ;
( 'if' prepares conditional jump, address will be filled in by 'else' or 'fi' )
: if ' jmp0 , here 999 , ; immediate
: unless ' not , postpone if ; immediate
: else ' jmp , here 999 , swap here swap ! ; immediate
: fi here swap ! ; immediate
( forth style 'do' and 'loop', including loop iterators 'i' and 'j' )
: i ' lit , 0 , ' pickr , ; immediate
: j ' lit , 2 , ' pickr , ; immediate
: do ' swap , ' >r , ' >r , here ; immediate
: loop+ ' r> , ' + , ' dup , ' >r , ' lit , 1 , ' pickr , ' > , ' jmp0 , , ' r> , ' drop , ' r> , ' drop , ; immediate
: loop ' lit , 1 , postpone loop+ ; immediate
( Create string literal, puts length and address on the stack )
: s" compiling @ if ' lits , here 0 , fi here begin key dup 34 = if drop
compiling @ if here swap - swap ! else dup here swap - fi exit else , fi
again ; immediate
( Print string literal )
: ." compiling @ if postpone s" ' tell , else begin key dup 34 = if drop exit else emit fi again
fi ; immediate
: max over over < if swap fi drop ;
: min over over > if swap fi drop ;
Dictionary
Words for handling the dictionary
( 'next' increases the given dictionary address by the size of the cell
located at that address )
: next dup # + ;
( 'words' generates a list of all define words )
: name dup @ 31 & swap next dup next rot tell @ ;
: words latest @ begin name br dup 0 = until cr drop ;
: prim? ( w -- bool ) @ 32 & ;
: a->xt ( w -- xt ) dup dup @ 31 & swap next next + swap prim? if @ fi ;
: xt->a ( xt -- w ) latest @ begin dup a->xt 2 pick = if swap drop exit fi next @ dup 0 = until swap drop ;
: lit?jmp? ( a -- a boolean ) dup @ dup 1 = swap dup 18 = swap 19 = + + ;
: disas ( a -- a ) dup dup . br br @ xt->a name drop lit?jmp? if br next dup @ . fi cr ;
( 'see' needs starting address on stack: e.g. ' words see )
: see ( xt -- ) dup xt->a name cr drop begin disas next dup @ =0 until drop ;
( 'dump' memory make hex dump len bytes from addr )
: hex_t ' lit , here dup , s" 0123456789abcdef" allot swap ! ; immediate
: *hex_t hex_t ;
: .hex *hex_t + @ emit ;
: >nib ( n -- low high ) dup 15 & swap -16 & 16 / ;
: ffemit ( n -- ) >nib .hex .hex ;
: ffffemit ( n -- ) >nib >nib >nib { .hex 4 x} ;
: @LSB ( addr -- LSB ) 2 @@ 255 & ;
: between? ( n low_lim high_lim -- bool ) 2 pick > rot rot > & ;
: 8hex ( a -- a_new ) { dup @LSB ffemit 32 emit 1+ 8 x} 32 emit ;
: 16ascii ( a -- a_new ) 124 emit { dup @LSB dup 31 127 between? if emit else drop 46 emit fi 1+ 16 x} 124 emit ;
: .addr ( a -- ) ffffemit ." " ;
: 16line ( a -- a_new ) dup .addr dup { 8hex 2 x} drop 16ascii cr ;
: dump ( addr len -- ) over + swap begin 16line over over < until drop drop ;
Memory Access
: !c 1 !! ; : !u8 2 !! ; : !u16 3 !! ; : !u32 4 !! ; : !s8 5 !! ; : !s16 6 !! ; : !s32 7 !! ;
: @c 1 @@ ; : @u8 2 @@ ; : @u16 3 @@ ; : @u32 4 @@ ; : @s8 5 @@ ; : @s16 6 @@ ; : @s32 7 @@ ;
: ,c 1 ,, ; : ,u8 2 ,, ; : ,u16 3 ,, ; : ,u32 4 ,, ; : ,s8 5 ,, ; : ,s16 6 ,, ; : ,s32 7 ,, ;