repositories
/
mTask.git
/ commitdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
| commitdiff |
tree
raw
|
patch
|
inline
| side by side (parent:
d40b1fa
)
Change timeout to ADT and start supporting interrupts
author
Mart Lubbers
<mart@martlubbers.net>
Thu, 2 Mar 2017 17:04:39 +0000
(18:04 +0100)
committer
Mart Lubbers
<mart@martlubbers.net>
Thu, 2 Mar 2017 17:04:39 +0000
(18:04 +0100)
Devices/mTaskDevice.dcl
patch
|
blob
|
history
Devices/mTaskDevice.icl
patch
|
blob
|
history
Tasks/mTaskTask.dcl
patch
|
blob
|
history
Tasks/mTaskTask.icl
patch
|
blob
|
history
client/main.c
patch
|
blob
|
history
mTaskInterpret.dcl
patch
|
blob
|
history
mTaskInterpret.icl
patch
|
blob
|
history
miTask.icl
patch
|
blob
|
history
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 ()
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 ()
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
@! ()
>>| 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
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
>>| makeShares sdss
>>| sendMessage device msgs
>>| makeTask wta -1
- >>= withDevices device o addTask
timeout
+ >>= withDevices device o addTask
@! ()
where
sharename i = device.deviceChannels +++ "-" +++ toString i
@! ()
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 ())
\\(i,[d1,d2])<-st.sdss]
makeShares = foldr (\sh t->set sh.initValue (getSDSStore sh) >>| t) (treturn ())
- addTask ::
Int
MTaskTask MTaskDevice -> MTaskDevice
- addTask t
imeout t
ask 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) @! ()
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
import mTask
import iTasks
-derive class iTask MTaskTask, Main, ByteCode, Stmt, Expr, BC, BCState
+derive class iTask MTaskTask, M
TaskInterval, M
ain, ByteCode, Stmt, Expr, BC, BCState
:: MTaskTask = {
name :: String,
:: 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
import iTasks._Framework.Serialization
-derive class iTask MTaskTask, Main, ByteCode, Stmt, Expr, BC, BCState
+derive class iTask MTaskTask, M
TaskInterval, M
ain, ByteCode, Stmt, Expr, BC, BCState
makeTask :: String Int -> Task MTaskTask
makeTask name ident = get currentDateTime
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;
}
// 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){
if(curtask->interval == 0){
+ run_task(curtask);
curtask->used = false;
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
| MTEmpty
:: MTaskMSGSend
- = MTTask
Int
String
+ = MTTask
MTaskInterval
String
| MTTaskDel Int
| MTSds Int String
| MTUpd Int 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
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 Long
instance toByteCode Button
instance toByteCode UserLED
+//instance toByteCode MTaskInterval
instance toChar Pin
instance arith ByteCode
instance toChar Pin
instance arith ByteCode
@@
-108,9
+115,7
@@
instance assign ByteCode
instance seq ByteCode
instance serial 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]
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 StdEnum
import mTask
+import StdInt
import StdFile
import StdString
import StdFile
import StdString
@@
-25,7
+26,12
@@
import qualified Data.Map as DM
import Text.Encodings.Base64
encode :: MTaskMSGSend -> String
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"
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
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
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`)
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 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
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
}
con f = undef
pub x = fmp makePub x
-// pub _ = undef
instance assign ByteCode where
(=.) v e = e <++> fmp makeStore v
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=[]}
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
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)
# (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)]
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
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
[] = 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)]
) >>* [OnAction (Action "Send") (withValue $ Just o sendToDevice mTaskTask bc)]
+ @! ()
)
process :: MTaskDevice (Shared Channels) -> Task ()
)
process :: MTaskDevice (Shared Channels) -> Task ()