From 12bdaf75f6b2ad3cf50ae5f4c9010830d4654f6e Mon Sep 17 00:00:00 2001 From: Holger Hans Peter Freyther Date: Mon, 8 Apr 2013 08:40:20 +0200 Subject: [PATCH] m2ua: Begin with a M2UA AS and ASP state machine and support code --- Makefile | 6 +- package.xml | 2 + ua/M2UAStates.st | 256 +++++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 263 insertions(+), 1 deletion(-) create mode 100644 ua/M2UAStates.st diff --git a/Makefile b/Makefile index 65f5887..1d4a96d 100644 --- a/Makefile +++ b/Makefile @@ -11,11 +11,15 @@ CONVERT_RULES = -r'Osmo.LogManager->LogManager' \ -r'(Duration milliseconds: ``@args1) -> (Duration milliSeconds: ``@args1)' \ -r'PP.PPCompositeParser->PPCompositeParser' \ -r'PP.PPCompositeParserTest->PPCompositeParserTest' \ + -r'STInST.RBProgramNodeVisitor->RBProgramNodeVisitor' \ + -r'STInST.RBBracketedMethodParser->RBParser' \ -r'Osmo.MessageBuffer->MessageBuffer' \ -r'SystemExceptions.NotFound->NotFound' \ -r'(``@object substrings: ``@args1)->(``@object subStrings: ``@args1)' \ -r'(Dictionary from: ``@args1)->(Dictionary newFrom: ``@args1)' \ -r'(``@object copyFrom: ``@args1)->(``@object copyFrom: ``@args1 to: ``@object size)' \ + -r'(``@object nl)->(``@object cr; lf)' \ + -r'(``@object methodSourceString)->(``@object sourceCode)' \ -C -IPAGSTTests # Can not be parsed right now.. @@ -36,7 +40,7 @@ ISUP = \ isup/ISUPTests.st UA = \ - ua/M2UA.st + ua/M2UA.st ua/M2UAStates.st OSMO = \ osmo/LogAreaOsmo.st \ diff --git a/package.xml b/package.xml index 9780435..85946a4 100644 --- a/package.xml +++ b/package.xml @@ -6,6 +6,7 @@ OsmoCore PetitParser Sockets + Parser core/Extensions.st core/MessageStructure.st @@ -25,6 +26,7 @@ sccp/SCCPAddress.st mtp3/MTP3Messages.st ua/M2UA.st + ua/M2UAStates.st osmo/LogAreaOsmo.st osmo/OsmoUDPSocket.st osmo/OsmoCtrlLogging.st diff --git a/ua/M2UAStates.st b/ua/M2UAStates.st new file mode 100644 index 0000000..571c3df --- /dev/null +++ b/ua/M2UAStates.st @@ -0,0 +1,256 @@ +" + (C) 2013 by Holger Hans Peter Freyther + All Rights Reserved + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU Affero General Public License as + published by the Free Software Foundation, either version 3 of the + License, or (at your option) any later version. + + This program 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 Affero General Public License for more details. + + You should have received a copy of the GNU Affero General Public License + along with this program. If not, see . +" + +STInST.RBProgramNodeVisitor subclass: M2UAStateMachineVisitor [ + | states | + + + + + acceptMessageNode: aNode [ + aNode selector = #moveToState: + ifTrue: [self addTransition: aNode arguments first name asString]. + super acceptMessageNode: aNode + ] + + addTransition: aStateName [ + + self stateSet add: aStateName + ] + + stateSet [ + + ^states ifNil: [states := Set new] + ] +] + + + +Object subclass: M2UAStateBase [ + + + + + M2UAStateBase class >> addStateFrom: aMethod to: newState class: aClass on: aStream [ + aStream + nextPutAll: aClass name asString; + nextPutAll: ' -> '; + nextPutAll: newState; + nextPutAll: ' [ label = "'; + nextPutAll: aMethod asString allButLast; + nextPutAll: '"];'; + nl. + ] + + M2UAStateBase class >> generateGraphviz [ + | stream | + stream := WriteStream on: String new. + stream + nextPutAll: 'digraph {'; + nl. + self subclassesDo: + [:class | + class selectors do: [:selector | + | codeVisitor method | + method := class >> selector. + codeVisitor := (STInST.RBBracketedMethodParser + parseMethod: method methodSourceString) body + acceptVisitor: M2UAStateMachineVisitor new. + codeVisitor stateSet do: + [:newState | + self + addStateFrom: method selector asString + to: newState + class: class + on: stream]]]. + ^stream + nextPutAll: '}'; + contents + ] +] + + + +M2UAStateBase subclass: M2UAAsState [ + + + +] + + + +M2UAAsState subclass: M2UAAsStateInactive [ + + + + + onAllAspDown: anEvent [ + "All ASP trans to ASP-DOWN" + + + self moveToState: M2UAAsStateDown + ] + + onAspActive: anEvent [ + "one ASP trans to ACTIVE" + + + self moveToState: M2UAAsStateActive + ] +] + + + +M2UAAsState subclass: M2UAAsStatePending [ + + + + + onAspUp: anEvent [ + "One ASP trans to ASP-ACTIVE" + + + self stopTr. + self moveToState: M2UAAsStateActive + ] + + onTrExpiry [ + "Tr Expiry, at least one ASP in ASP-INACTIVE -> AS-INACTIVE" + + "Tr Expiry and no ASPin ASP-INACTIVE state" + + + self hasInactiveAsp + ifTrue: [self moveToState: M2UAAsStateInactive] + ifFalse: [self moveToState: M2UAAsStateDown] + ] +] + + + +M2UAStateBase subclass: M2UAAspState [ + + + +] + + + +M2UAAspState subclass: M2UAAspStateActive [ + + + + + onAspDown: anEvent [ + + self moveToState: M2UAAspStateDown + ] + + onAspInactive: anEvent [ + + ^self moveToState: M2UAAspStateInactive + ] + + onOtherAspInAsOverrides: anEvent [ + + ^self moveToState: M2UAAspStateInactive + ] + + onSctpCdi: anEvent [ + + self moveToState: M2UAAspStateDown + ] + + onSctpRi: anEvent [ + + ^self moveToState: M2UAAspStateDown + ] +] + + + +M2UAAspState subclass: M2UAAspStateDown [ + + + + + onAspUp: anEvent [ + + ^self moveToState: M2UAAspStateInactive + ] +] + + + +M2UAAspState subclass: M2UAAspStateInactive [ + + + + + onAspActive: anEvent [ + + ^self moveToState: M2UAAspStateActive + ] + + onAspDown: anEvent [ + + ^self moveToState: M2UAAspStateDown + ] + + onSctpCdi: anEvent [ + + ^self moveToState: M2UAAspStateDown + ] + + onSctpRi: anEvent [ + + ^self moveToState: M2UAAspStateDown + ] +] + + + +M2UAAsState subclass: M2UAAsStateDown [ + + + + + onAspInactive: anEvent [ + "One ASP trans to ASP-INACTIVE" + + + self movesToState: M2UAAsStateInactive + ] +] + + + +M2UAAsState subclass: M2UAAsStateActive [ + + + + + onLastActiveAspDown: anEvent [ + "Last ACTIVEASP trans to ASP-INACTIVE or ASP-Down" + + + self startTr. + self moveToState: M2UAAsStatePending + ] +] +