????
Your IP : 216.73.216.143
[= AutoGen5 Template -*- Mode: Scheme -*-
#; This file is part of AutoGen.
#; AutoGen Copyright (C) 1992-2018 by Bruce Korb - all rights reserved
#;
#; AutoGen is free software: you can redistribute it and/or modify it
#; under the terms of the GNU General Public License as published by the
#; Free Software Foundation, either version 3 of the License, or
#; (at your option) any later version.
#;
#; AutoGen 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 General Public License for more details.
#;
#; You should have received a copy of the GNU General Public License along
#; with this program. If not, see <http://www.gnu.org/licenses/>.
=][=
(define exit-proc (get "exit-proc" "exit"))
=][=
DEFINE emit-invalid-msg =][=
;; "defs" indexes will be diverted.
(define tmp-text "")
(define str-table (string-append "z" Pfx "Strings"))
(string-table-new str-table)
(define add-tbl-str (lambda (ent-str)
(set! index-list (string-append index-list
(number->string (string-table-add str-table ent-str)) "\n" )) ))
(string-table-add str-table "** OUT-OF-RANGE **")
(ag-fprintf 0 "\n#define %sFsmErr_off %d\n" Pfx
(string-table-add str-table
"FSM Error: in state %d (%s), event %d (%s) is invalid\n"))
(define invalid-ix (string-table-add str-table "invalid"))
(ag-fprintf 0 "#define %sEvInvalid_off %d\n" Pfx invalid-ix)
(define index-list (sprintf "%d\n" (string-table-add str-table "init")))
(ag-fprintf 0 "#define %sStInit_off %s\n" Pfx index-list)
(out-push-new)
=][=
FOR state =][=
(add-tbl-str (get-down "state")) =][=
ENDFOR state =][=
(ag-fprintf 0 "\nstatic const size_t asz%sStates[%d] = {\n"
Pfx (+ 1 (count "state")) )
(emit (shell (string-append
"${CLexe-columns} --spread=1 -I4 -S, <<_EOF_\n"
index-list
"_EOF_"
)))
(set! index-list "")
" };\n" =][=
FOR event =][=
(set! tmp-text (get "event"))
(set! tmp-text
(if (exist? tmp-text) (get tmp-text) (string-downcase! tmp-text)))
(add-tbl-str tmp-text)
=][=
ENDFOR event =][=
(ag-fprintf 0 "\nstatic const size_t asz%sEvents[%d] = {\n"
Pfx (+ 1 (count "event")) )
(emit (shell (string-append
"${CLexe-columns} --spread=1 -I4 -S, <<_EOF_\n"
index-list
(sprintf "%d\n" invalid-ix)
"_EOF_")))
(emit " };\n")
(out-suspend "strings")
(emit-string-table str-table)
(out-resume "strings")
(emit (out-pop #t)) =]
#define [=(. PFX)
=]_EVT_NAME(t) ( (((unsigned)(t)) >= [=(+ 1 (count "event"))=]) \
? z[=(. Pfx)=]Strings : z[=(. Pfx)
=]Strings + asz[=(. Pfx)=]Events[t])
#define [=(. PFX)
=]_STATE_NAME(s) ( (((unsigned)(s)) >= [=(+ 1 (count "state"))=]) \
? z[=(. Pfx)=]Strings : z[=(. Pfx)
=]Strings + asz[=(. Pfx)=]States[s])
#ifndef EXIT_FAILURE
# define EXIT_FAILURE 1
#endif
static int [=(. pfx)=]_invalid_transition( te_[=(. pfx)=]_state st, te_[=
(. pfx)=]_event evt );
[=
IF (not (exist? "handler-file")) =]
/* * * * * * * * * THE CODE STARTS HERE * * * * * * * */
/**
* Print out an invalid transition message and return EXIT_FAILURE
*/
static int
[=(. pfx)=]_invalid_transition( te_[=(. pfx)=]_state st, te_[=
(. pfx)=]_event evt )
{
[=
(set! tmp-text (sprintf "\
char const * fmt = z%1$sStrings + %1$sFsmErr_off;
fprintf( stderr, fmt, st, %2$s_STATE_NAME(st), evt, %2$s_EVT_NAME(evt));"
Pfx PFX ))
(extract fsm-source " /* %s == INVALID TRANS MSG == %s */" "" tmp-text)=]
return EXIT_FAILURE;
}
[=
ENDIF not exist handler-file =][=
ENDDEF emit-invalid-msg
;;; # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # =][=
DEFINE emit-cookie-args =][=
FOR cookie =]
[=cookie=],[=
ENDFOR =][=
ENDDEF emit-cookie-args
;;; # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # =][=
DEFINE build-callback =][=
CASE cb-name =][=
= noop =][=
* =]
static te_[=(. pfx)=]_state
[=cb_prefix=]_[=cb_name=]([= INVOKE emit-cookie-args =]
te_[=(. pfx)=]_state initial,
te_[=(. pfx)=]_state maybe_next,
te_[=(. pfx)=]_event trans_evt)
{
[= (extract fsm-source (string-append
"/* %s == " (string-tr! (get "cb_name") "a-z_-" "A-Z ") " == %s */" )
""
(if (= (get "cb-name") "invalid")
(string-append " " exit-proc "(" pfx
"_invalid_transition(initial, trans_evt));")
" return maybe_next;" )) =]
}
[=
ESAC =][=
ENDDEF build-callback
# # # # # # # =][=
DEFINE callbacks =][=
`set -- \`sed 's/,//' ${tmp_dir}/xlist\`` =][=
WHILE `echo $#` =][=
INVOKE build-callback
cb_prefix = (string-append pfx "_do")
cb_name = (shell "echo $1 ; shift") =][=
ENDWHILE echo $# =][=
ENDDEF callbacks
# # # # # # # =][=
DEFINE run-callback
=]
if (pT != NULL)
nxtSt = (*pT)( [=
FOR cookie =][=
(shellf "echo '%s'|sed 's,.*[ \t*],,'" (get "cookie")) =], [=
ENDFOR =][=(. pfx)=]_state, nxtSt, trans_evt );[=
ENDDEF run-callback
;;; # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # =][=
DEFINE build-switch =]
case [=cb_prefix=]_[=cb_name=]:[=
IF (== (get "cb_name") "NOOP") =] break;[=
ELSE =]
[=
(set! example-code (if (= (get "cb_name") "invalid") (string-append
" " exit-proc "(" pfx "_invalid_transition(" pfx
"_state, trans_evt));")
(string-append " nxtSt = HANDLE_" (get "cb_name") "();") ))
(extract fsm-source
(string-append " /* %s == " (get "cb_name") " == %s */")
"" example-code ) =]
break;
[=ENDIF=][=
ENDDEF build-switch
;;; # # # # # =][=
DEFINE run-switch =][=
(define example-code "") =]
switch (trans) {[=
`set -- \`sed 's/,//' ${tmp_dir}/xlist\`` =][=
WHILE `echo $#` =][=
INVOKE build-switch
cb_prefix = (string-append PFX "_TR")
cb_name = (shell "echo $1 ; shift") =][=
ENDWHILE echo $# =]
default:
[=(extract fsm-source " /* %s == BROKEN MACHINE == %s */" ""
(string-append " " exit-proc "(" pfx "_invalid_transition("
pfx "_state, trans_evt));" ))=]
}[=
ENDDEF run-switch
;;; # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # =][=
DEFINE preamble =][=
IF (emit (dne " * " "/* "))
(== (suffix) "c") =][=
(set! fsm-source (string-append tmp-dir "/fsm.code"))
(set-writable) =][=
ELSE =][=
(make-tmp-dir)
(define fsm-source (string-append tmp-dir "/fsm.header"))
(shellf "test -f %1$s-fsm.h && cp %1$s-fsm.h ${tmp_dir}/fsm.header
test -f %1$s-fsm.c && cp %1$s-fsm.c ${tmp_dir}/fsm.code" (base-name))
(define pfx (string->c-name! (string-downcase!
(if (exist? "prefix") (get "prefix") (base-name)) )))
(define PFX (string-upcase pfx))
(define Pfx (string-capitalize pfx))
(define t-trans (string-append "t_" pfx "_transition"))
=][=
ENDIF =]
*
* Automated Finite State Machine
*
* [=(. cright-years)=]
*
[=(license-description "mbsd" "AutoFSM" " * " "Bruce Korb")=]
*/[=
ENDDEF preamble
;;; # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # =][=
DEFINE compute-transitions =][=
;;; Initialize every possible transition as invalid
;;;
(define tr-name (if (=* (get "method") "call")
(string-append pfx "_do_invalid")
(string-append PFX "_TR_INVALID") ))
(shellf
"ev_list='%s' ; st_list='INIT %s'
for f in $ev_list ; do for g in $st_list
do eval FSM_TRANS_${g}_${f}=\"'{ %s_ST_INVALID, %s }'\"
export FSM_TRANS_${g}_${f}
done ; done"
(stack-up "event")
(stack-up "state")
PFX tr-name )
(define tev "")
(define tst "")
(define ttype "")
(define next "")
(define proc-ptr-type
(lambda (tp)
(if (= tp "noop") "NULL"
(string-downcase! (string-append pfx "_do_" tp)) )))
=][=#
;;; Now replace the initial values with proper ones gotten from
;;; the trasition definitions.
;;;
;;; It is actually possible to have multiple specifications for a
;;; single state/event pair, however the last state/event assignment
;;; will supply the value for the transition table. Different
;;; transitions may also specify the same transition method.
;;; For that, we unique sort the list and eliminate dups.
;;; The unique-ified list is used to produce the callout table.
;;;
=][=
FOR transition =][=
IF (== (get "tst") "*") =][=
;; This transition applies for all states
;;
(set! tev (get-up "tev"))
(set! ttype (if (exist? "ttype") (get "ttype")
(string-append "${f}_" tev) ))
(set! tr-name (if (=* (get "method") "call")
(proc-ptr-type ttype)
(string-upcase! (string-append PFX "_TR_" ttype)) ))
(set! next (if (exist? "next") (get-up "next") "${f}"))
(shellf
"for f in ${st_list} ; do F=${f}
eval FSM_TRANS_${f}_%s=\"'{ %s_ST_%s, %s }'\"
done"
tev PFX next tr-name ) =][=
ELIF (== (get "tev") "*") =][=
;; This transition applies for all transitions in a certain state
;;
(set! tst (get-up "tst"))
(set! ttype (if (exist? "ttype")
(get-up "ttype") (string-append tst "_${f}") ))
(set! tr-name (if (=* (get "method") "call")
(proc-ptr-type ttype)
(string-append PFX "_TR_" ttype) ))
(set! next (if (exist? "next") (get-up "next") tst))
(shellf
"for f in ${ev_list} ; do
eval FSM_TRANS_%s_${f}=\"'{ %s_ST_%s, %s }'\"
done"
tst PFX next tr-name) =][=
ELSE =][=
FOR tst =][=
(set! tst (get-up "tst"))
(set! next (if (exist? "next") (get-up "next") tst))
=][=
FOR tev =][=
(set! tev (get-up "tev"))
(set! ttype (string-downcase! (if (exist? "ttype") (get "ttype")
(string-append tst "_" tev) )))
(set! tr-name (if (=* (get "method") "call")
(proc-ptr-type ttype)
(string-upcase! (string-append PFX "_TR_" ttype)) ))
(shellf "FSM_TRANS_%s_%s=\"{ %s_ST_%s, %s }\""
tst tev PFX next tr-name) =][=
ENDFOR tev =][=
ENDFOR tst =][=
ENDIF tst or ttkn as '*' =][=
ENDFOR transition =][=
(define trans-ct
(shellf
"env | egrep '^FSM_TRANS_' | \
sed '/, NULL }/d;s/^.*%s//;s/ .*$/,/' | \
sort -u > ${tmp_dir}/xlist
echo `wc -l < ${tmp_dir}/xlist` "
(if (=* (get "method") "call")
(string-append pfx "_do_")
(string-append PFX "_TR_"))
) ) =][=
ENDDEF compute-transitions
# end of agen5/fsm-macro.tlib =]