...
 
Commits (110)
......@@ -5,8 +5,3 @@ _Tests.*
*-sapl
*-www
*-data
*.prj
*.prp
* Time Profile.pcl
*.exe
a.out
CFLAGS?=-Wall -Wextra
ifeq ($(OS), Windows_NT)
DETECTED_OS?=Windows
CC=gcc
else
DETECTED_OS?=POSIX
endif
LIBFILES=$(wildcard $(DETECTED_OS)/*library)
VPATH = src:../csource
all: $(addprefix Clean\ System\ Files/,ctty.o $(LIBFILES))
Clean\ System\ Files/%: %
mkdir -p "Clean System Files"
cp "$<" "Clean System Files"
ctty.o: tty.c
$(COMPILE.c) $(OUTPUT_OPTION) $<
clean:
$(RM) -rf *.o Clean\ System\ Files
#define Clean(a)
typedef struct clean_string *CleanString;
/* a string in Clean is:
struct clean_string {
size_t clean_string_length;
char clean_string_characters[clean_string_length];
};
The string does not end with a '\0' !
*/
#ifndef _WIN64
/* CleanStringLength(clean_string) returns the length of the clean_string in characters */
#define CleanStringLength(clean_string) (*(unsigned long *)(clean_string))
/* CleanStringCharacters(clean_string) returns a pointer to the characters of the clean_string */
#define CleanStringCharacters(clean_string) ((char*)(1+(unsigned long *)(clean_string)))
/* CleanStringSizeInts(string_length) return size of *CleanString in integers */
#define CleanStringSizeInts(string_length) (1+(((unsigned long)(string_length)+(sizeof(unsigned long)-1))>>(1+(sizeof(unsigned long)>>2))))
/* CleanStringVariable(clean_string,string_length) defines variable clean_string with length string_length,
before using the clean_string variable, cast to CleanString, except for the macros above */
#define CleanStringVariable(clean_string,string_length) unsigned long clean_string[CleanStringSizeInts(string_length)]
/* CleanStringSizeBytes(string_length) return size of *CleanString in bytes */
#define CleanStringSizeBytes(string_length) ((sizeof(unsigned long)<<1)+(((unsigned long)(string_length)+(sizeof(unsigned long)-1)) & -(sizeof(unsigned long))))
typedef long *CleanIntArray;
/* CleanIntArraySize(clean_array) returns the size (number of elements) of the clean_int_array */
#define CleanIntArraySize(clean_int_array) (((unsigned long *)(clean_int_array))[-2])
/* CleanRealArraySize(clean_real_array) returns the size (number of elements) of the clean_real_array */
#define CleanRealArraySize(clean_real_array) (((unsigned long *)(clean_real_array))[-2])
/* CleanCharArraySize(clean_char_array) returns the size (number of elements) of the clean_char_array */
#define CleanCharArraySize(clean_char_array) (((unsigned long *)(clean_char_array))[-1])
#else
/* CleanStringLength(clean_string) returns length of the clean_string in characters */
#define CleanStringLength(clean_string) (*(unsigned __int64 *)(clean_string))
/* CleanStringCharacters(clean_string) returns a pointer to the characters of the clean_string */
#define CleanStringCharacters(clean_string) ((char*)(1+(unsigned __int64 *)(clean_string)))
/* CleanStringSizeInts(string_length) return size of *CleanString in integers */
#define CleanStringSizeInts(string_length) (1+(((unsigned __int64)(string_length)+7)>>3))
/* CleanStringVariable(clean_string,string_length) defines variable clean_string with length string_length,
before using the clean_string variable, cast to CleanString, except for the macros above */
#define CleanStringVariable(clean_string,string_length) unsigned __int64 clean_string[CleanStringSizeInts(string_length)]
/* CleanStringSizeBytes(string_length) return size of *CleanString in bytes */
#define CleanStringSizeBytes(string_length) (8+(((unsigned __int64)(string_length)+7) & -8))
typedef __int64 *CleanIntArray;
/* CleanIntArraySize(clean_array) returns the size (number of elements) of the clean_int_array */
#define CleanIntArraySize(clean_int_array) (((unsigned __int64 *)(clean_int_array))[-2])
/* CleanRealArraySize(clean_real_array) returns the size (number of elements) of the clean_real_array */
#define CleanRealArraySize(clean_real_array) (((unsigned __int64 *)(clean_real_array))[-2])
/* CleanCharArraySize(clean_char_array) returns the size (number of elements) of the clean_char_array */
#define CleanCharArraySize(clean_char_array) (((unsigned __int64 *)(clean_char_array))[-1])
#endif
typedef double *CleanRealArray;
typedef unsigned char *CleanCharArray;
CC=gcc
OBJS:=systemsignal.o
OBJS:=$(wildcard *.c)
all: $(OBJS)
install: $(OBJS)
mkdir -p ../libraries/OS-Independent/Clean\ System\ Files/
......
//Windows imports
#ifdef _WIN32
#include <windows.h>
typedef HANDLE ttyhandle;
//Posix imports
#else
#include <ctype.h>
#include <errno.h>
#include <fcntl.h>
#include <unistd.h>
#include <stdlib.h>
#include <string.h>
#include <time.h>
#include <termios.h>
#include <sys/ioctl.h>
typedef int ttyhandle;
#endif
//Common imports
#include <stdio.h>
#include <stdbool.h>
#include "Clean.h"
#ifdef DEBUG
#define debug(s) {printf("%s\n", s);}
#else
#define debug(s) ;
#endif
#ifdef __APPLE__
int CMSPAR = 0;
#endif
#define die(s) {perror(s);exit(EXIT_FAILURE);}
#ifdef _WIN32
static int baudrates[] = {0, 50, 75, 110, 134, 150, 200, 300, 600, 1200, 1800,
2400, 4800, 9600, 19200, 38400, 57600, 115200, 230400};
static int bytesizes[4] = {5, 6, 7, 8};
#else
static speed_t baudrates[] = {B0, B50, B75, B110, B134, B150, B200, B300, B600,
B1200, B1800, B2400, B4800, B9600, B19200, B38400, B57600, B115200,
B230400};
static int bytesizes[4] = {CS5, CS6, CS7, CS8};
#endif
static char *error = "NoError";
#ifdef _WIN32
#endif
static void *my_malloc(size_t s)
{
void *r;
#ifdef _WIN32
r = HeapAlloc(GetProcessHeap(), 0, s);
#else
if((r = malloc(s)) == NULL)
die("my_malloc");
#endif
return r;
}
static void my_free(void *p)
{
#ifdef _WIN32
HeapFree(GetProcessHeap(), 0, p);
#else
free(p);
#endif
}
static char *cleanStringToCString(CleanString s)
{
unsigned long len = CleanStringLength(s);
char *cs = (char *)my_malloc(len+1);
memcpy(cs, CleanStringCharacters(s), len);
cs[len] = '\0';
return cs;
}
#ifndef _WIN32
//This buggery is needed for linux systems that don't reset the termios settings...
struct termioslist
{
int fd;
struct termios to;
struct termioslist *next;
};
struct termioslist *head = NULL;
static struct termios *getTermios(int fd)
{
struct termioslist *h = head;
while(h != NULL)
if(h->fd == fd)
return &h->to;
return NULL;
}
static void remTermios(int fd)
{
struct termioslist *beforeit = NULL;
struct termioslist *it = head;
while(it != NULL){
if(it->fd == fd){
if(beforeit == NULL)
head = it->next;
else
beforeit->next = it->next;
my_free(it);
break;
}
beforeit = it;
it = it->next;
}
}
static void addTermios(int fd, struct termios *t)
{
struct termioslist *new = my_malloc(sizeof(struct termioslist));
new->fd = fd;
memcpy(&new->to, t, sizeof(struct termios));
new->next = NULL;
if(head == NULL){
head = new;
} else {
struct termioslist *h = head;
while(h->next != NULL)
h = h->next;
h->next = new;
}
}
#endif
void ttyopen(CleanString fn, int baudrate, int bytesize, int parity,
int stopbits, int xonoff, int sleepTime, int *status, ttyhandle *fd)
{
debug("ttyopen");
char *cs_fn = cleanStringToCString(fn);
debug(cs_fn);
*status = 0;
#ifdef _WIN32
*fd = CreateFile(cs_fn, GENERIC_READ | GENERIC_WRITE, 0, 0, OPEN_EXISTING, 0, 0);
debug("Opened");
if(*fd == INVALID_HANDLE_VALUE){
debug("Error opening");
error = strerror(errno);
return;
}
DCB dcb;
FillMemory(&dcb, sizeof(dcb), 0);
dcb.DCBlength = sizeof(dcb);
//Get
if (!GetCommState(*fd, &dcb)){
error = strerror(errno);
return;
}
//Baudrate
dcb.BaudRate = baudrates[baudrate];
//Bytesize
dcb.ByteSize = bytesizes[bytesize];
//Parity
if(parity == 0) {
dcb.fParity = false;
} else if(parity == 1) {
dcb.fParity = true;
dcb.Parity = ODDPARITY;
} else if(parity == 2) {
dcb.fParity = true;
dcb.Parity = EVENPARITY;
} else if(parity == 3) {
dcb.fParity = true;
//Parity space???
} else if( parity == 4) {
dcb.fParity = true;
dcb.Parity = MARKPARITY;
}
//Stopbits
if(stopbits != 0)
dcb.StopBits = ONESTOPBIT;
else
dcb.StopBits = TWOSTOPBITS;
//Xonoff
if(xonoff == 1)
dcb.fTXContinueOnXoff = true;
else
dcb.fTXContinueOnXoff = false;
//Set
//tio.c_oflag = 0;
//tio.c_lflag &= ~(ECHO | ECHONL | ICANON | IEXTEN | ISIG);
if (!SetCommState(*fd, &dcb)){
error = strerror(errno);
return;
}
*status = 1;
if(sleepTime > 0){
//Sleep on windows is in milliseconds...
Sleep(sleepTime*1000);
}
#else
struct termios tio;
*fd = open(cs_fn, O_RDWR | O_NOCTTY | O_NONBLOCK);
fcntl(*fd, F_SETFL, 0);
if(*fd < 0){
error = strerror(errno);
return;
}
//Get
tcgetattr(*fd, &tio);
addTermios(*fd, &tio);
//Baudrate
cfsetispeed(&tio, baudrates[baudrate]);
//Bytesize
tio.c_cflag &= ~CSIZE;
tio.c_cflag |= bytesizes[bytesize];
//Parity
if(parity == 0) {
tio.c_cflag &= ~PARENB | ~INPCK;
} else if(parity == 1) {
tio.c_cflag |= PARODD | PARENB;
} else if(parity == 2) {
tio.c_cflag |= PARENB;
tio.c_cflag &= ~PARODD;
} else if(parity == 3) {
tio.c_cflag |= PARENB | CMSPAR;
tio.c_cflag &= ~PARODD;
} else if( parity == 4) {
tio.c_cflag |= PARENB | CMSPAR | PARODD;
}
//Stopbits
if(stopbits != 0)
tio.c_cflag |= CSTOPB;
else
tio.c_cflag &= ~CSTOPB;
//Xonoff
if(xonoff == 1)
tio.c_cflag |= IXON;
else
tio.c_cflag &= ~IXON;
//Set
tio.c_oflag = 0;
tio.c_lflag &= ~(ECHO | ECHONL | ICANON | IEXTEN | ISIG);
#ifdef __APPLE__
tio.c_cflag |= CLOCAL;
#endif
tio.c_cc[VMIN]=1;
tio.c_cc[VTIME]=0;
tcsetattr(*fd, TCSANOW, &tio);
*status = 1;
error = strerror(errno);
if(sleepTime > 0){
sleep(sleepTime);
tcflush(*fd, TCIOFLUSH);
}
#endif
my_free(cs_fn);
debug("ttyopen-done");
}
unsigned long *errcl = NULL;
void ttyerror(CleanString *result)
{
debug("ttyerror");
if(errcl != NULL)
my_free(errcl);
errcl = my_malloc(
sizeof(unsigned long)*CleanStringSizeInts(strlen(error)));
*result = (CleanString) errcl;
memcpy(CleanStringCharacters(errcl), error, strlen(error));
CleanStringLength(errcl) = strlen(error);
debug("ttyerror-done");
}
void ttyread(ttyhandle fd, int *ch, ttyhandle *fdo)
{
debug("ttyread");
unsigned int c;
#ifdef _WIN32
long unsigned int bytes_read;
if(!ReadFile(fd, &c, 1, &bytes_read, NULL)){
die("ReadFile failed");
}
#else
if(read(fd, &c, 1) == -1){
die("read");
}
#endif
*ch = (int) c;
*fdo = fd;
debug("ttyread done");
}
void ttyavailable(ttyhandle fd, int *r, int *e, ttyhandle *fdo)
{
debug("ttyavailable");
*e = 0;
#ifdef _WIN32
COMSTAT cs;
if(ClearCommError(fd, NULL, &cs) == 0){
error = strerror(errno);
*e = 1;
return;
}
*r = cs.cbInQue > 0;
#else
fd_set rfds, efds;
struct timeval tv;
tv.tv_sec = 0;
tv.tv_usec = 0;
FD_ZERO(&rfds);
FD_SET(fd, &rfds);
FD_ZERO(&efds);
FD_SET(fd, &efds);
*r = select(fd+1, &rfds, NULL, &efds, &tv);
if (FD_ISSET(fd, &efds)){
*e = 1;
*fdo = fd;
return;
}
if(*r == -1)
die("select");
#endif
*fdo = fd;
// debug("ttyavailable-done");
}
ttyhandle ttywrite(CleanString s, ttyhandle fd)
{
debug("ttywrite");
#ifdef _WIN32
long unsigned int bytes_written;
WriteFile(fd, (void *)CleanStringCharacters(s), CleanStringLength(s), &bytes_written, NULL);
//TODO flush?
#else
write(fd, (void *)CleanStringCharacters(s), CleanStringLength(s));
tcdrain(fd);
#endif
debug("ttywrite-done");
return fd;
}
int ttyclose(ttyhandle fd)
{
debug("ttyclose");
int ret = 0;
#ifdef _WIN32
ret = CloseHandle(fd);
error = strerror(errno);
#else
struct termios *to = getTermios(fd);
tcsetattr(fd, TCSANOW, to);
remTermios(fd);
ret = close(fd) == 0;
error = strerror(errno);
#endif
debug("ttyclose-done");
return ret;
}
module SerialMonitor
import StdEnv
import Data.Either
import Data.Func
import System.Time
import iTasks
import System.TTY, iTasksTTY
Start w = startEngine manage w
manage = parallel
[(Embedded, \stl->tune (Title "New device") $ forever $
accWorld getTTYDevices
>>= \ds->enterChoice "Choose path" [] ["Other":ds]
>>= \path->updateInformation "TTY Settings" [] {zero & devicePath=path}
>>! \ts->appendTask Embedded (\_->tune (Title ts.devicePath) $ monitor ts @! ()) stl @! ())
]
[]
<<@ ArrangeWithTabs True
>>* [OnAction (Action "Shutdown") (always (shutDown 0))]
monitor ts = catchAll (
withShared ([], [], False) \channels->
syncSerialChannel {tv_sec=0,tv_nsec=100*1000000} ts id (\s->(Right [s], "")) channels
||- viewSharedInformation "Incoming messages" [ViewAs (take 20 o fst3)] channels
||- forever (
enterInformation "Send line of text" []
>>= \line->upd (\(r,w,s)->(r,w++[line+++"\n"],s)) channels
) @? const NoValue
) (\e->viewInformation "Exception occured" [] e)
>>* [OnAction (Action "Close") (always (treturn ""))]
module test
import StdEnv
import TTY
TTYerrorclose :: !*World -> *World
TTYerrorclose w
# (err, w) = TTYerror w
= cwrite err w
cwrite :: String !*World -> *World
cwrite s w
# (io, w) = stdio w
= snd (fclose (io <<< s <<< "\n") w)
Start :: *World -> *World
Start w
# w = cwrite "open" w
# (ok, tty, w) = TTYopen {zero & sleepTime=2, devicePath="COM3"} w
| not ok = TTYerrorclose w
#! (l, tty) = TTYreadline tty
= w
/*
# io = io <<< "close\n"
# (ok, w) = TTYclose tty w
# io = io <<< "ok: " <<< toString ok <<< "\n"
| not ok = TTYerrorclose io w
= snd (fclose io w)
*/
/*
#! tty = TTYwrite "echo123\n" tty
#! (av, e, tty) = TTYavailable tty
# io = io <<< ("Bytes available: " +++ toString av +++ "\n")
#! (l, tty) = TTYreadline tty
# io = io <<< ("Line read: " +++ l)
#! (ok, w) = TTYclose tty w
| not ok = TTYerrorclose io w
= snd (fclose io w)*/
definition module iTasksTTY
from iTasks.Internal.Generic.Visualization import generic gText, :: TextFormat
from iTasks.SDS.Definition import :: SDS, :: Shared, :: RWShared
from iTasks.UI.Editor.Generic import generic gEditor, :: Editor
from iTasks.WF.Definition import :: Task
from iTasks.WF.Definition import class iTask
from Data.GenDefault import generic gDefault
from Data.GenEq import generic gEq
from Data.Maybe import :: Maybe
from Data.Either import :: Either
from Text.GenJSON import generic JSONEncode, generic JSONDecode, :: JSONNode
from System.Time import :: Timespec
from TTY import :: TTYSettings
derive class iTask TTYSettings
:: TTYException = TTYException String
/**
* Synchronizes the channel share
*
* @param Device settings
* @param Encoding function for messages to send
* @param Streaming decoding function to decode received data
* @param Channel SDS, first list are incoming messages, second list outgoing, third boolean is the stop flag
* @result Task that stops when the stop flag is set
* @throws TTYException
*/
syncSerialChannel :: Timespec TTYSettings (b -> String) (String -> (Either String [a], String)) (Shared ([a],[b],Bool)) -> Task () | iTask a & iTask b
implementation module iTasksTTY
import StdEnv
from Data.Map import :: Map, newMap
import Data.Func
import Text
import iTasks
import iTasks.Internal.IWorld
import iTasks.Internal.SDS
import iTasks.Internal.TaskEval
import iTasks.Internal.TaskState
import TTY
:: *Resource | TTYd String *TTY
derive class iTask TTYSettings, Parity, BaudRate, ByteSize
syncSerialChannel :: Timespec TTYSettings (b -> String) (String -> (Either String [a], String)) (Shared ([a],[b],Bool)) -> Task () | iTask a & iTask b
syncSerialChannel poll opts enc dec rw = Task eval
where
eval event evalOpts tree=:(TCInit taskId ts) iworld
# (mtty, iworld=:{world,resources}) = getResource iworld
= case mtty of
[] = case TTYopen opts iworld.world of
(False, _, world)
# (err, world) = TTYerror world
= (exc err, {iworld & world=world})
(True, tty, world)
# (merr, iworld) = readRegister taskId ticker {iworld & world=world, resources=[TTYd opts.devicePath tty:resources]}
| isError merr = (ExceptionResult (fromError merr), iworld)
= (ValueResult
NoValue
{TaskEvalInfo|lastEvent=ts,removedTasks=[],attributes=newMap}
rep
(TCBasic taskId ts (DeferredJSONNode $ JSONString "") False)
, iworld)
_ = (exc "This tty was already open", iworld)
eval _ _ tree=:(TCBasic taskId ts (DeferredJSONNode (JSONString acc)) _) iworld
# (mtty, iworld) = getResource iworld
= case mtty of
[] = (exc"TTY resource lost", iworld)
[_,_:_] = (exc "Multiple matching resources", iworld)
[TTYd dp tty]
# (merr, iworld) = readRegister taskId ticker iworld
| isError merr = (ExceptionResult (fromError merr), iworld)
# (merr, iworld=:{resources}) = read rw iworld
| isError merr = (ExceptionResult (fromError merr), iworld)
= case fromOk merr of
//We need to stop
(_,_,True) =
(ValueResult
(Value () True)
{TaskEvalInfo|lastEvent=ts,removedTasks=[],attributes=newMap}
rep
(TCDestroy tree)
, {iworld & resources=[TTYd dp tty:resources]})
(r,s,ss)
# tty = foldr TTYwrite tty $ reverse $ map enc s
# (merr, tty) = readWhileAvailable tty
| isError merr = (exc (fromError merr), iworld)
# iworld = {iworld & resources=[TTYd dp tty:iworld.resources]}
= case dec (acc +++ toString (fromOk merr)) of
(Left err, newacc) = (exc ("Error while parsing: " +++ join " " [toString (toInt c)\\c<-:acc+toString (fromOk merr)]), iworld)
(Right msgs, newacc)
# (merr, iworld) = if (msgs =: [] && s =: [])
(Ok (), iworld)
(write (r++msgs, [], False) rw iworld)
| isError merr = (ExceptionResult (fromError merr), iworld)
= (ValueResult
NoValue
{TaskEvalInfo|lastEvent=ts,removedTasks=[],attributes=newMap}
rep
(TCBasic taskId ts (DeferredJSONNode $ JSONString newacc) False)
, iworld)
eval event evalOpts tree=:(TCDestroy _) iworld=:{IWorld|resources,world}
# (mtty, iworld) = getResource iworld
= case mtty of
[] = (exc "This tty was already closed", iworld)
[_,_:_] = (exc "Multiple matching resources", iworld)
[TTYd _ tty]
# (ok, world) = TTYclose tty iworld.world
# iworld & world = world
| not ok = (exc "Couldn't close device", iworld)
= (DestroyedResult, iworld)
rep = ReplaceUI $ stringDisplay $ "Serial client " <+++ opts.devicePath
ticker = sdsFocus {start=zero,interval=poll} iworldTimespec
getResource = iworldResource (\t=:(TTYd p _)->(p == opts.devicePath, t))
exc = ExceptionResult o exception
readWhileAvailable :: !*TTY -> (MaybeError String [Char], !*TTY)
readWhileAvailable tty
# (available, error, tty) = TTYavailable tty
| error = (Error "TTY device disconnected", tty)
| not available = (Ok [], tty)
# (c, tty) = TTYread tty
# (merr, tty) = readWhileAvailable tty
| isError merr = (merr, tty)
= (Ok [toChar c:fromOk merr], tty)
definition module System.TTY
from StdClass import class zero
from Data.Error import :: MaybeError
from System.OSError import :: MaybeOSError, :: OSError, :: OSErrorCode, :: OSErrorMessage
/**
* TTY handle
*/
:: *TTY (:== Int)
/**
* Possible byte sizes
*/
:: ByteSize = BytesizeFive | BytesizeSix | BytesizeSeven | BytesizeEight
/**
* Possible parity settings
*/
:: Parity = ParityNone | ParityOdd | ParityEven | ParitySpace | ParityMark
/**
* Possible baudrates
*/
:: BaudRate = B0 | B50 | B75 | B110 | B134 | B150 | B200 | B300 | B600 |
B1200 | B1800 | B2400 | B4800 | B9600 | B19200 | B38400 | B57600 |
B115200 | B230400
/**
* Serial device settings
*/
:: TTYSettings = {
devicePath :: String,
//* Path of the device, e.g. /dev/ttyACM0
baudrate :: BaudRate,
//* Baudrate
bytesize :: ByteSize,
//* Parity
parity :: Parity,
//* stop2bits
stop2bits :: Bool,
//* xonxoff flow control
xonxoff :: Bool,
//* Time in seconds to wait after opening the devices.
//* Set this to 2 if you want to connect to a borked arduino
sleepTime :: Int
}
instance zero TTYSettings
/**
* Returns a list of tty devices. This list is not conclusive but just checks familiar names.
*
* @param world
* @result list of detected devices
* @result new world
*/
getTTYDevices :: !*World -> *(MaybeOSError [String], !*World)
/**
* Smart constructor for {{`TTYSettings`}}
*
* @param devicePath
* @param baudrate
* @param parity
* @param stop2bits
* @param xonxoff
* @param sleepTime
*/
makeTTYSettings :: String BaudRate ByteSize Parity Bool Bool Int -> TTYSettings
/**
* Closes a TTY
*
* @param tty handle
* @param world
* @result Ok flag
* @result new world
*/
TTYclose :: !*TTY !*env -> (!Bool, !*env)
/**
* Reads the error from the tty library
*
* @param world
* @result Error
* @result new world
*/
TTYerror :: !*env -> (!String, !*env)
/**
* Open a tty
*
* @param tty settings
* @param world
* @result Ok flag
* @result TTY handle
* @result new world
*/
TTYopen :: !TTYSettings !*env -> (!Bool,!*TTY,!*env)
/**
* Read a byte from a tty
*
* @param tty handle
* @param world
* @result byte
* @result new tty handle
*/
TTYread :: !*TTY -> (!Int, !*TTY)
/**
* Read a line from the tty (up until '\n' or EOF)
*
* @param tty handle
* @param world
* @result line
* @result new tty handle
*/
TTYreadline :: !*TTY -> (!String, !*TTY)
/**
* Checks if the TTY device is available for reading
*
* @param tty handle
* @result Data available
* @result Ok flag
* @result new tty handle
*/
TTYavailable :: !*TTY -> (!Bool, !Bool, !*TTY)
/**
* Write bytes to a TTY
*
* @param The bytes to write
* @param The tty handle
* @result new tty handle
*/
TTYwrite :: !String !*TTY -> *TTY
implementation module System.TTY
import StdEnv
import Data.Error
import System.OSError
import System.OS
import Text
import System._Devices
import code from "tty.o"
:: *TTY :== Int
instance zero TTYSettings where
zero = {TTYSettings |
devicePath = "/dev/ttyACM0",
baudrate = B9600,
bytesize = BytesizeEight,
parity = ParityNone,
stop2bits = False,
xonxoff = False,
sleepTime = 2}
instance toInt BaudRate where
toInt b = case b of
B0 = 0; B50 = 1; B75 = 2; B110 = 3; B134 = 4; B150 = 5; B200 = 6
B300 = 7; B600 = 8; B1200 = 9; B1800 = 10; B2400 = 11; B4800 = 12
B9600 = 13; B19200 = 14; B38400 = 15; B57600 = 16; B115200 = 17
B230400 = 18
instance toInt ByteSize where
toInt b = case b of
BytesizeFive = 0; BytesizeSix = 1; BytesizeSeven = 2; BytesizeEight = 3
instance toInt Parity where
toInt p = case p of
ParityNone = 0; ParityOdd = 1; ParityEven = 2; ParitySpace = 3;
ParityMark = 4
getTTYDevices :: !*World -> *(MaybeOSError [String], !*World)
getTTYDevices w
# (ds, w) = getDevices w
= case ds of
(Error e) = (Error e, w)
(Ok ds) = (Ok (
IF_WINDOWS
(filter isTTYWindows ds)
(map ((+++) "/dev/") (filter isTTYPosix ds)))
, w)
where
isTTYPosix s = not (isEmpty (filter (flip startsWith s) ["tty", "rfcomm", "cu"]))
isTTYWindows s = startsWith "COM" s && size s > 3 && isDigit s.[3]
makeTTYSettings :: String BaudRate ByteSize Parity Bool Bool Int -> TTYSettings
makeTTYSettings dp br bs pr sb xx st = {TTYSettings | devicePath=dp, baudrate=br,
bytesize=bs, parity=pr, stop2bits=sb, xonxoff=xx, sleepTime=st}
TTYopen :: !TTYSettings !*env -> (!Bool, !*TTY, !*env)
TTYopen ts w = TTYopen2
ts.devicePath
(toInt ts.baudrate)
(toInt ts.bytesize)
(toInt ts.parity)
ts.stop2bits
ts.xonxoff
ts.sleepTime
w
where
TTYopen2 :: !String !Int !Int !Int !Bool !Bool !Int !*env -> (!Bool, !*TTY, !*env)
TTYopen2 _ _ _ _ _ _ _ _ = code {
ccall ttyopen "SIIIIII:VII:A"
}
TTYclose :: !*TTY !*env -> (!Bool, !*env)
TTYclose _ _ = code {
ccall ttyclose "I:I:A"
}
TTYread :: !*TTY -> (!Int, !*TTY)
TTYread _ = code {
ccall ttyread "I:VII"
}
TTYreadline :: !*TTY -> (!String, !*TTY)
TTYreadline tty = case TTYread tty of
(10, tty) = ("", tty)
(c, tty)
# (rest, tty) = TTYreadline tty
= ({#toChar c} +++ rest, tty)
TTYwrite :: !String !*TTY -> *TTY
TTYwrite _ _ = code {
ccall ttywrite "SI:I"
}
TTYavailable :: !*TTY -> (!Bool, !Bool, !*TTY)
TTYavailable _ = code {
ccall ttyavailable "I:VIII"
}
TTYerror :: !*env -> (!String, !*env)
TTYerror _ = code {
ccall ttyerror ":VS:A"
}
definition module System._Devices
from Data.Error import :: MaybeError
from System.OSError import :: MaybeOSError, :: OSError, :: OSErrorCode, :: OSErrorMessage
getDevices :: !*World -> *(MaybeOSError [String], !*World)
implementation module System._Devices
import Data.Error
import System.OSError
import System.Directory
getDevices :: !*World -> *(MaybeOSError [String], !*World)
getDevices w = readDirectory "/dev" w
kernel32.dll
ClearCommError@12
CreateMutexA@12
ReleaseMutex@4
ResumeThread@4
OpenThread@12
SetEndOfFile@4
LockFileEx@24
UnlockFile@20
CreatePipe@16
GetCommState@8
GetFullPathNameA@16
GetProcessHeap@0
GetSystemTimeAsFileTime@4
HeapAlloc@12
HeapFree@12
CreatePipe@16
LockFileEx@24
OpenThread@12
PeekNamedPipe@24
QueryDosDeviceA@12
ReleaseMutex@4
ResumeThread@4
SetCommState@8
SetEndOfFile@4
SetHandleInformation@12
TerminateProcess@8
GetFullPathNameA@16
GetSystemTimeAsFileTime@4
UnlockFile@20
msvcrt.dll
_errno
_mkgmtime
_strdup
asctime
ctime
clock
time
ctime
exit
free
gmtime
localtime
malloc
memcpy
memset
mktime
strftime
_mkgmtime
perror
printf
puts
signal
strerror
strftime
strlen
time
definition module System._Devices
from Data.Error import :: MaybeError
from System.OSError import :: MaybeOSError, :: OSError, :: OSErrorCode, :: OSErrorMessage
getDevices :: !*World -> *(MaybeOSError [String], !*World)
implementation module System._Devices
import code from library "msvcrt.txt"
import System._Pointer
import System._WinBase
import Data.Error
import System.OSError
import StdMisc, StdDebug, StdBool, StdString
import Text
getDevices :: !*World -> *(MaybeOSError [String], !*World)
getDevices w
# (ph, w) = getProcessHeap w
# (ptr, w) = heapAlloc ph 0 40960 w
| ptr == 0 = getLastOSError w
# (ret, w) = realQDD 0 ptr 40960 w
| ret == 0
= getLastOSError w
#! res = derefCharArray ptr ret
# (ok, w) = heapFree ph 0 ptr w
| not ok = getLastOSError w
= (Ok (split "\0" res), w)
realQDD :: !Pointer !Pointer !Int !*env -> *(!Int, !*env)
realQDD _ _ _ _ = code {
ccall QueryDosDeviceA@12 "PppI:I:A"
}
ifeq ($(OS), Windows_NT)
DETECTED_OS=Windows
else
DETECTED_OS=POSIX
endif
all: listDevices
.SECONDARY: listDevices.prj
%: %.prj %.icl
cpm $<
%.prj:
cpm project $(basename $@) create
cpm project $@ target iTasks
cpm project $@ set -h 2000m -s 20m -dynamics
cpm project $@ root ..
cpm project $@ path add "$$PWD/../$(DETECTED_OS)"
cpm project $@ path add "$$PWD/.."
......@@ -172,22 +172,24 @@ import qualified System.OS
import qualified System.OSError
import qualified System.Platform
import qualified System.Process
import qualified System.TTS
import qualified System.Time
import qualified System.Time.GenJSON
import qualified System.Signal
import qualified System.Socket
import qualified System.Socket.Ipv4
import qualified System.Socket.Ipv6
import qualified System.Socket.Unix
import qualified System._Signal
import qualified System._Socket
import qualified System.TTS
import qualified System.TTY
import qualified System.Time
import qualified System.Time.GenJSON
import qualified System._Devices
import qualified System._Directory
import qualified System._FilePath
import qualified System._Finalized
import qualified System._Platform
import qualified System._Pointer
import qualified System._Posix
import qualified System._Signal
import qualified System._Socket
import qualified System._Unsafe
import qualified Testing.Options
import qualified Testing.TestEvents
......