CLEAN_HOME?=/opt/clean
CLM:=clm
-override CLMFLAGS+=-dynamics -l -no-pie -h 200M -t -nt #-lat
+override CLMFLAGS+=-dynamics -l -no-pie -h 200M -t -nt -lat
CLMLIBS:=\
-I $(CLEAN_HOME)/lib/iTasks-SDK/Patches/Dynamics\
-I $(CLEAN_HOME)/lib/iTasks-SDK/Patches/Generics\
#include "interpret.h"
#include "misc.h"
#include "task.h"
+#include "sds.h"
-void run_task(struct task *t)
+void run_task(struct task *t, int fd)
{
uint8_t *program = t->bc;
int plen = t->tlen;
char stack[STACKSIZE] = {0};
printf("Running task with length: %d\n", plen);
while(pc != plen){
- printf("program: %x\n", program[pc]);
+ printf("program: %d\n", program[pc]);
+ printf("stack: %02x %02x %02x %02x %02x %02x %02x %02x %02x %02x\n",
+ stack[0], stack[1], stack[2], stack[3], stack[4],
+ stack[5], stack[6], stack[7], stack[8], stack[9]);
switch(program[pc++]){
case BCNOP: trace("nop\n");
break;
- case BCPUSH: trace("push %d\n", program[pc]);
- stack[sp++] = program[pc++];
+ case BCPUSH: trace("push %d\n", program[pc]*265+program[pc+1]);
+ stack[sp++] = program[pc]*265 + program[pc+1];
+ pc+=2;
break;
case BCPOP: trace("pop\n");
sp--;
break;
case BCSDSSTORE: trace("sds store\n");
+ sds_store(program[pc++], stack[sp-1]);
break;
case BCSDSFETCH: trace("sds fetch\n");
+ stack[sp++] = sds_fetch(program[pc++]);
break;
case BCSDSPUBLISH: trace("sds publish\n");
+ sds_publish(program[pc++], fd);
break;
case BCNOT: trace("not\n");
stack[sp] = stack[sp] > 0 ? 0 : 1;
break;
case BCADD: trace("add\n");
- stack[sp-1] = stack[sp] + stack[sp-1];
+ stack[sp-2] = stack[sp-1] + stack[sp-2];
sp -= 1;
break;
case BCSUB: trace("sub\n");
- stack[sp-1] = stack[sp] - stack[sp-1];
+ stack[sp-2] = stack[sp-1] - stack[sp-2];
sp -= 1;
break;
case BCMUL: trace("mul\n");
- stack[sp-1] = stack[sp] * stack[sp-1];
+ stack[sp-2] = stack[sp-1] * stack[sp-2];
sp -= 1;
break;
case BCDIV: trace("div\n");
- stack[sp-1] = stack[sp] / stack[sp-1];
+ stack[sp-2] = stack[sp-1] / stack[sp-2];
sp -= 1;
break;
case BCAND: trace("and\n");
- stack[sp-1] = stack[sp] && stack[sp-1];
+ stack[sp-2] = stack[sp-1] && stack[sp-2];
sp -= 1;
break;
case BCOR: trace("or\n");
- stack[sp-1] = stack[sp] || stack[sp-1];
+ stack[sp-2] = stack[sp-1] || stack[sp-2];
sp -= 1;
break;
case BCEQ: trace("eq\n");
- stack[sp-1] = stack[sp] == stack[sp-1];
+ stack[sp-2] = stack[sp-1] == stack[sp-2];
sp -= 1;
break;
case BCNEQ: trace("neq\n");
- stack[sp-1] = stack[sp] != stack[sp-1];
+ stack[sp-2] = stack[sp-1] != stack[sp-2];
sp -= 1;
break;
case BCLES: trace("les\n");
- stack[sp-1] = stack[sp] < stack[sp-1];
+ stack[sp-2] = stack[sp-1] < stack[sp-2];
sp -= 1;
break;
case BCGRE: trace("gre\n");
- stack[sp-1] = stack[sp] > stack[sp-1];
+ stack[sp-2] = stack[sp-1] > stack[sp-2];
sp -= 1;
break;
case BCLEQ: trace("leq\n");
- stack[sp-1] = stack[sp] <= stack[sp-1];
+ stack[sp-2] = stack[sp-1] <= stack[sp-2];
sp -= 1;
break;
case BCGEQ: trace("geq\n");
- stack[sp-1] = stack[sp] >= stack[sp-1];
+ stack[sp-2] = stack[sp-1] >= stack[sp-2];
sp -= 1;
break;
case BCJMP: trace("jmp to %d\n", program[pc]);
#include "task.h"
-void run_task(struct task *task);
+void run_task(struct task *task, int fd);
#endif
c = task_register(fd_in);
write(fd_out, &c, 1);
break;
+ case '\0':
+ debug("iTasks server shut down\n");
+ exit(EXIT_SUCCESS);
default:
- debug("Unknown message: %X?\n", c);
+ debug("Unknown message: %X %X?\n", c, EOF);
}
}
for(ct = 0; ct<MAXTASKS; ct++){
//See whether the task is even in use
if((curtask = task_get(ct)) == NULL){
- debug("Task %d not implemented\n", ct);
+// 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);
+// debug("Task %d not scheduled\n", ct);
continue;
}
#ifdef DEBUG
printf("Current task to run: %d\n", ct);
getchar();
#endif
- run_task(curtask);
+ run_task(curtask, fd);
}
- usleep(10);
+ debug("Waiting for 500ms\n");
+ usleep(500000);
+ debug("done waiting\n");
}
return 0;
}
}
return false;
}
+
+void sds_publish(int id, int fd)
+{
+ uint8_t cs;
+ for(cs = 0; cs<MAXSDSS; cs++){
+ if(sdss[cs].used && sdss[cs].id == id){
+ debug("Publish %d=%d\n", sdss[cs].id, sdss[cs].value);
+ char msg[6];
+ sprintf(msg, "s%c%c%c\n",
+ sdss[cs].id,
+ sdss[cs].value/265,
+ sdss[cs].value%265);
+ write(fd, msg, 6);
+ return;
+ }
+ }
+ debug("SDS identifier unknown: %d\n", id);
+}
+
+int sds_fetch(int id)
+{
+ uint8_t cs;
+ for(cs = 0; cs<MAXSDSS; cs++)
+ if(sdss[cs].used && sdss[cs].id == id)
+ return sdss[cs].value;
+ debug("SDS identifier unknown: %d\n", id);
+ return 0;
+}
+
+void sds_store(int id, int val)
+{
+ uint8_t cs;
+ for(cs = 0; cs<MAXSDSS; cs++) {
+ if(sdss[cs].used && sdss[cs].id == id){
+ sdss[cs].value = val;
+ return;
+ }
+ }
+ debug("SDS identifier unknown: %d\n", id);
+
+}
void sds_register(int fd);
bool sds_update(int fd);
+void sds_publish(int id, int fd);
+int sds_fetch(int id);
+void sds_store(int id, int val);
#endif
imporove setp: >>*.
*/
-//import iTasks
+import iTasks
+
import iTasks._Framework.Generic
from iTasks._Framework.Task import :: Task
import StdClass
in setCode Var +.+ c (type2string v + " " + name + " = " + toCode v +
";\n") +.+ setCode Setup +.+ unMain body}
con f = defCode f
+// pub _ = undef
defCode :: ((Code t p) -> In t (Main (Code u q))) -> Main (Code u r) | type t
defCode f =
:: BCState = {
freshl :: [Int],
- freshs :: [Int]
+ freshs :: [Int],
+ sdss :: [(Int, [Char])]
}
instance zero BCState
instance seq ByteCode
instance serial ByteCode
+getSDSBytes :: BCState -> String
+getTaskBytes :: Int String -> String
+
toByteVal :: BC -> [Char]
-toReadableByteCode :: (ByteCode a Expr) -> String
-toRealByteCode :: (ByteCode a Expr) -> String
+toReadableByteCode :: (ByteCode a b) -> (String, BCState)
+toRealByteCode :: (ByteCode a b) -> (String, BCState)
from Data.Func import $
from Text import class Text(concat,join,toUpperCase), instance Text String
+import Text.Encodings.Base64
+
toByteVal :: BC -> [Char]
toByteVal b
# bt = toChar $ consIndex{|*|} b + 1
= [bt:case b of
(BCPush i) = i
+ (BCSdsStore i) = [toChar i]
+ (BCSdsFetch i) = [toChar i]
+ (BCSdsPublish i) = [toChar i]
(BCAnalogRead i) = [toChar i]
(BCAnalogWrite i) = [toChar i]
(BCDigitalRead i) = [toChar i]
toChar (Digital p) = toChar $ consIndex{|*|} p + 1
toChar (Analog p) = toChar $ consIndex{|*|} p + 1
-derive gPrint BC, AnalogPin, Pin, DigitalPin, BCState
+derive gPrint BC, AnalogPin, Pin, DigitalPin
derive consIndex BC, Pin, Button
derive consName BC, Pin, Button
withSDS f = BC \s->let [fresh:fs] = s.freshs
in runBC (f fresh) {s & freshs=fs}
+setSDS :: Int v -> ByteCode b q | toByteCode v
+setSDS ident val = BC \s->([], {s & sdss = [(ident, toByteCode val):s.sdss]})
+
instance sds ByteCode where
sds f = {main = withSDS \sds->
let (v In body) = f $ retrn [BCSdsFetch sds]
- in retrn [BCPush $ toByteCode v,BCSdsStore sds] <++> unMain body
+ in setSDS sds v <++> unMain body
}
con f = undef
+// pub _ = undef
instance assign ByteCode where
(=.) v e = e <++> fmp makeStore v
+makePub [] = []
+makePub [x:xs] = case x of
+ BCSdsFetch i = [BCSdsPublish i:xs]
+ y = [y:xs]
+
makeStore [] = []
makeStore [x:xs] = case x of
BCSdsFetch i = [BCSdsStore i:xs]
serialParseInt = retrn [BCSerialParseInt]
instance zero BCState where
- zero = {freshl=[1..], freshs=[1..]}
+ zero = {freshl=[1..], freshs=[1..], sdss=[]}
+
+makeSafe :: Char -> Char
+makeSafe c = c//toChar $ toInt c + 31
-toRealByteCode :: (ByteCode a Expr) -> String
+toRealByteCode :: (ByteCode a b) -> (String, BCState)
toRealByteCode x
# (bc, st) = runBC x zero
-= concat $ map (toString o toByteVal) bc
+= (concat $ map (toString o map makeSafe o toByteVal) bc, st)
-toReadableByteCode :: (ByteCode a Expr) -> String
+readable :: BC -> String
+readable (BCPush d) = "BCPush " +++ concat (map safe d)
+ where
+ safe c
+ | isControl c = "\\d" +++ toString (toInt c)
+ = toString c
+readable b = printToString b
+
+toReadableByteCode :: (ByteCode a b) -> (String, BCState)
toReadableByteCode x
# (bc, st) = runBC x zero
-= join "\n" $ map printToString bc
+= (join "\n" $ map readable bc, st)
//Start :: String
//Start = toReadableByteCode bc
// where
// bc :: ByteCode Int Expr
// bc = (lit 36 +. lit 42) +. lit 44
+getSDSBytes :: BCState -> String
+getSDSBytes {sdss} = concat $ map sd sdss
+ where sd (i, v) = "s" +++ toString (toChar i) +++ toString v +++ "\n"
-Start :: String
-Start = toReadableByteCode $ unMain bc
-//Start = toRealByteCode $ unMain bc
+getTaskBytes :: Int String -> String
+getTaskBytes i b = "t" +++ to16bit i +++ to16bit (size b) +++ b
+//
+Start = getSDSBytes (snd bc`) +++ getTaskBytes 400 (fst bc`)
+//Start = fst $ toReadableByteCode $ unMain bc
where
- bc :: Main (ByteCode Int Expr)
+ bc` = toRealByteCode (unMain bc)
+ bc :: Main (ByteCode Int Stmt)
bc = sds \x=41 In
- sds \y=1 In
- {main = x =. x +. y}
+ {main = x =. x +. lit 1 :. pub x}
+
+pub :: (ByteCode a b) -> ByteCode a b
+pub x = fmp makePub x
-//to16bit :: Int -> String
-//to16bit i = toString (toChar (i/265)) +++ toString (toChar (i rem 265))
+to16bit :: Int -> String
+to16bit i = toString (toChar (i/265)) +++ toString (toChar (i rem 265))
//
////Run test programma en pretty print
////Start :: String
definition module mTaskSimulation
+import iTasks.API.Core.Types
import mTask
-:: Display a = Display a
+//:: Display a = Display a
-derive class iTask Display
-instance zero State`
+//derive class iTask Display
+//instance zero State`
eval :: (Main (Eval t p)) -> [String] | toString t
:: State` =
import iTasks
import gdynamic, gCons, GenEq, StdMisc, StdArray
import mTask
-derive class iTask Display
+//derive class iTask Display
eval :: (Main (Eval t p)) -> [String] | toString t
eval {main=(E f)} = [toString (fst (f Rd zero))]
instance sds Eval where
sds f = defEval f
con f = defEval f
+// pub _ = undef
defEval :: ((Eval t p)->In t (Main (Eval u q))) -> (Main (Eval u q)) | dyn t
defEval f =
import mTask
Start :: *World -> *World
-Start world = startEngine mTaskTask world
+Start world = startEngine (withShared ([], False, [], False) mTaskTask) world
+//Start world = startEngine mTaskTask world
-mTaskTask :: Task ()
-mTaskTask = withShared ([],False,[],False) (\ch->
- syncNetworkChannel "localhost" 8123 "\n" id id ch ||-
- sendByteCode ||-
- updateSharedInformation "channels" [] ch @! ())
-
-sendByteCode :: Task ()
-sendByteCode = viewInformation "send" [] "4" @! ()
-// (toReadableByteCode (unMain bc)) @! ()
+mTaskTask :: (Shared ([String],Bool,[String],Bool)) -> Task ()
+mTaskTask ch =
+ syncNetworkChannel "localhost" 8124 "\n" id id ch ||-
+ viewSharedInformation "channels" [ViewWith lens] ch ||-
+ sendString (makemTask 500 bc) ch @! ()
where
+ lens :: ([String],Bool,[String],Bool) -> String
+ lens (r,_,s,_) = "channels"
+
bc :: Main (ByteCode Int Expr)
- bc = sds \x=41 In
- sds \y=1 In
- {main = x =. x +. y}
+ bc = sds \x=0 In {main = x =. x +. lit 1}
+
+makemTask :: Int (Main (ByteCode a Expr)) -> String
+makemTask to bc
+# (bc, st) = toRealByteCode (unMain bc)
+= "t" +++ toString (toChar (to / 265))
+ +++ toString (toChar (to rem 265)) +++ toString bc +++ "\n"
+
+sendString :: String (Shared ([String],Bool,[String],Bool)) -> Task ()
+sendString m ch = upd (\(r,rs,s,ss)->(r,rs,s ++ [m],ss)) ch @! ()
syncNetworkChannel :: String Int String (String -> m) (m -> String) (Shared ([m],Bool,[m],Bool)) -> Task () | iTask m
syncNetworkChannel server port msgSeparator decodeFun encodeFun channel
repositories / mTask.git / commitdiff