From 41ba74ece94d91858a6683a58a0f064c36900c4b Mon Sep 17 00:00:00 2001 From: Mart Lubbers Date: Wed, 17 May 2017 12:34:14 +0200 Subject: [PATCH] added gracefull shutdown --- Devices/mTaskDevice.icl | 4 +++- Tasks/Examples.dcl | 2 ++ Tasks/Examples.icl | 12 +++++++++++- Tasks/mTaskTask.dcl | 2 +- Tasks/mTaskTask.icl | 3 +-- client/interpret.c | 1 - mTask.dcl | 2 +- mTaskInterpret.dcl | 1 + mTaskInterpret.icl | 5 ++++- 9 files changed, 24 insertions(+), 8 deletions(-) diff --git a/Devices/mTaskDevice.icl b/Devices/mTaskDevice.icl index 95c549e..e05d61b 100644 --- a/Devices/mTaskDevice.icl +++ b/Devices/mTaskDevice.icl @@ -99,7 +99,9 @@ viewDevice pf d = forever $ traceValue "viewDevice" >>| anyTask dropEmpty (r,s,ss) = (filter ((=!=)MTEmpty) r,s,ss) deleteDevice :: MTaskDevice -> Task () -deleteDevice d = upd (\(r,s,ss)->(r,s,True)) (channels d) +deleteDevice d = sendMessages [MTShutdown] d + >>| wait "Waiting for the channels to empty" (\(r,s,ss)->isEmpty s) (channels d) + >>| upd (\(r,s,ss)->(r,s,True)) (channels d) >>| maybe (treturn ()) (flip removeTask topLevelTasks) d.deviceTask >>| upd (filter ((<>)d)) deviceStore >>| cleanSharesDevice d.deviceName diff --git a/Tasks/Examples.dcl b/Tasks/Examples.dcl index bf962cd..57f0c85 100644 --- a/Tasks/Examples.dcl +++ b/Tasks/Examples.dcl @@ -3,6 +3,8 @@ definition module Tasks.Examples from Data.Map import :: Map import mTask +faculty :: Int -> Main (ByteCode () Stmt) +countTo5 :: Main (ByteCode () Stmt) countAndLed :: Main (ByteCode () Stmt) blink :: UserLED -> Main (ByteCode () Stmt) count :: Main (ByteCode () Stmt) diff --git a/Tasks/Examples.icl b/Tasks/Examples.icl index 78b0d67..2e2a973 100644 --- a/Tasks/Examples.icl +++ b/Tasks/Examples.icl @@ -6,12 +6,21 @@ import mTask import Devices.mTaskDevice import iTasks._Framework.Serialization +faculty :: Int -> Main (ByteCode () Stmt) +faculty i = sds \y=i In sds \x=1 In {main = + IF (y <=. lit 1) ( + pub x :. retrn + ) ( + x =. x *. y :. + y =. y -. lit 1 + )} + countTo5 :: Main (ByteCode () Stmt) countTo5 = sds \x=0 In {main = x =. x +. lit 1 :. pub x :. IF ( x >. lit 5) ( - retrn x + retrn ) ( noOp )} @@ -78,4 +87,5 @@ allmTasks = 'DM'.fromList ,("blinkShare", treturn blinkShare) ,("count", treturn count) ,("countTo5", treturn countTo5) + ,("faculty", enterInformation "Faculty" [] @ faculty) ] diff --git a/Tasks/mTaskTask.dcl b/Tasks/mTaskTask.dcl index 3370e4a..0beddf2 100644 --- a/Tasks/mTaskTask.dcl +++ b/Tasks/mTaskTask.dcl @@ -13,4 +13,4 @@ derive class iTask MTaskTask, MTaskInterval, Main, ByteCode, Stmt, Expr, BC, BCS } makeTask :: String Int -> Task MTaskTask -sendTaskToDevice :: String (Main (ByteCode () Stmt)) (MTaskDevice, MTaskInterval) -> Task () +sendTaskToDevice :: String (Main (ByteCode a Stmt)) (MTaskDevice, MTaskInterval) -> Task () diff --git a/Tasks/mTaskTask.icl b/Tasks/mTaskTask.icl index 208b123..9bd5612 100644 --- a/Tasks/mTaskTask.icl +++ b/Tasks/mTaskTask.icl @@ -4,7 +4,6 @@ import mTask import iTasks import Devices.mTaskDevice - import iTasks._Framework.Serialization derive class iTask MTaskTask, MTaskInterval, Main, ByteCode, Stmt, Expr, BC, BCState, RWST, Identity @@ -13,7 +12,7 @@ makeTask :: String Int -> Task MTaskTask makeTask name ident = get currentDateTime @ \dt->{MTaskTask | name=name,ident=ident,dateAdded=dt} -sendTaskToDevice :: String (Main (ByteCode () Stmt)) (MTaskDevice, MTaskInterval) -> Task () +sendTaskToDevice :: String (Main (ByteCode a Stmt)) (MTaskDevice, MTaskInterval) -> Task () sendTaskToDevice wta mTask (device, timeout) = get bcStateStore @ toMessages timeout mTask >>= \(msgs, st1)->set st1 bcStateStore diff --git a/client/interpret.c b/client/interpret.c index 66173e2..08a20df 100644 --- a/client/interpret.c +++ b/client/interpret.c @@ -163,7 +163,6 @@ void run_task(struct task *t) break; #endif case BCRETURN: trace("Return"); - t->value = (uint16_t) stack[sp-1]; debug("Task returned"); task_delete(t->taskid); return; diff --git a/mTask.dcl b/mTask.dcl index 9eb93da..7766d30 100644 --- a/mTask.dcl +++ b/mTask.dcl @@ -95,7 +95,7 @@ class seq v where (>>=.) infixr 0 :: (v t p) ((v t Expr) -> (v u q)) -> (v u Stmt) | type t & type u (:.) infixr 0 :: (v t p) (v u q) -> v u Stmt | type t & type u class retrn v where - retrn :: (v t p) -> (v t Stmt) | type t + retrn :: v () Expr class step` v where (>>*.) infixl 1 :: (v t p) ((v t Expr) -> [Step v u]) -> v u Stmt | type t & type u :: Step v t = E.p.q: Cond (v Bool q) (v t p) | E.p: Ever (v t p) diff --git a/mTaskInterpret.dcl b/mTaskInterpret.dcl index 29e1fb9..011c130 100644 --- a/mTaskInterpret.dcl +++ b/mTaskInterpret.dcl @@ -23,6 +23,7 @@ from Generics.gCons import class gCons, generic conses, generic consName, generi :: MTaskMSGSend = MTTask MTaskInterval String | MTTaskDel Int + | MTShutdown | MTSds Int BCValue | MTUpd Int BCValue | MTSpec diff --git a/mTaskInterpret.icl b/mTaskInterpret.icl index 5e17aeb..635f68b 100644 --- a/mTaskInterpret.icl +++ b/mTaskInterpret.icl @@ -46,6 +46,7 @@ encode (MTTaskDel i) = "d" +++ to16bit i +++ "\n" encode (MTSds i v) = "s" +++ to16bit i +++ toByteCode v +++ "\n" encode (MTUpd i v) = "u" +++ to16bit i +++ toByteCode v +++ "\n" encode (MTSpec) = "c\n" +encode (MTShutdown) = "h\n" import StdDebug decode :: String -> MTaskMSGRecv @@ -79,6 +80,8 @@ instance toString MTaskMSGSend where toString (MTTaskDel i) = "Task delete request: " +++ toString i toString (MTUpd i v) = "Update id: " +++ toString i +++ " value " +++ safePrint v + toString (MTSpec) = "Spec request" + toString (MTShutdown) = "Shutdown request" instance toString MTaskMSGRecv where toString (MTTaskAck i mem) = "Task added with id: " +++ toString i @@ -283,7 +286,7 @@ instance userLed ByteCode where ledOff (BC l) = BC $ l >>| tell [BCLedOff] instance retrn ByteCode where - retrn (BC l) = tell` [BCReturn] + retrn = tell` [BCReturn] instance zero BCState where zero = {freshl=[1..], freshs=[1..], sdss=[]} -- 2.20.1