demo

diff --git a/int/interface.c b/int/interface.c
index 6809110..8106945 100644 (file)
--- a/int/interface.c
+++ b/int/interface.c
@@ -30,10 +30,6 @@ uint64_t dpins[] = {LINE_ARD_D0, LINE_ARD_D1, LINE_ARD_D2, LINE_ARD_D3,
        LINE_ARD_D14, LINE_ARD_D15};
 void write_dpin(uint8_t i, bool b)
 {
        LINE_ARD_D14, LINE_ARD_D15};
 void write_dpin(uint8_t i, bool b)
 {

-       if(i == 0){ palWriteLine(LINE_LED1, b ? PAL_HIGH : PAL_LOW);
-       } else if(i == 1){ palWriteLine(LINE_LED2, b ? PAL_HIGH : PAL_LOW);
-       } else if(i == 2){ palWriteLine(LINE_LED3, b ? PAL_HIGH : PAL_LOW);
-       }

        palWriteLine(dpins[i], b ? PAL_HIGH : PAL_LOW);
 }
 
        palWriteLine(dpins[i], b ? PAL_HIGH : PAL_LOW);
 }
 


@@ -57,6 +53,28 @@ uint8_t read_apin(uint8_t i)
        (void) i;
 }
 
        (void) i;
 }
 

+void led_on(uint8_t i)
+{
+       if(i == 0){
+               palWriteLine(LINE_LED1, PAL_HIGH);
+       } else if(i == 1){
+               palWriteLine(LINE_LED2, PAL_HIGH);
+       } else if(i == 2){
+               palWriteLine(LINE_LED3, PAL_HIGH);
+       }
+}
+
+void led_off(uint8_t i)
+{
+       if(i == 0){
+               palWriteLine(LINE_LED1, PAL_LOW);
+       } else if(i == 1){
+               palWriteLine(LINE_LED2, PAL_LOW);
+       } else if(i == 2){
+               palWriteLine(LINE_LED3, PAL_LOW);
+       }
+}
+

 long millis(void){
        return ST2MS(chVTGetSystemTime());
 }
 long millis(void){
        return ST2MS(chVTGetSystemTime());
 }

diff --git a/int/interface.h b/int/interface.h
index d3361df..f3920eb 100644 (file)
--- a/int/interface.h
+++ b/int/interface.h
@@ -22,6 +22,9 @@ bool read_dpin(uint8_t i);
 void write_apin(uint8_t i, uint8_t a);
 uint8_t read_apin(uint8_t i);
 
 void write_apin(uint8_t i, uint8_t a);
 uint8_t read_apin(uint8_t i);
 

+void led_on(uint8_t i);
+void led_off(uint8_t i);
+

 long millis(void);
 bool input_available(void);
 void delay(long ms);
 long millis(void);
 bool input_available(void);
 void delay(long ms);

diff --git a/int/interpret.c b/int/interpret.c
index 683638f..39c24b0 100644 (file)
--- a/int/interpret.c
+++ b/int/interpret.c
@@ -139,6 +139,12 @@ void run_task(struct task *t)
                        write_dpin(program[pc++], stack[sp-1]);
                        sp--;
                        break;
                        write_dpin(program[pc++], stack[sp-1]);
                        sp--;
                        break;

+               case BCLEDON: trace("LedOn(%d)", program[pc]);
+                       led_on(program[pc++]);
+                       break;
+               case BCLEDOFF: trace("LedOn(%d)", program[pc]);
+                       led_off(program[pc++]);
+                       break;

                default:
                        trace("unrecognized");
                        die("Unrecognized command: %d", program[pc-1]);
                default:
                        trace("unrecognized");
                        die("Unrecognized command: %d", program[pc-1]);

diff --git a/int/mTaskSymbols.h b/int/mTaskSymbols.h
index 3eb218a..57959af 100644 (file)
--- a/int/mTaskSymbols.h
+++ b/int/mTaskSymbols.h
@@ -23,14 +23,16 @@
 #define BCJMP 20
 #define BCJMPT 21
 #define BCJMPF 22
 #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
+#define BCLEDON 23
+#define BCLEDOFF 24
+#define BCSERIALAVAIL 25
+#define BCSERIALPRINT 26
+#define BCSERIALPRINTLN 27
+#define BCSERIALREAD 28
+#define BCSERIALPARSEINT 29
+#define BCANALOGREAD 30
+#define BCANALOGWRITE 31
+#define BCDIGITALREAD 32
+#define BCDIGITALWRITE 33
+#define BCTEST 34

 #endif
 #endif

diff --git a/mTask.dcl b/mTask.dcl
index c7a6a3a..114012c 100644 (file)
--- a/mTask.dcl
+++ b/mTask.dcl
@@ -32,6 +32,7 @@ import mTaskSerial, mTaskLCD
 :: DigitalPin 
    = D0 | D1 | D2 | D3 | D4 | D5 |D6 | D7 | D8 | D9 | D10 | D11 | D12 | D13
 :: AnalogPin = A0 | A1 | A2 | A3 | A4 | A5
 :: DigitalPin 
    = D0 | D1 | D2 | D3 | D4 | D5 |D6 | D7 | D8 | D9 | D10 | D11 | D12 | D13
 :: AnalogPin = A0 | A1 | A2 | A3 | A4 | A5

+:: UserLED = LED1 | LED2 | LED3

 :: PinMode   = INPUT | OUTPUT | INPUT_PULLUP
 :: Pin     = Digital DigitalPin | Analog AnalogPin
 
 :: PinMode   = INPUT | OUTPUT | INPUT_PULLUP
 :: Pin     = Digital DigitalPin | Analog AnalogPin
 


@@ -127,6 +128,10 @@ class time v where
   delay  :: (v Long p) -> (v Long Expr)
   millis ::         (v Long Expr)
 
   delay  :: (v Long p) -> (v Long Expr)
   millis ::         (v Long Expr)
 

+class userLed v where
+       ledOn :: UserLED -> (v () Stmt)
+       ledOff :: UserLED -> (v () Stmt)
+

 class pio p t where pio :: p -> v t Upd | aIO v & dIO v
 instance pio AnalogPin Int
 instance pio AnalogPin Bool
 class pio p t where pio :: p -> v t Upd | aIO v & dIO v
 instance pio AnalogPin Int
 instance pio AnalogPin Bool

diff --git a/mTaskInterpret.dcl b/mTaskInterpret.dcl
index 0cf8ef3..0105944 100644 (file)
--- a/mTaskInterpret.dcl
+++ b/mTaskInterpret.dcl
@@ -50,6 +50,9 @@ decode :: String -> MTaskMSGRecv
        | BCJmp Int
        | BCJmpT Int
        | BCJmpF Int
        | BCJmp Int
        | BCJmpT Int
        | BCJmpF Int

+       //UserLED
+       | BCLedOn [Char]
+       | BCLedOff [Char]

        //Serial
        | BCSerialAvail
        | BCSerialPrint
        //Serial
        | BCSerialAvail
        | BCSerialPrint


@@ -81,12 +84,14 @@ instance toByteCode Char
 instance toByteCode String
 instance toByteCode Long
 instance toByteCode Button
 instance toByteCode String
 instance toByteCode Long
 instance toByteCode Button

+instance toByteCode UserLED

 
 instance toChar Pin
 instance arith ByteCode
 instance boolExpr ByteCode
 instance analogIO ByteCode
 instance digitalIO ByteCode
 
 instance toChar Pin
 instance arith ByteCode
 instance boolExpr ByteCode
 instance analogIO ByteCode
 instance digitalIO ByteCode

+instance userLed ByteCode

 //instance If ByteCode Stmt Stmt Stmt
 //instance If ByteCode e Stmt Stmt
 //instance If ByteCode Stmt e Stmt
 //instance If ByteCode Stmt Stmt Stmt
 //instance If ByteCode e Stmt Stmt
 //instance If ByteCode Stmt e Stmt

diff --git a/mTaskInterpret.icl b/mTaskInterpret.icl
index 180939c..1833e62 100644 (file)
--- a/mTaskInterpret.icl
+++ b/mTaskInterpret.icl
@@ -64,6 +64,8 @@ bclength (BCAnalogRead _) = 2
 bclength (BCAnalogWrite _) = 2
 bclength (BCDigitalRead _) = 2
 bclength (BCDigitalWrite _) = 2
 bclength (BCAnalogWrite _) = 2
 bclength (BCDigitalRead _) = 2
 bclength (BCDigitalWrite _) = 2

+bclength (BCLedOn _) = 2
+bclength (BCLedOff _) = 2

 bclength (BCJmp i) = 2
 bclength (BCJmpT i) = 2
 bclength (BCJmpF i) = 2
 bclength (BCJmp i) = 2
 bclength (BCJmpT i) = 2
 bclength (BCJmpF i) = 2


@@ -82,6 +84,8 @@ toByteVal b
                (BCAnalogWrite i) = [toChar i]
                (BCDigitalRead i) = [toChar i]
                (BCDigitalWrite i) = [toChar i]
                (BCAnalogWrite i) = [toChar i]
                (BCDigitalRead i) = [toChar i]
                (BCDigitalWrite i) = [toChar i]

+               (BCLedOn i) = i
+               (BCLedOff i) = i

                (BCJmp i) = [toChar i]
                (BCJmpT i) = [toChar i]
                (BCJmpF i) = [toChar i]
                (BCJmp i) = [toChar i]
                (BCJmpT i) = [toChar i]
                (BCJmpF i) = [toChar i]


@@ -114,13 +118,14 @@ 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 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 toChar Pin where
        toChar (Digital p) = toChar $ consIndex{|*|} p
        toChar (Analog p) = toChar $ consIndex{|*|} p
 
 derive gPrint BC, AnalogPin, Pin, DigitalPin
 
 instance toChar Pin where
        toChar (Digital p) = toChar $ consIndex{|*|} p
        toChar (Analog p) = toChar $ consIndex{|*|} p
 
 derive gPrint BC, AnalogPin, Pin, DigitalPin

-derive consIndex BC, Pin, Button
+derive consIndex BC, Pin, Button, UserLED

 derive consName BC, Pin, Button
 
 instance arith ByteCode where
 derive consName BC, Pin, Button
 
 instance arith ByteCode where


@@ -207,6 +212,10 @@ instance serial ByteCode where
        serialRead = retrn [BCSerialRead]
        serialParseInt = retrn [BCSerialParseInt]
 
        serialRead = retrn [BCSerialRead]
        serialParseInt = retrn [BCSerialParseInt]
 

+instance userLed ByteCode where
+       ledOn l = retrn [BCLedOn $ toByteCode l]
+       ledOff l = retrn [BCLedOff $ toByteCode l]
+

 instance zero BCState where
        zero = {freshl=[1..], freshs=[1..], sdss=[]}
 
 instance zero BCState where
        zero = {freshl=[1..], freshs=[1..], sdss=[]}
 


@@ -241,11 +250,6 @@ 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)
 

-//Start :: String
-//Start = toReadableByteCode bc
-//     where
-//             bc :: ByteCode Int Expr
-//             bc = (lit 36 +. lit 42) +. lit 44

 toMessages :: Int (String, BCState) -> ([MTaskMSGSend], BCState)
 toMessages interval (bytes, st=:{sdss}) = ([MTSds i (toString b)\\(i,b)<-sdss] ++ [MTTask interval bytes], st)
 
 toMessages :: Int (String, BCState) -> ([MTaskMSGSend], BCState)
 toMessages interval (bytes, st=:{sdss}) = ([MTSds i (toString b)\\(i,b)<-sdss] ++ [MTTask interval bytes], st)
 


@@ -253,15 +257,11 @@ toSDSUpdate :: Int Int -> [MTaskMSGSend]
 toSDSUpdate i v = [MTUpd i (to16bit v)]
 
 Start = toMessages 500 $ toRealByteCode (unMain bc)
 toSDSUpdate i v = [MTUpd i (to16bit v)]
 
 Start = toMessages 500 $ toRealByteCode (unMain bc)

-//Start = fst $ toReadableByteCode $ unMain bc

        where
                bc = sds \x=5 In 
                        sds \y=4 In
                        {main = If (y ==. lit 0) (pub x) (x =. x *. y :. y =. y -. lit 1)}
 
        where
                bc = sds \x=5 In 
                        sds \y=4 In
                        {main = If (y ==. lit 0) (pub x) (x =. x *. y :. y =. y -. lit 1)}
 

-//pub :: (ByteCode a b) -> ByteCode a b
-//pub x = fmp makePub x
-

 to16bit :: Int -> String
 to16bit i = toString (toChar (i/256)) +++ toString (toChar (i rem 256))
 
 to16bit :: Int -> String
 to16bit i = toString (toChar (i/256)) +++ toString (toChar (i rem 256))
 

diff --git a/miTask.icl b/miTask.icl
index 407e930..2757450 100644 (file)
--- a/miTask.icl
+++ b/miTask.icl
@@ -21,7 +21,7 @@ import iTasks._Framework.Store
 import TTY
 
 derive class iTask Queue, TTYSettings, Parity, BaudRate, ByteSize
 import TTY
 
 derive class iTask Queue, TTYSettings, Parity, BaudRate, ByteSize

-derive class iTask MTaskMSGRecv, MTaskMSGSend, SerTCP
+derive class iTask MTaskMSGRecv, MTaskMSGSend, SerTCP, UserLED

 
 :: SerTCP = Serial | TCP
 :: *Resource | TTYd !*TTY
 
 :: SerTCP = Serial | TCP
 :: *Resource | TTYd !*TTY


@@ -39,20 +39,20 @@ bc = sds \x=1 In sds \pinnetje=1 In {main =
                        noOp
                ) :.
                IF (pinnetje ==. lit 1) (
                        noOp
                ) :.
                IF (pinnetje ==. lit 1) (

-                       digitalWrite D0 (lit True)
+                       ledOn LED1

                ) (
                        IF (pinnetje ==. lit 2) (
                ) (
                        IF (pinnetje ==. lit 2) (

-                               digitalWrite D1 (lit True)
+                               ledOn LED2

                        ) (
                        ) (

-                               digitalWrite D2 (lit True)
+                               ledOn LED3

                        )
                )}
 
                        )
                )}
 

-bc2 :: DigitalPin -> Main (ByteCode () Stmt)
-bc2 d = {main = digitalWrite d (lit True) :. noOp}
+bc2 :: UserLED -> Main (ByteCode () Stmt)
+bc2 d = {main = ledOn d}

 
 

-bc3 :: DigitalPin -> Main (ByteCode () Stmt)
-bc3 d = {main = digitalWrite d (lit False) :. noOp}
+bc3 :: UserLED -> Main (ByteCode () Stmt)
+bc3 d = {main = ledOff d}

 
 
 withDevice :: ((Shared ([MTaskMSGRecv],[MTaskMSGSend],Bool)) -> Task a) -> Task a | iTask a
 
 
 withDevice :: ((Shared ([MTaskMSGRecv],[MTaskMSGSend],Bool)) -> Task a) -> Task a | iTask a


@@ -78,9 +78,9 @@ mTaskTask = let (msgs, sdsShares) = makeMsgs 1000 bc in
        withDevice \ch->
                        sendMsg msgs ch
                ||- processMessages ch messageShare sdsShares
        withDevice \ch->
                        sendMsg msgs ch
                ||- processMessages ch messageShare sdsShares

-               ||- forever (enterChoice "Choose led to enable" [] [D0, D1, D2]
+               ||- forever (enterChoice "Choose led to enable" [] [LED1, LED2, LED3]

                                >>= \p->sendMsg (fst (makeMsgs 0 (bc2 p))) ch)
                                >>= \p->sendMsg (fst (makeMsgs 0 (bc2 p))) ch)

-               ||- forever (enterChoice "Choose led to disable" [] [D0, D1, D2]
+               ||- forever (enterChoice "Choose led to disable" [] [LED1, LED2, LED3]

                                >>= \p->sendMsg (fst (makeMsgs 0 (bc3 p))) ch)
                ||- viewSharedInformation "channels" [ViewWith lens] ch
                ||- viewSharedInformation "messages" [] messageShare
                                >>= \p->sendMsg (fst (makeMsgs 0 (bc3 p))) ch)
                ||- viewSharedInformation "channels" [ViewWith lens] ch
                ||- viewSharedInformation "messages" [] messageShare


@@ -111,8 +111,8 @@ mTaskTask = let (msgs, sdsShares) = makeMsgs 1000 bc in
                | id == i = set ((toInt d.[0])*265 + toInt d.[1]) sh @! ()
                = updateSDSs xs m n
                updateSDSs _ m mtm = case mtm of
                | id == i = set ((toInt d.[0])*265 + toInt d.[1]) sh @! ()
                = updateSDSs xs m n
                updateSDSs _ m mtm = case mtm of

-                       MTMessage s = upd (\l->take 20 [s:l]) m @! ()
-                       mta=:(MTTaskAdded _) = upd (\l->take 20 [toString mta:l]) m @! ()
+                       MTMessage s = upd (\l->take 5 [s:l]) m @! ()
+                       mta=:(MTTaskAdded _) = upd (\l->take 5 [toString mta:l]) m @! ()

                        _ = return ()
 
                lens :: ([MTaskMSGRecv], [MTaskMSGSend],Bool) -> ([String], [String])
                        _ = return ()
 
                lens :: ([MTaskMSGRecv], [MTaskMSGSend],Bool) -> ([String], [String])