Skip to content
This repository has been archived by the owner before Nov 9, 2022. It is now read-only.
Permalink
master
Switch branches/tags

Name already in use

A tag already exists with the provided branch name. Many Git commands accept both tag and branch names, so creating this branch may cause unexpected behavior. Are you sure you want to create this branch?
Go to file
 
 
Cannot retrieve contributors at this time
\ ==============================================================================
\
\ fsm - the Finite State Machine module in the ffl
\
\ Copyright (C) 2008 Dick van Oudheusden
\
\ This library is free software; you can redistribute it and/or
\ modify it under the terms of the GNU Lesser General Public
\ License as published by the Free Software Foundation; either
\ version 3 of the License, or (at your option) any later version.
\
\ This library is distributed in the hope that it will be useful,
\ but WITHOUT ANY WARRANTY; without even the implied warranty of
\ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
\ Lesser General Public License for more details.
\
\ You should have received a copy of the GNU Lesser General Public
\ License along with this library; if not, write to the Free
\ Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
\
\ ==============================================================================
\
\ $Date: 2008-03-25 06:56:00 $ $Revision: 1.6 $
\
\ ==============================================================================
include ffl/config.fs
[UNDEFINED] fsm.version [IF]
include ffl/ftr.fs
include ffl/fst.fs
include ffl/snl.fs
include ffl/tos.fs
( fsm = Finite State Machine )
( The fsm module implements a Finite State Machine. Use fsm-new-state to add )
( states to the machine. Then use fsm-new-transition to add transitions )
( between the states. fsm-new-transition returns the new transition. Use )
( ftr-condition@ on this new transition to get a reference to the condition )
( in the transition. This is actually a bit array, see )
( <a href='bar.html'>bar</a>. Use the words of the bar module to set the )
( condition. When the whole FSM is built, start )
( using the machine by calling fsm-start. By default the first created )
( state is the start state, but this can be changed by fsm-start! After )
( starting the machine, feed events to the machine by fsm-feed. This word )
( returns the new, current state or nil if no transition matched. The )
( machine can be converted to graphviz's dot files by fsm-to-dot. This word )
( uses the labels of the states and transitions to build the dot )
( representation. It also set the shape of the states &lb;double circle for )
( start and end states, circles for the others&rb;. Use fst-attributes! and )
( ftr-attributes! to set additional graphviz attributes. )
( During the feeding of events, the optional actions are called. When a )
( state is left, the exit action is called, when a state is entered the )
( entry state is called. If a transition matched, the action of this )
( transition is also called. The stack usage for those actions: )
( <pre> )
( state entry action: fst -- = State fst is entered )
( state exit action: fst -- = State fst is left )
( transition action: n ftr -- = Transition fst matched for event n )
( </pre> )
1 constant fsm.version
( fsm structure )
begin-structure fsm% ( -- n = Get the required space for a fsm variable )
snl%
+field fsm>states \ the list with all the states
field: fsm>ids \ the state id counter
field: fsm>start \ the start state
field: fsm>current \ the current state
field: fsm>events \ the number of events in the machine
end-structure
( FSM creation, initialisation and destruction )
: fsm-init ( +n fsm -- = Initialise the fsm with the number of events n )
dup fsm>states snl-init
dup fsm>ids 0!
tuck fsm>events !
dup fsm>start nil!
fsm>current nil!
;
: fsm-(free) ( fsm -- = Free the internal, private variables from the heap )
['] fst-free swap fsm>states snl-(free)
;
: fsm-create ( "<spaces>name" +n -- ; -- fsm = Create a named fsm in the dictionary with the number of events n )
create here fsm% allot fsm-init
;
: fsm-new ( +n -- fsm = Create a new fsm on the heap with the number of events n )
fsm% allocate throw tuck fsm-init
;
: fsm-free ( fsm -- = Free the fsm from the heap )
dup fsm-(free) \ Free the internal, private variables from the heap
free throw \ Free the fsm
;
( Member words )
: fsm-start@ ( fsm -- fst = Get the start state )
fsm>start @
;
: fsm-start! ( fst fsm -- = Set the start state )
fsm>start !
;
( State words )
: fsm-new-state ( x xt1 xt2 c-addr1 u1 fsm -- fst = Add a new state with label c-addr1 u1, entry action xt1, exit action xt2 and data x )
>r
r@ fsm>ids dup 1+! @ fst-new \ Increase ids and create the state
dup r@ fsm>states snl-append
r@ fsm-start@ nil= IF
dup r@ fsm>start !
THEN
rdrop
;
: fsm-start ( fsm -- = Start the finite state machine )
dup fsm-start@
swap fsm>current !
;
: fsm-find-state ( c-addr u fsm -- fst | nil = Find the state by its label c-addr u in the fsm )
['] fst-label? swap fsm>states snl-execute? 0= IF
2drop nil
THEN
;
( Transition words )
: fsm-new-transition ( x xt c-addr1 u1 fst1 fst2 fsm -- ftr = Add a new transition from state fst1 to state fst2 with label c-addr1 u1, action xt and data x )
fsm>events @ rot fst-new-transition
;
: fsm-any-transition ( x xt c-addr1 u1 fst1 fst2 fsm -- ftr = Set the any transition for state fst1 to state fst2 with label c-addr1 u1, action xt and data x )
drop swap fst-any-transition
;
( Event words )
: fsm-feed ( n fsm -- fst | nil = Feed the event to the current state, return the next state or nil if the event did not match any condition )
>r
r@ fsm>current @
dup nil= exp-invalid-state AND throw
fst-feed
dup r> fsm>current !
;
: fsm-try ( n fsm -- fst | nil = Try the event for the current event, return the next state, but do not move to this state )
fsm>current @
dup nil= exp-invalid-state AND throw
fst-try
;
( Conversion words )
: fsm-to-dot ( c-addr u tos fsm -- = Convert the fsm to a dot string using the stream, giving the graph the name c-addr u )
swap >r -rot
s" digraph " r@ tos-write-string
r@ tos-write-string \ Write graph name
s" {" r@ tos-write-string
r@ tos-flush
s" rankdir=LR;" r@ tos-write-string
r@ tos-flush
\ Write all nodes with their attributes to the tos
dup fsm-start@ swap fsm>states r@ swap ['] fst-to-dot swap snl-execute 2drop
[char] } r@ tos-write-char
r> tos-flush
;
( Inspection )
: fsm-dump ( fsm -- = Dump the fsm variable )
." fsm:" dup . cr
." states : " ['] fst-dump over fsm>states snl-execute cr
." start : " dup fsm>start ? cr
." current : " dup fsm>current ? cr
." events : " fsm>events ? cr
;
[THEN]
\ ==============================================================================