Change timeout to ADT and start supporting interrupts

diff --git a/Devices/mTaskDevice.dcl b/Devices/mTaskDevice.dcl
index 0e9f567..6a717f0 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 ()