From 2baa7d4b9df523436b38a4a7a0d9cb4e75fb527c Mon Sep 17 00:00:00 2001 From: Mart Lubbers Date: Mon, 23 Jan 2017 22:17:01 +0100 Subject: [PATCH] started communication from scratch --- int/halconf.h | 2 +- int/interface.c | 3 - int/interface.h | 1 + int/interface_linux.c | 5 ++ int/interpret.c | 31 ++++--- int/mTaskSymbols.h | 66 +++++++-------- int/main.c | 4 +- int/sds.c | 3 + int/task.c | 12 +-- mTaskInterpret.icl | 4 +- mTaskMakeSymbols.icl | 2 +- miTask.icl | 186 ++++++++++++++++-------------------------- 12 files changed, 141 insertions(+), 178 deletions(-) diff --git a/int/halconf.h b/int/halconf.h index e556d48..1275a5f 100644 --- a/int/halconf.h +++ b/int/halconf.h @@ -294,7 +294,7 @@ * default configuration. */ #if !defined(SERIAL_DEFAULT_BITRATE) || defined(__DOXYGEN__) -#define SERIAL_DEFAULT_BITRATE 9600 +#define SERIAL_DEFAULT_BITRATE 38400 #endif /** diff --git a/int/interface.c b/int/interface.c index ba4446f..312689a 100644 --- a/int/interface.c +++ b/int/interface.c @@ -81,9 +81,6 @@ void debug(char *fmt, ...) write_byte((uint8_t)fmt[i]); } write_byte('\n'); -#ifdef DEBUG -#endif - (void)fmt; } void debugi(int i) diff --git a/int/interface.h b/int/interface.h index 1c77b7a..6141559 100644 --- a/int/interface.h +++ b/int/interface.h @@ -11,6 +11,7 @@ extern char **gargv; #endif #define read16() 256*read_byte() + read_byte() +#define from16(a, b) 256*a+b uint8_t read_byte(void); void write_byte(uint8_t b); diff --git a/int/interface_linux.c b/int/interface_linux.c index dd94993..c62e36f 100644 --- a/int/interface_linux.c +++ b/int/interface_linux.c @@ -152,6 +152,11 @@ void debug(char *fmt, ...) va_end(ap); } +void debugi(int i) +{ + debug("%d", i); +} + void pdie(char *s) { perror(s); diff --git a/int/interpret.c b/int/interpret.c index dedf688..06f46a0 100644 --- a/int/interpret.c +++ b/int/interpret.c @@ -13,6 +13,8 @@ #define trace(op, ...) printf("pc: %d, sp: %d, op: " op "\n", pc, sp, ##__VA_ARGS__); #endif +#define f16(p) program[pc]*265+program[pc+1] + void run_task(struct task *t) { uint8_t *program = t->bc; @@ -21,11 +23,11 @@ void run_task(struct task *t) int sp = 0; char stack[STACKSIZE] = {0}; debug("Running task with length: %d", plen); - while(pc != plen){ -// debug("program: %d", program[pc]); -// debug("stack: %02x %02x %02x %02x %02x %02x %02x %02x %02x %02x", -// stack[0], stack[1], stack[2], stack[3], stack[4], -// stack[5], stack[6], stack[7], stack[8], stack[9]); + while(pc < plen){ + debug("program: %d", program[pc]); + debug("stack: %02x %02x %02x %02x %02x %02x %02x %02x %02x %02x", + 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"); @@ -34,20 +36,23 @@ void run_task(struct task *t) pc++; break; case BCPUSH: trace("push %d", program[pc]*265+program[pc+1]); - stack[sp++] = program[pc]*265 + program[pc+1]; + stack[sp++] = f16(pc); pc+=2; break; case BCPOP: trace("pop"); sp--; break; - case BCSDSSTORE: trace("sds store: %d", program[pc]); - sds_store(program[pc++], stack[--sp]); + case BCSDSSTORE: trace("sds store: %d", f16(pc)); + sds_store(f16(pc), stack[--sp]); + pc+=2; break; - case BCSDSFETCH: trace("sds fetch: %d", program[pc]); - stack[sp++] = sds_fetch(program[pc++]); + case BCSDSFETCH: trace("sds fetch: %d", f16(pc)); + stack[sp++] = sds_fetch(f16(pc)); + pc+=2; break; - case BCSDSPUBLISH: trace("sds publish %d", program[pc]); - sds_publish(program[pc++]); + case BCSDSPUBLISH: trace("sds publish %d", f16(pc)); + sds_publish(f16(pc)); + pc+=2; break; case BCNOT: trace("not"); stack[sp] = stack[sp] > 0 ? 0 : 1; @@ -106,7 +111,7 @@ void run_task(struct task *t) case BCJMPT: trace("jmpt to %d", program[pc]); pc = stack[--sp] ? program[pc]-1 : pc+1; break; - case BCJMPF: trace("jmpf to %d", program[pc]); + case BCJMPF: trace("jmpf(%d) to %d", stack[sp-1], program[pc]); pc = stack[--sp] ? pc+1 : program[pc]-1; break; case BCSERIALAVAIL: trace("SerialAvailable()"); diff --git a/int/mTaskSymbols.h b/int/mTaskSymbols.h index 35b211a..3eb218a 100644 --- a/int/mTaskSymbols.h +++ b/int/mTaskSymbols.h @@ -1,36 +1,36 @@ #ifndef MTASK_H #define MTASK_H -#define BCNOP 1 -#define BCLAB 2 -#define BCPUSH 3 -#define BCPOP 4 -#define BCSDSSTORE 5 -#define BCSDSFETCH 6 -#define BCSDSPUBLISH 7 -#define BCNOT 8 -#define BCADD 9 -#define BCSUB 10 -#define BCMUL 11 -#define BCDIV 12 -#define BCAND 13 -#define BCOR 14 -#define BCEQ 15 -#define BCNEQ 16 -#define BCLES 17 -#define BCGRE 18 -#define BCLEQ 19 -#define BCGEQ 20 -#define BCJMP 21 -#define BCJMPT 22 -#define BCJMPF 23 -#define BCSERIALAVAIL 24 -#define BCSERIALPRINT 25 -#define BCSERIALPRINTLN 26 -#define BCSERIALREAD 27 -#define BCSERIALPARSEINT 28 -#define BCANALOGREAD 29 -#define BCANALOGWRITE 30 -#define BCDIGITALREAD 31 -#define BCDIGITALWRITE 32 -#define BCTEST 33 +#define BCNOP 0 +#define BCLAB 1 +#define BCPUSH 2 +#define BCPOP 3 +#define BCSDSSTORE 4 +#define BCSDSFETCH 5 +#define BCSDSPUBLISH 6 +#define BCNOT 7 +#define BCADD 8 +#define BCSUB 9 +#define BCMUL 10 +#define BCDIV 11 +#define BCAND 12 +#define BCOR 13 +#define BCEQ 14 +#define BCNEQ 15 +#define BCLES 16 +#define BCGRE 17 +#define BCLEQ 18 +#define BCGEQ 19 +#define BCJMP 20 +#define BCJMPT 21 +#define BCJMPF 22 +#define BCSERIALAVAIL 23 +#define BCSERIALPRINT 24 +#define BCSERIALPRINTLN 25 +#define BCSERIALREAD 26 +#define BCSERIALPARSEINT 27 +#define BCANALOGREAD 28 +#define BCANALOGWRITE 29 +#define BCDIGITALREAD 30 +#define BCDIGITALWRITE 31 +#define BCTEST 32 #endif diff --git a/int/main.c b/int/main.c index 7840876..5acebef 100644 --- a/int/main.c +++ b/int/main.c @@ -23,7 +23,7 @@ void read_message(void) //Find next task if(input_available()){ uint8_t c = read_byte(); - debug("Receiving input: %c\n", c); + debug("Receiving input: %c %02x\n", c, c); switch(c){ case MSG_SDS_SPEC: debug("Receiving an sds"); @@ -50,7 +50,6 @@ void read_message(void) break; default: debug("Unknown message: %X", c); - debugi(c); } } } @@ -79,7 +78,6 @@ void loop(void) debug("Current task to run: %d", ct); run_task(curtask); curtask->lastrun = cyclestart; - write_byte('\n'); } } diff --git a/int/sds.c b/int/sds.c index 80c31f9..6b96c6c 100644 --- a/int/sds.c +++ b/int/sds.c @@ -73,6 +73,7 @@ void sds_publish(int id) } } debug("SDS identifier unknown: %d", id); + die(""); } int sds_fetch(int id) @@ -82,6 +83,7 @@ int sds_fetch(int id) if(sdss[cs].used && sdss[cs].id == id) return sdss[cs].value; debug("SDS identifier unknown: %d", id); + die(""); return 0; } @@ -95,4 +97,5 @@ void sds_store(int id, int val) } } debug("SDS identifier unknown: %d", id); + die(""); } diff --git a/int/task.c b/int/task.c index 8fde866..a08e791 100644 --- a/int/task.c +++ b/int/task.c @@ -29,22 +29,18 @@ int task_register(void) memset(&tasks[ct], 0, sizeof(struct task)); //Read interval tasks[ct].interval = read16(); - debug("interval"); - debugi(tasks[ct].interval); //Read tasklength tasks[ct].tlen = read16(); - debug("length"); - debugi(tasks[ct].tlen); + debug("task interval: %d, length: %d\n", + tasks[ct].interval, tasks[ct].tlen); if(tasks[ct].tlen > MAXTASKSIZE) die("Task is too long: %d", tasks[ct].tlen); //Read task bytecode for(unsigned int i = 0; i [Char] toByteVal b -# bt = toChar $ consIndex{|*|} b + 1 +# bt = toChar $ consIndex{|*|} b = [bt:case b of (BCPush i) = i (BCLab i) = [toChar i] @@ -159,7 +159,7 @@ BCIfStmt b t e = b <++> retrn [BCJmpF else] <++> t <++> retrn [BCJmp endif,BCLab else] <++> e <++> retrn [BCLab endif] -instance noOp ByteCode where noOp = mempty +instance noOp ByteCode where noOp = retrn [BCNop] withLabel :: (Int -> (ByteCode b q)) -> ByteCode b q withLabel f = BC \s->let [fresh:fs] = s.freshl diff --git a/mTaskMakeSymbols.icl b/mTaskMakeSymbols.icl index b505ee8..f92cb2a 100644 --- a/mTaskMakeSymbols.icl +++ b/mTaskMakeSymbols.icl @@ -31,7 +31,7 @@ toDefine i b = "#define " <+ toUpperCase (consName{|*|} b) <+ " " <+ i Start w # (io, w) = stdio w # io = io <<< "#ifndef MTASK_H\n#define MTASK_H\n" -# io = io <<< join "\n" (zipWith toDefine [1..] conses{|*|}) +# io = io <<< join "\n" (zipWith toDefine [0..] conses{|*|}) # (ok, w) = fclose (io <<< "\n#endif\n") w | not ok = abort "Couldn't close stdio" = w diff --git a/miTask.icl b/miTask.icl index 5df0450..2e80bb3 100644 --- a/miTask.icl +++ b/miTask.icl @@ -21,24 +21,48 @@ import iTasks._Framework.Store import TTY derive class iTask Queue, TTYSettings, Parity, BaudRate, ByteSize -derive class iTask MTaskMSGRecv, MTaskMSGSend +derive class iTask MTaskMSGRecv, MTaskMSGSend, SerTCP +:: SerTCP = Serial | TCP :: *Resource | TTYd !*TTY Start :: *World -> *World -Start world = startEngine (withShared ([], False, [], False) mTaskTask) world +Start world = startEngine mTaskTask world //Start world = startEngine mTaskTask world -// -deviceSelectorNetwork :: Task (Int, String) -deviceSelectorNetwork = enterInformation "Port Number?" [] - -&&- enterInformation "Network address" [] - -deviceSelectorSerial :: Task (String, TTYSettings) -deviceSelectorSerial = accWorld getDevices - >>= \dl->(enterChoice "Device" [] dl -&&- deviceSettings) - where - deviceSettings = updateInformation "Settings" [] zero +bc :: Main (ByteCode () Stmt) +bc = sds \x=1 In sds \pinnetje=1 In {main = + IF (digitalRead D3 ==. lit True) ( + x =. x +. lit 1 :. + pub x + ) ( + noOp + ) :. + IF (pinnetje ==. lit 1) ( + digitalWrite D0 (lit True) :. + digitalWrite D1 (lit False) :. + digitalWrite D2 (lit False) + ) ( + IF (pinnetje ==. lit 2) ( + digitalWrite D0 (lit False) :. + digitalWrite D1 (lit True) :. + digitalWrite D2 (lit False) + ) ( + digitalWrite D0 (lit False) :. + digitalWrite D1 (lit False) :. + digitalWrite D2 (lit True) + ) + )} + +deviceSelector :: (Shared ([MTaskMSGRecv],[MTaskMSGSend],Bool)) -> Task () +deviceSelector ch = enterInformation "Type" [] + >>= \ty->case ty of + TCP = (enterInformation "Host" [] -&&- enterInformation "Port" []) + >>= \(port,host)->syncNetworkChannel host port ch +// Serial = accWorld getDevices +// >>= \dl->(enterChoice "Device" [] dl -&&- enterInformation "Settings" []) +// >>= \(dev,set)->syncSerialChannel dev set decode encode ch + where getDevices :: !*World -> *(![String], !*World) getDevices w = case readDirectory "/dev" w of (Error (errcode, errmsg), w) = abort errmsg @@ -47,30 +71,28 @@ deviceSelectorSerial = accWorld getDevices isTTY s = not (isEmpty (filter (flip startsWith s) prefixes)) prefixes = ["ttyS", "ttyACM", "ttyUSB", "tty.usbserial"] -derive class iTask SerTCP -:: SerTCP = Serial | TCP -mTaskTask :: (Shared ([MTaskMSGRecv],Bool,[MTaskMSGSend],Bool)) -> Task () -mTaskTask ch = - (enterInformation "Choose" [] >>= \st->case st of - Serial = deviceSelectorSerial >>= \(s,set)->syncSerialChannel s set decode encode ch - TCP = deviceSelectorNetwork >>= \(p,h)->syncNetworkChannel h p "\n" decode encode ch - ) ||- - ( - sendMsg msgs ch >>= \_->( - consumeNetworkStream (processSDSs sdsShares messageShare) ch ||- - viewSharedInformation "channels" [ViewWith lens] ch ||- - viewSharedInformation "messages" [] messageShare ||- - viewSh sdsShares ch - ) - ) >>* [OnAction ActionFinish (always shutDown)] +mTaskTask :: Task () +mTaskTask = let (msgs, sdsShares) = makeMsgs 500 bc in + withShared ([], msgs, False) (\ch-> + deviceSelector ch +// ||- sendTasks msgs ch//sendMsg msgs ch +// ||- (whileUnchanged ch (process sdsShares messageShare ch)) + ||- viewSharedInformation "channels" [ViewWith lens] ch + ||- viewSharedInformation "messages" [] messageShare + ||- viewSh sdsShares ch + >>* [OnAction ActionFinish (always shutDown)] + ) where messageShare :: Shared [String] messageShare = sharedStore "mTaskMessagesRecv" [] - processSDSs :: [(Int, Shared Int)] (Shared [String]) [MTaskMSGRecv] -> Task () - processSDSs _ _ [] = return () - processSDSs s y [x:xs] = updateSDSs s y x >>= \_->processSDSs s y xs + makeMsgs :: Int (Main (ByteCode () Stmt)) -> ([MTaskMSGSend], [(Int, Shared Int)]) + makeMsgs timeout bc + # (msgs, st) = toMessages timeout (toRealByteCode (unMain bc)) + = (msgs, map f st.sdss) + where + f (i,d) = (i, sharedStore ("mTaskSDS-" +++ toString i) 0) updateSDSs :: [(Int, Shared Int)] (Shared [String]) MTaskMSGRecv -> Task () updateSDSs _ m (MTMessage s) = upd (\l->take 20 [s:l]) m @! () @@ -79,14 +101,10 @@ mTaskTask ch = | id == i = set ((toInt d.[0])*265 + toInt d.[1]) sh @! () = updateSDSs xs m n - lens :: ([MTaskMSGRecv],Bool,[MTaskMSGSend],Bool) -> ([String], [String]) - lens (r,_,s,_) = (f r, map toString s) - where - f [] = [] - f [MTEmpty:xs] = f xs - f [x:xs] = [toString x:f xs] + lens :: ([MTaskMSGRecv], [MTaskMSGSend],Bool) -> ([String], [String]) + lens (r,s,_) = (map toString r, map toString s) - viewSh :: [(Int, Shared Int)] (Shared ([MTaskMSGRecv],Bool,[MTaskMSGSend],Bool)) -> Task () + viewSh :: [(Int, Shared Int)] (Shared ([MTaskMSGRecv],[MTaskMSGSend],Bool)) -> Task () viewSh [] ch = return () viewSh [(i, sh):xs] ch # sharename = "SDS-" +++ toString i @@ -104,50 +122,8 @@ mTaskTask ch = ) ) ||- viewSh xs ch - sdsShares = makeShares st - (msgs, st) = toMessages 1000 (toRealByteCode (unMain bc)) - - bc :: Main (ByteCode () Stmt) - bc = sds \x=1 In sds \pinnetje=1 In {main = - IF (digitalRead D3 ==. lit True) ( - x =. x +. lit 1 :. - pub x - ) ( - noOp - ) :. - IF (pinnetje ==. lit 1) ( - digitalWrite D0 (lit True) :. - digitalWrite D1 (lit False) :. - digitalWrite D2 (lit False) - ) ( - IF (pinnetje ==. lit 2) ( - digitalWrite D0 (lit False) :. - digitalWrite D1 (lit True) :. - digitalWrite D2 (lit False) - ) ( - digitalWrite D0 (lit False) :. - digitalWrite D1 (lit False) :. - digitalWrite D2 (lit True) - ) - )} - -makeShares :: BCState -> [(Int, Shared Int)] -makeShares {sdss=[]} = [] -makeShares s=:{sdss=[(i,d):xs]} = - [(i, sharedStore ("mTaskSDS-" +++ toString i) 1):makeShares {s & sdss=xs}] - -//makeBytecode :: Int (Main (ByteCode () Stmt)) -> ([MTaskMSGSend], [(Int, Shared Int)]) -//makeBytecode timeout bc -//# (msgs, st) = toMessages timeout (toRealByteCode (unMain bc)) -//# shares = map (\(i,d)->(i, sharedStore (s i) (dd d))) st.sdss -//= (msgs, shares) -// where -// s i = "mTaskSDS-" +++ toString i -// dd [x,y] = (toInt x)*265+(toInt y) - - -sendMsg :: [MTaskMSGSend] (Shared ([MTaskMSGRecv],Bool,[MTaskMSGSend],Bool)) -> Task () -sendMsg m ch = upd (\(r,rs,s,ss)->(r,rs,s ++ m,ss)) ch @! () +sendMsg :: [MTaskMSGSend] (Shared ([MTaskMSGRecv],[MTaskMSGSend],Bool)) -> Task () +sendMsg m ch = upd (\(r,s,ss)->(r,s ++ m,True)) ch @! () syncSerialChannel :: String TTYSettings (String -> m) (n -> String) (Shared ([m],Bool,[n],Bool)) -> Task () | iTask m & iTask n syncSerialChannel dev opts decodeFun encodeFun rw = Task eval @@ -170,7 +146,7 @@ syncSerialChannel dev opts decodeFun encodeFun rw = Task eval # (TTYd tty) = fromJust resources # (ok, world) = TTYclose tty world # iworld = {iworld & world=world,resources=Nothing} - = case removeBackgroundTask 42 iworld of + = case removeBackgroundTask 42 iworld of (Error e, iworld) = (ExceptionResult (exception "h"), iworld) (Ok _, iworld) = (DestroyedResult, iworld) @@ -198,37 +174,19 @@ serialDeviceBackgroundTask rw de en iworld writet [x:xs] t = writet xs (TTYwrite x t) -syncNetworkChannel :: String Int String (String -> m) (n -> String) (Shared ([m],Bool,[n],Bool)) -> Task () | iTask m & iTask n -syncNetworkChannel server port msgSeparator decodeFun encodeFun channel +syncNetworkChannel :: String Int (Shared ([MTaskMSGRecv], [MTaskMSGSend], Bool)) -> Task () +syncNetworkChannel server port channel = tcpconnect server port channel {ConnectionHandlers|onConnect=onConnect,whileConnected=whileConnected,onDisconnect=onDisconnect} @! () where - onConnect _ (received,receiveStopped,send,sendStopped) - = (Ok "",if (not (isEmpty send)) (Just (received,False,[],sendStopped)) Nothing, map encodeFun send,False) - whileConnected Nothing acc (received,receiveStopped,send,sendStopped) - | not (trace_tn "whilec nothing") = undef - = (Ok acc, Nothing, [], False) - whileConnected (Just newData) acc (received,receiveStopped,send,sendStopped) - | not (trace_tn "whilec just") = undef - # [acc:msgs] = reverse (split msgSeparator (concat [acc,newData])) - # write = if (not (isEmpty msgs && isEmpty send)) - (Just (received ++ map decodeFun (reverse msgs),receiveStopped,[],sendStopped)) - Nothing - = (Ok acc,write,map encodeFun send,False) - - onDisconnect l (received,receiveStopped,send,sendStopped) - = (Ok l,Just (received,True,send,sendStopped)) - -consumeNetworkStream :: ([m] -> Task ()) (Shared ([m],Bool,[n],Bool)) -> Task () | iTask m & iTask n -consumeNetworkStream processTask channel - = ((watch channel >>* [OnValue (ifValue ifProcess process)]) >| if (isEmpty received) (return ()) (processTask received) - @! receiveStopped + onConnect :: String ([MTaskMSGRecv],[MTaskMSGSend],Bool) -> (MaybeErrorString String, Maybe ([MTaskMSGRecv],[MTaskMSGSend],Bool), [String], Bool) + onConnect _ (msgs,send,sendStopped) + = (Ok "", Just (msgs,[],sendStopped), map encode send, False) + + whileConnected :: (Maybe String) String ([MTaskMSGRecv], [MTaskMSGSend],Bool) -> (MaybeErrorString String, Maybe ([MTaskMSGRecv],[MTaskMSGSend],Bool), [String], Bool) + whileConnected maybeNewData acc (msgs,send,sendStopped) + # l = map decode (maybeToList maybeNewData) + # send = if (not sendStopped) [] (map encode send) + = (Ok acc, Just (msgs ++ l,[],sendStopped), send, False) - empty :: ([m],Bool,[n],Bool) -> ([m],Bool,[n],Bool) - empty (_,rs,s,ss) = ([],rs,s,ss) + onDisconnect :: String ([MTaskMSGRecv],[MTaskMSGSend],Bool) -> (MaybeErrorString String, Maybe ([MTaskMSGRecv],[MTaskMSGSend],Bool)) + onDisconnect l (msgs,send,sendStopped) = (Ok l, Nothing) -- 2.20.1