From acd239b3f29e215ade0b63d5b26b6cf8e8ae0d63 Mon Sep 17 00:00:00 2001 From: Mart Lubbers Date: Thu, 2 Mar 2017 18:04:39 +0100 Subject: [PATCH] Change timeout to ADT and start supporting interrupts --- Devices/mTaskDevice.dcl | 2 +- Devices/mTaskDevice.icl | 8 ++++---- Tasks/mTaskTask.dcl | 2 +- Tasks/mTaskTask.icl | 2 +- client/main.c | 22 ++++++++++------------ mTaskInterpret.dcl | 13 +++++++++---- mTaskInterpret.icl | 29 +++++++++++++++++++++-------- miTask.icl | 3 ++- 8 files changed, 49 insertions(+), 32 deletions(-) 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 () -- 2.20.1