From: Mart Lubbers Date: Mon, 2 Jan 2017 14:01:05 +0000 (+0100) Subject: revert back to old itasks, add sds support in bytecode X-Git-Url: https://git.martlubbers.net/?a=commitdiff_plain;h=93cabbcd5d18b7b45d6f43a6ff39f94cfcb95522;p=mTask.git revert back to old itasks, add sds support in bytecode --- diff --git a/Makefile b/Makefile index da62a3c..6273d8e 100644 --- a/Makefile +++ b/Makefile @@ -1,6 +1,6 @@ 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\ diff --git a/int/interpret.c b/int/interpret.c index f44c7bf..4c60bc9 100644 --- a/int/interpret.c +++ b/int/interpret.c @@ -5,8 +5,9 @@ #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; @@ -15,71 +16,78 @@ void run_task(struct task *t) 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]); diff --git a/int/interpret.h b/int/interpret.h index d2effe7..98a257b 100644 --- a/int/interpret.h +++ b/int/interpret.h @@ -8,6 +8,6 @@ #include "task.h" -void run_task(struct task *task); +void run_task(struct task *task, int fd); #endif diff --git a/int/main.c b/int/main.c index 78f44bb..e7a8f22 100644 --- a/int/main.c +++ b/int/main.c @@ -79,8 +79,11 @@ void read_message(int fd_in, int fd_out) 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); } } @@ -159,21 +162,23 @@ int main(int argc, char *argv[]) for(ct = 0; ctlastrun < 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; } diff --git a/int/sds.c b/int/sds.c index 3a3c8fe..679ce42 100644 --- a/int/sds.c +++ b/int/sds.c @@ -56,3 +56,44 @@ bool sds_update(int fd) } return false; } + +void sds_publish(int id, int fd) +{ + uint8_t cs; + for(cs = 0; cs>*. */ -//import iTasks +import iTasks + import iTasks._Framework.Generic from iTasks._Framework.Task import :: Task import StdClass diff --git a/mTaskCode.icl b/mTaskCode.icl index 6360b5a..c405cea 100644 --- a/mTaskCode.icl +++ b/mTaskCode.icl @@ -74,6 +74,7 @@ instance sds Code where 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 = diff --git a/mTaskInterpret.dcl b/mTaskInterpret.dcl index fd22548..0deb665 100644 --- a/mTaskInterpret.dcl +++ b/mTaskInterpret.dcl @@ -53,7 +53,8 @@ instance Monoid (ByteCode a p) :: BCState = { freshl :: [Int], - freshs :: [Int] + freshs :: [Int], + sdss :: [(Int, [Char])] } instance zero BCState @@ -82,6 +83,9 @@ instance assign ByteCode 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) diff --git a/mTaskInterpret.icl b/mTaskInterpret.icl index 789c58a..4c8e43e 100644 --- a/mTaskInterpret.icl +++ b/mTaskInterpret.icl @@ -19,11 +19,16 @@ import StdList 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] @@ -65,7 +70,7 @@ instance toChar Pin where 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 @@ -115,16 +120,25 @@ withSDS :: (Int -> (ByteCode b q)) -> ByteCode b q 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] @@ -142,35 +156,54 @@ instance serial ByteCode where 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 diff --git a/mTaskSimulation.dcl b/mTaskSimulation.dcl index 525498f..16ceee4 100644 --- a/mTaskSimulation.dcl +++ b/mTaskSimulation.dcl @@ -1,11 +1,12 @@ 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` = diff --git a/mTaskSimulation.icl b/mTaskSimulation.icl index d52fa9a..ae7ddfb 100644 --- a/mTaskSimulation.icl +++ b/mTaskSimulation.icl @@ -3,7 +3,7 @@ implementation module mTaskSimulation 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))] @@ -74,6 +74,7 @@ defEval2 v f = 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 = diff --git a/miTask.icl b/miTask.icl index a00d6f0..1fc0b2f 100644 --- a/miTask.icl +++ b/miTask.icl @@ -8,22 +8,29 @@ import iTasks 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