[Gd-chatter] r11473 - in trunk/libraries: . layer network/ip-stack network/ip-stack/state-machines network/ip-stack/state-machines/dhcp network/ip-stack/state-machines/tcp packetizer protocols registry/generic tcp utilities/state-machine
hannes at gwydiondylan.org
hannes at gwydiondylan.org
Sun Oct 28 02:46:27 CEST 2007
Author: hannes
Date: Sun Oct 28 02:46:26 2007
New Revision: 11473
Added:
trunk/libraries/network/ip-stack/
trunk/libraries/network/ip-stack/state-machines/
trunk/libraries/network/ip-stack/state-machines/dhcp/
trunk/libraries/network/ip-stack/state-machines/dhcp/dhcp.dylan (contents, props changed)
trunk/libraries/network/ip-stack/state-machines/dhcp/dhcp.lid (contents, props changed)
trunk/libraries/network/ip-stack/state-machines/dhcp/library.dylan (contents, props changed)
trunk/libraries/network/ip-stack/state-machines/tcp/
- copied from r11471, trunk/libraries/tcp/
trunk/libraries/registry/generic/dhcp-state-machine (contents, props changed)
trunk/libraries/registry/generic/state-machine (contents, props changed)
trunk/libraries/utilities/state-machine/
trunk/libraries/utilities/state-machine/library.dylan (contents, props changed)
trunk/libraries/utilities/state-machine/state-machine.dylan (contents, props changed)
trunk/libraries/utilities/state-machine/state-machine.lid (contents, props changed)
Removed:
trunk/libraries/tcp/
Modified:
trunk/libraries/layer/layer.dylan
trunk/libraries/network/ip-stack/state-machines/tcp/library.dylan
trunk/libraries/network/ip-stack/state-machines/tcp/module.dylan
trunk/libraries/network/ip-stack/state-machines/tcp/tcp.dylan
trunk/libraries/packetizer/leaf-frames.dylan
trunk/libraries/packetizer/module.dylan
trunk/libraries/protocols/dhcp.dylan
trunk/libraries/protocols/protocols-library.dylan
trunk/libraries/registry/generic/tcp-state-machine
trunk/libraries/reorg.txt
Log:
Job: 7299
*better support for dhcp in protocols
*introduce network/ip-stack, currently used for state-machines
*generalize code from tcp-state-machine into state-machine
*introduce dhcp-state-machine
*introduce initial dhcp-client support in layer (does not work yet)
*update reorg.txt
Modified: trunk/libraries/layer/layer.dylan
==============================================================================
--- trunk/libraries/layer/layer.dylan (original)
+++ trunk/libraries/layer/layer.dylan Sun Oct 28 02:46:26 2007
@@ -709,6 +709,10 @@
default-gateway :: <ipv4-address> = ipv4-address("192.168.0.1"),
netmask :: <integer> = 24)
let arp-handler = make(<arp-handler>);
+ arp-handler.arp-table[ipv4-address("255.255.255.255")]
+ := make(<static-arp-entry>,
+ ip-address: ipv4-address("255.255.255.255"),
+ mac-address: mac-address("00:00:00:00:00:00"));
let ip-layer = make(<ip-layer>);
let ip-over-ethernet = make(<ip-over-ethernet-adapter>,
ethernet: ethernet-layer,
@@ -726,8 +730,3 @@
// icmp-handler: icmp-handler);
values(ip-layer, ip-over-ethernet);
end;
-
-
-
-
-
Added: trunk/libraries/network/ip-stack/state-machines/dhcp/dhcp.dylan
==============================================================================
--- (empty file)
+++ trunk/libraries/network/ip-stack/state-machines/dhcp/dhcp.dylan Sun Oct 28 02:46:26 2007
@@ -0,0 +1,41 @@
+Module: dhcp-state-machine
+Author: Hannes Mehnert
+Copyright: (C) 2007, All rights reversed.
+
+define abstract class <dhcp-state> (<protocol-state>) end;
+
+define open class <dhcp-client-state> (<protocol-state-encapsulation>)
+ inherited slot state = make(<init>);
+ slot xid;
+ slot offer;
+end;
+
+states(<init-reboot>, <rebooting>, <requesting>, <init>,
+ <selecting>, <rebinding>, <bound>, <renewing>; <dhcp-state>);
+
+define constant <dhcp-events>
+ = one-of(#"send-discover", #"send-request", #"receive-nak", #"receive-ack",
+ #"receive-offer", #"receive-ack-send-decline", #"timeout-t1-expires",
+ #"timeout-t2-expires", #"lease-expired");
+
+define state-transition-rule <init> #"send-discover" <selecting> end;
+define state-transition-rule <init-reboot> #"send-request" <rebooting> end;
+define state-transition-rule <rebooting> #"receive-nak" <init> end;
+define state-transition-rule <rebooting> #"receive-ack" <bound> end;
+define state-transition-rule <selecting> #"send-request" <requesting> end;
+define state-transition-rule <selecting> #"receive-offer" <selecting> end;
+define state-transition-rule <requesting> #"receive-offer" <requesting> end;
+define state-transition-rule <requesting> #"receive-nak" <init> end;
+define state-transition-rule <requesting> #"receive-ack" <bound> end;
+define state-transition-rule <requesting> #"receive-ack-send-decline" <init> end;
+define state-transition-rule <bound> #"receive-offer" <bound> end;
+define state-transition-rule <bound> #"receive-ack" <bound> end;
+define state-transition-rule <bound> #"receive-nak" <bound> end;
+define state-transition-rule <bound> #"timeout-t1-expires" <renewing> end;
+define state-transition-rule <rebinding> #"receive-ack" <bound> end;
+define state-transition-rule <rebinding> #"receive-nak" <init> end;
+define state-transition-rule <rebinding> #"lease-expired" <init> end;
+define state-transition-rule <renewing> #"receive-ack" <bound> end;
+define state-transition-rule <renewing> #"timeout-t2-expires" <rebinding> end;
+define state-transition-rule <renewing> #"receive-nak" <init> end;
+
Added: trunk/libraries/network/ip-stack/state-machines/dhcp/dhcp.lid
==============================================================================
--- (empty file)
+++ trunk/libraries/network/ip-stack/state-machines/dhcp/dhcp.lid Sun Oct 28 02:46:26 2007
@@ -0,0 +1,3 @@
+Library: dhcp-state-machine
+Files: library
+ dhcp
Added: trunk/libraries/network/ip-stack/state-machines/dhcp/library.dylan
==============================================================================
--- (empty file)
+++ trunk/libraries/network/ip-stack/state-machines/dhcp/library.dylan Sun Oct 28 02:46:26 2007
@@ -0,0 +1,22 @@
+module: dylan-user
+
+define library dhcp-state-machine
+ use dylan;
+ use common-dylan;
+ use state-machine;
+ export dhcp-state-machine;
+end;
+
+define module dhcp-state-machine
+ use dylan;
+ use common-dylan;
+ use state-machine;
+
+ export <dhcp-client-state>, offer, xid,
+ offer-setter, xid-setter;
+
+ export <init-reboot>, <rebooting>,
+ <requesting>, <init>,
+ <selecting>, <rebinding>,
+ <bound>, <renewing>, <dhcp-state>;
+end;
Modified: trunk/libraries/network/ip-stack/state-machines/tcp/library.dylan
==============================================================================
--- trunk/libraries/tcp/library.dylan (original)
+++ trunk/libraries/network/ip-stack/state-machines/tcp/library.dylan Sun Oct 28 02:46:26 2007
@@ -6,6 +6,7 @@
define library tcp-state-machine
use common-dylan;
use io;
+ use state-machine;
export tcp-state-machine;
end library tcp-state-machine;
Modified: trunk/libraries/network/ip-stack/state-machines/tcp/module.dylan
==============================================================================
--- trunk/libraries/tcp/module.dylan (original)
+++ trunk/libraries/network/ip-stack/state-machines/tcp/module.dylan Sun Oct 28 02:46:26 2007
@@ -9,6 +9,7 @@
use format-out;
use standard-io;
use streams, import: { read-line };
+ use state-machine;
export <tcp-dingens>, state, lock;
@@ -17,6 +18,6 @@
<fin-wait1>, <fin-wait2>, <closing>,
<time-wait>, <close-wait>, <last-ack>;
- export <tcp-events>, state-transition, process-event;
+ export <tcp-events>;
end module tcp-state-machine;
Modified: trunk/libraries/network/ip-stack/state-machines/tcp/tcp.dylan
==============================================================================
--- trunk/libraries/tcp/tcp.dylan (original)
+++ trunk/libraries/network/ip-stack/state-machines/tcp/tcp.dylan Sun Oct 28 02:46:26 2007
@@ -3,60 +3,15 @@
Author: Andreas Bogk, Hannes Mehnert
Copyright: (C) 2006, All rights reserved.
-define open class <tcp-dingens> (<object>)
- constant slot lock :: <simple-lock> = make(<simple-lock>);
- slot state :: <tcp-state> = make(<closed>);
+define open class <tcp-dingens> (<protocol-state-encapsulation>)
+ inherited slot state = make(<closed>);
end;
-define abstract class <tcp-state> (<object>)
-end;
-
-define macro singleton-class-definer
- { define singleton-class ?:name (?superclass:name) ?slots:* end }
- =>
- { define class ?name (?superclass) ?slots end;
- define variable "*" ## ?name ## "-instance*" :: false-or(?name) = #f;
- define method make (class == ?name,
- #next next-method, #rest rest, #key, #all-keys)
- => (instance :: ?name);
- "*" ## ?name ## "-instance*"
- | ("*" ## ?name ## "-instance*" := next-method())
- end;
- }
-end;
-
-define singleton-class <closed> (<tcp-state>)
-end;
+define abstract class <tcp-state> (<protocol-state>) end;
-define singleton-class <listen> (<tcp-state>)
-end;
-
-define singleton-class <syn-sent> (<tcp-state>)
-end;
-
-define singleton-class <syn-received> (<tcp-state>)
-end;
-
-define singleton-class <established> (<tcp-state>)
-end;
-
-define singleton-class <fin-wait1> (<tcp-state>)
-end;
-
-define singleton-class <fin-wait2> (<tcp-state>)
-end;
-
-define singleton-class <closing> (<tcp-state>)
-end;
-
-define singleton-class <time-wait> (<tcp-state>)
-end;
-
-define singleton-class <close-wait> (<tcp-state>)
-end;
-
-define singleton-class <last-ack> (<tcp-state>)
-end;
+states(<closed>, <listen>, <syn-sent>, <syn-received>,
+ <established>, <fin-wait1>, <fin-wait2>, <closing>,
+ <time-wait>, <close-wait>, <last-ack>; <tcp-state>);
define constant <tcp-events>
= one-of(#"passive-open", #"active-open", #"close", #"syn-received",
@@ -64,162 +19,30 @@
#"ack-received", #"fin-ack-received", #"2msl-timeout",
#"last-ack-received");
-define generic next-state (state :: <tcp-state>, event :: <tcp-events>)
- => (res :: <tcp-state>);
-
-define method next-state (state :: <tcp-state>, event :: <tcp-events>)
- => (res :: <tcp-state>)
- state
-end;
-
-define method next-state (state :: <tcp-state>,
- event == #"rst-received")
- => (res :: <tcp-state>)
- make(<closed>)
-end;
-
-define method next-state (state :: <closed>,
- event == #"active-open")
- => (res :: <tcp-state>)
- make(<syn-sent>)
-end;
-define method next-state (state :: <closed>,
- event == #"passive-open")
- => (new-state :: <tcp-state>);
- make(<listen>)
-end;
-define method next-state (state :: <listen>,
- event == #"syn-received")
- => (new-state :: <tcp-state>);
- make(<syn-received>)
-end;
+define state-transition-rule <tcp-state> #"rst-received" <closed> end;
+define state-transition-rule <closed> #"active-open" <syn-sent> end;
+define state-transition-rule <closed> #"passive-open" <listen> end;
+define state-transition-rule <listen> #"syn-received" <syn-received> end;
+define state-transition-rule <syn-sent> #"close" <closed> end;
+define state-transition-rule <syn-sent> #"syn-received" <syn-received> end;
+define state-transition-rule <syn-sent> #"syn-ack-received" <established> end;
+define state-transition-rule <syn-received> #"rst-received" <listen> end;
+define state-transition-rule <syn-received> #"last-ack-received" <established> end;
+define state-transition-rule <syn-received> #"close" <fin-wait1> end;
+define state-transition-rule <established> #"close" <fin-wait1> end;
+define state-transition-rule <established> #"fin-received" <close-wait> end;
+define state-transition-rule <established> #"fin-ack-received" <close-wait> end;
+define state-transition-rule <close-wait> #"close" <last-ack> end;
+define state-transition-rule <last-ack> #"last-ack-received" <closed> end;
+define state-transition-rule <fin-wait1> #"fin-received" <closing> end;
+define state-transition-rule <fin-wait1> #"last-ack-received" <fin-wait2> end;
+define state-transition-rule <fin-wait1> #"fin-ack-received" <time-wait> end;
+define state-transition-rule <fin-wait2> #"fin-received" <time-wait> end;
+define state-transition-rule <fin-wait2> #"fin-ack-received" <time-wait> end;
+define state-transition-rule <closing> #"last-ack-received" <time-wait> end;
+define state-transition-rule <time-wait> #"2msl-timeout" <closed> end;
-define method next-state (state :: <syn-sent>,
- event == #"close")
- => (new-state :: <tcp-state>);
- make(<closed>)
-end;
-
-define method next-state (state :: <syn-sent>,
- event == #"syn-received")
- => (new-state :: <tcp-state>);
- make(<syn-received>)
-end;
-
-define method next-state (state :: <syn-sent>,
- event == #"syn-ack-received")
- => (new-state :: <tcp-state>);
- make(<established>)
-end;
-
-define method next-state (old-state :: <syn-received>,
- event == #"rst-received")
- => (new-state :: <tcp-state>);
- make(<listen>)
-end;
-
-define method next-state (old-state :: <syn-received>,
- event == #"last-ack-received")
- => (new-state :: <tcp-state>);
- make(<established>)
-end;
-
-define method next-state (old-state :: <syn-received>,
- event == #"close")
- => (new-state :: <tcp-state>);
- make(<fin-wait1>)
-end;
-
-define method next-state (old-state :: <established>,
- event == #"close")
- => (new-state :: <tcp-state>);
- make(<fin-wait1>)
-end;
-
-define method next-state (old-state :: <established>,
- event == #"fin-received")
- => (new-state :: <tcp-state>);
- make(<close-wait>)
-end;
-
-define method next-state (old-state :: <established>,
- event == #"fin-ack-received")
- => (new-state :: <tcp-state>);
- make(<close-wait>)
-end;
-
-define method next-state (old-state :: <close-wait>,
- event == #"close")
- => (new-state :: <tcp-state>);
- make(<last-ack>)
-end;
-
-define method next-state (old-state :: <last-ack>,
- event == #"last-ack-received")
- => (new-state :: <tcp-state>);
- make(<closed>)
-end;
-
-define method next-state (old-state :: <fin-wait1>,
- event == #"fin-received")
- => (new-state :: <tcp-state>);
- make(<closing>)
-end;
-
-define method next-state (old-state :: <fin-wait1>,
- event == #"last-ack-received")
- => (new-state :: <tcp-state>);
- make(<fin-wait2>)
-end;
-
-define method next-state (old-state :: <fin-wait1>,
- event == #"fin-ack-received")
- => (new-state :: <tcp-state>);
- make(<time-wait>)
-end;
-
-define method next-state (old-state :: <fin-wait2>,
- event == #"fin-received")
- => (new-state :: <tcp-state>);
- make(<time-wait>)
-end;
-
-define method next-state (old-state :: <fin-wait2>,
- event == #"fin-ack-received")
- => (new-state :: <tcp-state>);
- make(<time-wait>)
-end;
-
-define method next-state (old-state :: <closing>,
- event == #"last-ack-received")
- => (new-state :: <tcp-state>);
- make(<time-wait>)
-end;
-
-define method next-state (state :: <time-wait>,
- event == #"2msl-timeout")
- => (new-state :: <tcp-state>)
- make(<closed>)
-end;
-
-define method process-event (dingens :: <tcp-dingens>, event :: <tcp-events>)
- let old-state = dingens.state;
- let new-state = next-state(old-state, event);
- format-out("State transition %= => %=\n", old-state, new-state);
- dingens.state := new-state;
- state-transition(dingens, old-state, new-state);
-end;
-
-define open generic state-transition (dingens :: <tcp-dingens>,
- old-state :: <tcp-state>,
- new-state :: <tcp-state>) => ();
-
-define method state-transition (dingens :: <tcp-dingens>,
- old-state :: <tcp-state>,
- new-state :: <tcp-state>) => ()
- ignore(dingens, old-state, new-state)
-end;
/*
begin
@@ -228,19 +51,21 @@
let line = read-line(*standard-input*);
let event =
select(line by \=)
- "po" => passive-open;
- "ao" => active-open;
- "c" => close;
- "s" => syn-received;
- "sa" => syn-ack-received;
- "r" => rst-received;
- "f" => fin-received;
- "a" => ack-received;
- "fa" => fin-ack-received;
+ "po" => #"passive-open";
+ "ao" => #"active-open";
+ "c" => #"close";
+ "s" => #"syn-received";
+ "sa" => #"syn-ack-received";
+ "r" => #"rst-received";
+ "f" => #"fin-received";
+ "a" => #"ack-received";
+ "fa" => #"fin-ack-received";
end;
- event(tcp)
+ process-event(tcp, event);
end
-end; */
+end;
+*/
+
/*
closed; application: open; syn-sent; frame: syn
listen; frame: syn; syn-received; frame: syn & ack
Modified: trunk/libraries/packetizer/leaf-frames.dylan
==============================================================================
--- trunk/libraries/packetizer/leaf-frames.dylan (original)
+++ trunk/libraries/packetizer/leaf-frames.dylan Sun Oct 28 02:46:26 2007
@@ -433,6 +433,9 @@
define class <externally-delimited-string> (<variable-size-byte-vector>)
end;
+define constant $empty-externally-delimited-string
+ = make(<externally-delimited-string>, data: make(<byte-sequence>, capacity: 0));
+
define method as (class == <string>, frame :: <externally-delimited-string>)
=> (res :: <string>)
let res = make(<string>, size: byte-offset(frame-size(frame)));
@@ -452,6 +455,9 @@
define class <raw-frame> (<variable-size-byte-vector>)
end;
+define constant $empty-raw-frame
+ = make(<raw-frame>, data: make(<byte-sequence>, capacity: 0));
+
define method as (class == <string>, frame :: <raw-frame>) => (res :: <string>)
let out-stream = make(<string-stream>, direction: #"output");
block()
Modified: trunk/libraries/packetizer/module.dylan
==============================================================================
--- trunk/libraries/packetizer/module.dylan (original)
+++ trunk/libraries/packetizer/module.dylan Sun Oct 28 02:46:26 2007
@@ -43,6 +43,8 @@
export <variable-size-byte-vector>, <externally-delimited-string>,
<raw-frame>;
+
+ export $empty-externally-delimited-string, $empty-raw-frame;
//XXX: evil hacks
export float-to-byte-vector-le, byte-vector-to-float-le,
Modified: trunk/libraries/protocols/dhcp.dylan
==============================================================================
--- trunk/libraries/protocols/dhcp.dylan (original)
+++ trunk/libraries/protocols/dhcp.dylan Sun Oct 28 02:46:26 2007
@@ -10,17 +10,24 @@
field hardware-address-length :: <unsigned-byte> = 6;
field hops :: <unsigned-byte> = 0;
field transaction-id :: <big-endian-unsigned-integer-4byte>;
- field seconds-since-address-acquisition :: <2byte-big-endian-unsigned-integer>;
- field broadcast-flag :: <1bit-unsigned-integer>;
+ field seconds-since-address-acquisition
+ :: <2byte-big-endian-unsigned-integer> = 0;
+ field broadcast-flag :: <1bit-unsigned-integer> = 0;
field reserved :: <15bit-unsigned-integer> = 0;
- field client-ip-address :: <ipv4-address>;
- field your-ip-address :: <ipv4-address>;
- field server-ip-address :: <ipv4-address>;
- field relay-agent-ip-address :: <ipv4-address>;
- field client-hardware-address :: <raw-frame>, static-length: 16 * 8;
- field server-name :: <externally-delimited-string>, static-length: 64 * 8;
- field boot-file-name :: <externally-delimited-string>, static-length: 128 * 8;
- field magic-cookie :: <big-endian-unsigned-integer-4byte>; //#x63 #x82 #x53 #x63
+ field client-ip-address :: <ipv4-address> = ipv4-address("0.0.0.0");
+ field your-ip-address :: <ipv4-address> = ipv4-address("0.0.0.0");
+ field server-ip-address :: <ipv4-address> = ipv4-address("0.0.0.0");
+ field relay-agent-ip-address :: <ipv4-address> = ipv4-address("0.0.0.0");
+ field client-hardware-address :: <raw-frame> = $empty-raw-frame,
+ static-length: 16 * 8;
+ field server-name :: <externally-delimited-string>
+ = $empty-externally-delimited-string,
+ static-length: 64 * 8;
+ field boot-file-name :: <externally-delimited-string>
+ = $empty-externally-delimited-string,
+ static-length: 128 * 8;
+ field magic-cookie :: <big-endian-unsigned-integer-4byte>
+ = big-endian-unsigned-integer-4byte(#(#x63, #x82, #x53, #x63));
repeated field dhcp-options :: <dhcp-option>,
reached-end?: instance?(frame, <dhcp-end-option>);
end;
Modified: trunk/libraries/protocols/protocols-library.dylan
==============================================================================
--- trunk/libraries/protocols/protocols-library.dylan (original)
+++ trunk/libraries/protocols/protocols-library.dylan Sun Oct 28 02:46:26 2007
@@ -313,7 +313,15 @@
define module dhcp
use common-dylan;
use packetizer;
- use ipv4, import: { <ipv4-address>, <udp-frame> };
+ use ipv4, import: { <ipv4-address>, <udp-frame>, ipv4-address };
+ export <dhcp-message>,
+ <dhcp-message-type-option>,
+ <dhcp-requested-ip-address-option>,
+ <dhcp-server-identifier-option>,
+ message-type,
+ dhcp-options,
+ your-ip-address,
+ server-ip-address;
end;
define module dns
Added: trunk/libraries/registry/generic/dhcp-state-machine
==============================================================================
--- (empty file)
+++ trunk/libraries/registry/generic/dhcp-state-machine Sun Oct 28 02:46:26 2007
@@ -0,0 +1 @@
+abstract://dylan/network/ip-stack/state-machines/dhcp/dhcp.lid
Added: trunk/libraries/registry/generic/state-machine
==============================================================================
--- (empty file)
+++ trunk/libraries/registry/generic/state-machine Sun Oct 28 02:46:26 2007
@@ -0,0 +1 @@
+abstract://dylan/utilities/state-machine/state-machine.lid
Modified: trunk/libraries/registry/generic/tcp-state-machine
==============================================================================
--- trunk/libraries/registry/generic/tcp-state-machine (original)
+++ trunk/libraries/registry/generic/tcp-state-machine Sun Oct 28 02:46:26 2007
@@ -1 +1 @@
-abstract://dylan/tcp/tcp.hdp
+abstract://dylan/network/ip-stack/state-machines/tcp/tcp.hdp
Modified: trunk/libraries/reorg.txt
==============================================================================
--- trunk/libraries/reorg.txt (original)
+++ trunk/libraries/reorg.txt Sun Oct 28 02:46:26 2007
@@ -44,6 +44,9 @@
sniffer
tcp
vector-table
+ state-machines
+ tcp
+ dhcp
koala
xml-rpc-client
wiki
@@ -88,6 +91,7 @@
gtk+
utilities
channels
- getopt // Rename to command-line-parser?
+ command-line-parser
timer
commands
+ state-machine
Added: trunk/libraries/utilities/state-machine/library.dylan
==============================================================================
--- (empty file)
+++ trunk/libraries/utilities/state-machine/library.dylan Sun Oct 28 02:46:26 2007
@@ -0,0 +1,28 @@
+Module: dylan-user
+Synopsis: State Machine definition macros
+Author: Hannes Mehnert
+Copyright: (C) 2007, All rights reversed.
+
+define library state-machine
+ use common-dylan;
+ use system;
+ use io;
+
+ export state-machine;
+end library state-machine;
+
+define module state-machine
+ use common-dylan;
+ use threads;
+ use format-out;
+
+ export <protocol-state>,
+ singleton-class-definer,
+ states,
+ next-state,
+ state-transition-rule-definer;
+
+ export <protocol-state-encapsulation>,
+ lock, state,
+ process-event, state-transition;
+end module state-machine;
Added: trunk/libraries/utilities/state-machine/state-machine.dylan
==============================================================================
--- (empty file)
+++ trunk/libraries/utilities/state-machine/state-machine.dylan Sun Oct 28 02:46:26 2007
@@ -0,0 +1,69 @@
+Module: state-machine
+Synopsis: State Machine definition macros
+Author: Hannes Mehnert
+Copyright: (C) 2007, All rights reversed.
+
+
+define open abstract class <protocol-state> (<object>) end;
+
+define open abstract class <protocol-state-encapsulation> (<object>)
+ constant slot lock :: <simple-lock> = make(<simple-lock>);
+ slot state :: <protocol-state>;
+end;
+
+define macro singleton-class-definer
+ { define singleton-class ?:name (?superclass:name) ?slots:* end }
+ =>
+ { define class ?name (?superclass) ?slots end;
+ define variable "*" ## ?name ## "-instance*" :: false-or(?name) = #f;
+ define method make (class == ?name,
+ #next next-method, #rest rest, #key, #all-keys)
+ => (instance :: ?name);
+ "*" ## ?name ## "-instance*"
+ | ("*" ## ?name ## "-instance*" := next-method())
+ end;
+ }
+end;
+
+define macro states
+ { states(?state:name; ?superstate:name) }
+ => { define singleton-class ?state (?superstate) end }
+ { states(?state:name, ?rest:*; ?superstate:name) }
+ =>
+ { define singleton-class ?state (?superstate) end;
+ states(?rest; ?superstate) }
+end;
+
+define open generic next-state (state :: <protocol-state>, event :: <symbol>)
+ => (res :: <protocol-state>);
+
+define method next-state (state :: <protocol-state>, event :: <symbol>)
+ => (res :: <protocol-state>)
+ state
+end;
+
+define method process-event (dingens :: <protocol-state-encapsulation>, event :: <symbol>)
+ let old-state = dingens.state;
+ let new-state = next-state(old-state, event);
+ format-out("State transition %= => %=\n", old-state, new-state);
+ dingens.state := new-state;
+ state-transition(dingens, old-state, new-state);
+end;
+
+define open generic state-transition (dingens :: <protocol-state-encapsulation>,
+ old-state :: <protocol-state>,
+ new-state :: <protocol-state>) => ();
+
+define method state-transition (dingens :: <protocol-state-encapsulation>,
+ old-state :: <protocol-state>,
+ new-state :: <protocol-state>) => ()
+ ignore(dingens, old-state, new-state)
+end;
+
+define macro state-transition-rule-definer
+ { define state-transition-rule ?old-state:name ?event:expression ?new-state:name end }
+ => { define method next-state (state :: ?old-state, event == ?event)
+ => (result-state :: ?new-state)
+ make(?new-state)
+ end }
+end;
Added: trunk/libraries/utilities/state-machine/state-machine.lid
==============================================================================
--- (empty file)
+++ trunk/libraries/utilities/state-machine/state-machine.lid Sun Oct 28 02:46:26 2007
@@ -0,0 +1,4 @@
+library: state-machine
+files: library
+ state-machine
+
More information about the chatter
mailing list