From: Mart Lubbers <mart@martlubbers.net>
Date: Thu, 2 Mar 2017 17:04:39 +0000 (+0100)
Subject: Change timeout to ADT and start supporting interrupts
X-Git-Url: https://git.martlubbers.net/?a=commitdiff_plain;h=acd239b3f29e215ade0b63d5b26b6cf8e8ae0d63;p=mTask.git

Change timeout to ADT and start supporting interrupts
---

diff --git a/Devices/mTaskDevice.dcl b/Devices/mTaskDevice.dcl
index 0e9f567..6a717f0 100644
--- a/Devices/mTaskDevice.dcl
+++ b/Devices/mTaskDevice.dcl
@@ -35,7 +35,7 @@ class MTaskDuplex a where
 	synFun :: a (Shared Channels) -> Task ()
 
 manageDevices :: (MTaskDevice (Shared Channels) -> Task ()) [MTaskDevice] -> Task ()
-sendToDevice :: String (Main (ByteCode () Stmt)) (MTaskDevice, Int) -> Task ()
+sendToDevice :: String (Main (ByteCode () Stmt)) (MTaskDevice, MTaskInterval) -> Task ()
 
 deviceTaskDelete :: MTaskDevice MTaskTask -> Task ()
 deviceTaskAcked :: MTaskDevice Int -> Task ()
diff --git a/Devices/mTaskDevice.icl b/Devices/mTaskDevice.icl
index 4fff9ae..28d44c4 100644
--- a/Devices/mTaskDevice.icl
+++ b/Devices/mTaskDevice.icl
@@ -82,7 +82,7 @@ deleteDevice d = upd (\(r,s,ss)->(r,s,True)) (channels d)
 	>>| upd (filter ((==)d)) deviceStore
 	@! ()
 
-sendToDevice :: String (Main (ByteCode () Stmt)) (MTaskDevice, Int) -> Task ()
+sendToDevice :: String (Main (ByteCode () Stmt)) (MTaskDevice, MTaskInterval) -> Task ()
 sendToDevice wta mTask (device, timeout) =
 		get bcStateStore @ toMessages timeout o toRealByteCode (unMain mTask)
 	>>= \(msgs, st1)->set st1 bcStateStore @ toSDSRecords
@@ -90,7 +90,7 @@ sendToDevice wta mTask (device, timeout) =
 	>>| makeShares sdss
 	>>| sendMessage device msgs
 	>>| makeTask wta -1
-	>>= withDevices device o addTask timeout
+	>>= withDevices device o addTask
 	@! ()
 	where
 		sharename i = device.deviceChannels +++ "-" +++ toString i
@@ -102,8 +102,8 @@ sendToDevice wta mTask (device, timeout) =
 				\\(i,[d1,d2])<-st.sdss]
 		makeShares = foldr (\sh t->set sh.initValue (getSDSStore sh) >>| t) (treturn ())
 
-		addTask :: Int MTaskTask MTaskDevice -> MTaskDevice
-		addTask timeout task device = {device & deviceTasks=[task:device.deviceTasks]}
+		addTask :: MTaskTask MTaskDevice -> MTaskDevice
+		addTask task device = {device & deviceTasks=[task:device.deviceTasks]}
 
 sendMessage :: MTaskDevice [MTaskMSGSend] -> Task ()
 sendMessage dev msgs = upd (\(r,s,ss)->(r,msgs++s,ss)) (channels dev) @! ()
diff --git a/Tasks/mTaskTask.dcl b/Tasks/mTaskTask.dcl
index 2e3458e..ef46243 100644
--- a/Tasks/mTaskTask.dcl
+++ b/Tasks/mTaskTask.dcl
@@ -3,7 +3,7 @@ definition module Tasks.mTaskTask
 import mTask
 import iTasks
 
-derive class iTask MTaskTask, Main, ByteCode, Stmt, Expr, BC, BCState
+derive class iTask MTaskTask, MTaskInterval, Main, ByteCode, Stmt, Expr, BC, BCState
 
 :: MTaskTask = {
 		name :: String,
diff --git a/Tasks/mTaskTask.icl b/Tasks/mTaskTask.icl
index 584dc34..d15f8f3 100644
--- a/Tasks/mTaskTask.icl
+++ b/Tasks/mTaskTask.icl
@@ -5,7 +5,7 @@ import iTasks
 
 import iTasks._Framework.Serialization
 
-derive class iTask MTaskTask, Main, ByteCode, Stmt, Expr, BC, BCState
+derive class iTask MTaskTask, MTaskInterval, Main, ByteCode, Stmt, Expr, BC, BCState
 
 makeTask :: String Int -> Task MTaskTask
 makeTask name ident = get currentDateTime 
diff --git a/client/main.c b/client/main.c
index 9fc91df..f86beff 100644
--- a/client/main.c
+++ b/client/main.c
@@ -74,21 +74,19 @@ void loop(void)
 //			debug("Task %d not implemented\n", ct);
 			continue;
 		}
-		//See whether the task interval has passed
-		if(cyclestart-curtask->lastrun < curtask->interval){
-//			debug("Task %d not scheduled\n", ct);
-			continue;
-		}
-		debug("Current task to run: %d", ct);
-		run_task(curtask);
-		curtask->lastrun = cyclestart;
+		//Onshot task
 		if(curtask->interval == 0){
+			run_task(curtask);
 			curtask->used = false;
-//			write_byte('m');
-//			write_byte('d');
-//			write_byte('\n');
+		//Interrupt task
+		} else if(curtask->interval & 32768){
+			debug("Interrupt task %d not implemented", ct);
+		//Interval task, check if interval is passed
+		} else if(cyclestart-curtask->lastrun > curtask->interval){
+			debug("Running interval task: %d", ct);
+			run_task(curtask);
+			curtask->lastrun = cyclestart;
 		}
-//		write_byte('\n');
 	}
 }
 
diff --git a/mTaskInterpret.dcl b/mTaskInterpret.dcl
index 221c8a4..2701fcf 100644
--- a/mTaskInterpret.dcl
+++ b/mTaskInterpret.dcl
@@ -15,11 +15,17 @@ import mTask
 	| MTEmpty
 
 :: MTaskMSGSend
-	= MTTask Int String
+	= MTTask MTaskInterval String
 	| MTTaskDel Int
 	| MTSds Int String
 	| MTUpd Int String
 
+:: MTaskInterval
+	= OneShot
+	| OnInterval Int
+	| OnInterrupt Int
+
+instance toString MTaskInterval
 instance toString MTaskMSGRecv
 instance toString MTaskMSGSend
 encode :: MTaskMSGSend -> String
@@ -89,6 +95,7 @@ instance toByteCode String
 instance toByteCode Long
 instance toByteCode Button
 instance toByteCode UserLED
+//instance toByteCode MTaskInterval
 
 instance toChar Pin
 instance arith ByteCode
@@ -108,9 +115,7 @@ instance assign ByteCode
 instance seq ByteCode
 instance serial ByteCode
 
-//pub :: (ByteCode a b) -> ByteCode a b
-
-toMessages :: Int (String, BCState) -> ([MTaskMSGSend], BCState)
+toMessages :: MTaskInterval (String, BCState) -> ([MTaskMSGSend], BCState)
 toSDSUpdate :: Int Int -> [MTaskMSGSend]
 
 toByteVal :: BC -> [Char]
diff --git a/mTaskInterpret.icl b/mTaskInterpret.icl
index 2c44484..3f57e7d 100644
--- a/mTaskInterpret.icl
+++ b/mTaskInterpret.icl
@@ -8,6 +8,7 @@ import GenPrint
 import StdEnum
 import mTask
 
+import StdInt
 import StdFile
 import StdString
 
@@ -25,7 +26,12 @@ import qualified Data.Map as DM
 import Text.Encodings.Base64
 
 encode :: MTaskMSGSend -> String
-encode (MTTask to data) = "t" +++ to16bit to +++ to16bit (size data) +++ data +++ "\n"
+encode (MTTask to data) = "t" +++ tob +++ to16bit (size data) +++ data +++ "\n"
+	where 
+		tob = case to of
+			OneShot = to16bit 0
+			OnInterval i = to16bit i
+			OnInterrupt _ = abort "Interrupts not implemented yet"
 encode (MTTaskDel i) = "d" +++ to16bit i +++ "\n"
 encode (MTSds i v) = "s" +++ to16bit i +++ v +++ "\n"
 encode (MTUpd i v) = "u" +++ to16bit i +++ v +++ "\n"
@@ -46,6 +52,11 @@ decode x
 
 safePrint :== toString o toJSON
 
+instance toString MTaskInterval where
+	toString OneShot = "One shot"
+	toString (OnInterrupt i) = "Interrupt: " +++ toString i
+	toString (OnInterval i) = "Every " +++ toString i +++ "ms"
+
 instance toString MTaskMSGSend where
 	toString (MTSds i v) = "Sds id: " +++ toString i
 		+++ " value " +++ safePrint v
@@ -121,15 +132,19 @@ retrn = BC o tuple
 fmp :: ([BC] -> [BC]) (ByteCode a p) -> ByteCode a q
 fmp f b = BC \s->let (bc, s`) = runBC b s in (f bc, s`)
 
-instance toByteCode Bool where
-	toByteCode True = [toChar 0, toChar 1]
-	toByteCode False = [toChar 0, toChar 0]
+instance toByteCode Bool where toByteCode b = toByteCode $ if b 1 0
 instance toByteCode Int where toByteCode n = map toChar [n/256,n rem 256]
 instance toByteCode Long where toByteCode (L n) = toByteCode n
 instance toByteCode Char where toByteCode c = [c]
 instance toByteCode String where toByteCode s = undef
 instance toByteCode Button where toByteCode s = [toChar $ consIndex{|*|} s]
 instance toByteCode UserLED where toByteCode s = [toChar $ consIndex{|*|} s]
+instance toByteCode MTaskInterval where
+	toByteCode OneShot = toByteCode 0
+	//Intervals have the first bit 0 and the rest is a 15 bit unsigned int
+	toByteCode (OnInterval i) = map toChar [i/256 bitand 127, i rem 256]
+	//Intervals have the first bit 1 and the rest is a 15 bit unsigned int
+	toByteCode (OnInterrupt i) = map toChar [i/256 bitor 128, i rem 256]
 
 instance toChar Pin where
 	toChar (Digital p) = toChar $ consIndex{|*|} p
@@ -197,7 +212,6 @@ instance sds ByteCode where
 		}
 	con f = undef
 	pub x = fmp makePub x
-//	pub _ = undef
 
 instance assign ByteCode where
 	(=.) v e = e <++> fmp makeStore v
@@ -230,7 +244,6 @@ instance userLed ByteCode where
 instance zero BCState where
 	zero = {freshl=[1..], freshs=[1..], sdss=[]}
 
-
 toRealByteCode :: (ByteCode a b) BCState -> (String, BCState)
 toRealByteCode x s
 # (bc, st) = runBC x s
@@ -261,13 +274,13 @@ toReadableByteCode x
 # (bc, gtmap) = computeGotos bc 0
 = (join "\n" $ map readable (map (implGotos gtmap) bc), st)
 
-toMessages :: Int (String, BCState) -> ([MTaskMSGSend], BCState)
+toMessages :: MTaskInterval (String, BCState) -> ([MTaskMSGSend], BCState)
 toMessages interval (bytes, st=:{sdss}) = ([MTSds i (toString b)\\(i,b)<-sdss] ++ [MTTask interval bytes], st)
 
 toSDSUpdate :: Int Int -> [MTaskMSGSend]
 toSDSUpdate i v = [MTUpd i (to16bit v)]
 
-Start = toMessages 500 $ toRealByteCode (unMain bc) zero
+Start = toMessages (OnInterval 500) $ toRealByteCode (unMain bc) zero
 	where
 		bc = sds \x=5 In 
 			sds \y=4 In
diff --git a/miTask.icl b/miTask.icl
index 8faca2f..0d7f450 100644
--- a/miTask.icl
+++ b/miTask.icl
@@ -49,8 +49,9 @@ mTaskManager = anyTask
 						[] = viewInformation "No devices yet" [] ()
 						ds = fromJust ('DM'.get mTaskTask allmTasks)
 							>>= \bc->(enterChoice "Choose Device" [ChooseFromDropdown \t->t.deviceName] ds
-								-&&- enterInformation "Timeout, 0 for one-shot" []
+								-&&- enterInformation "Timeout" []
 							) >>* [OnAction (Action "Send") (withValue $ Just o sendToDevice mTaskTask bc)]
+							@! ()
 				)
 
 		process :: MTaskDevice (Shared Channels) -> Task ()