Verified Commit 5d66275f authored by Camil Staps's avatar Camil Staps 🚀

Initial commit

parents
# Executables
*.exe
*.out
test
# Directory used to store object files, abc files and assembly files
Clean System Files/
# iTasks environment extra data
*-data/
sapl/
#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;
definition module Inotify
from Data.Either import ::Either
from Data.Maybe import ::Maybe
:: *Inotify st
:: INWatch
:: INMask :== Int
:: INEvent :== Int
:: INCallback st :== INEvent st *World -> *(st, *World)
(|-) infixl 6 :: (INMask INMask -> INMask)
inotify_init :: st -> Maybe *(Inotify st)
inotify_close :: *(Inotify st) -> st
inotify_add_watch :: (INCallback st) !Int !String !*(Inotify st) -> *(Either Int INWatch, *Inotify st)
inotify_rm_watch :: !INWatch !*(Inotify st) -> *(Bool, *Inotify st)
inotify_poll :: *(Inotify st) -> *Inotify st
inotify_check :: *(Inotify st) *World -> *(*Inotify st, *World)
IN_ACCESS :== 0x00000001 // File was accessed
IN_MODIFY :== 0x00000002 // File was modified
IN_ATTRIB :== 0x00000004 // Metadata changed
IN_CLOSE_WRITE :== 0x00000008 // Writtable file was closed
IN_CLOSE_NOWRITE :== 0x00000010 // Unwrittable file closed
IN_OPEN :== 0x00000020 // File was opened
IN_MOVED_FROM :== 0x00000040 // File was moved from X
IN_MOVED_TO :== 0x00000080 // File was moved to Y
IN_CREATE :== 0x00000100 // Subfile was created
IN_DELETE :== 0x00000200 // Subfile was deleted
IN_DELETE_SELF :== 0x00000400 // Self was deleted
IN_MOVE_SELF :== 0x00000800 // Self was moved
IN_UNMOUNT :== 0x00002000 // Backing fs was unmounted
IN_Q_OVERFLOW :== 0x00004000 // Event queued overflowed
IN_IGNORED :== 0x00008000 // File was ignored
IN_CLOSE :== (IN_CLOSE_WRITE |- IN_CLOSE_NOWRITE) // close
IN_MOVE :== (IN_MOVED_FROM |- IN_MOVED_TO) // moves
IN_ONLYDIR :== 0x01000000 // only watch the path if it is a directory
IN_DONT_FOLLOW :== 0x02000000 // don't follow a sym link
IN_EXCL_UNLINK :== 0x04000000 // exclude events on unlinked objects
IN_MASK_ADD :== 0x20000000 // add to the mask of an already existing watch
IN_ISDIR :== 0x40000000 // event occurred against dir
IN_ONESHOT :== 0x80000000 // only send event once
IN_ALL_EVENTS :==
(IN_ACCESS |- IN_MODIFY |- IN_ATTRIB |- IN_CLOSE_WRITE |- IN_CLOSE_NOWRITE
|- IN_OPEN |- IN_MOVED_FROM |- IN_MOVED_TO |- IN_DELETE |- IN_CREATE |-
IN_DELETE_SELF |- IN_MOVE_SELF)
implementation module Inotify
import Data.Either
import Data.Maybe
import StdArray
import StdBool
import StdFunc
import StdInt
import StdList
import StdString
from StdOverloaded import class zero(zero)
import code from "inotify_c.o"
:: *Inotify st = { fd :: *Int
, watches :: [(INWatch, INCallback st)]
, state :: st
}
:: INWatch :== Int
(|-) infixl 6 :: (INMask INMask -> INMask)
(|-) = bitor
inotify_init :: st -> Maybe *(Inotify st)
inotify_init st
= let fd = c_init 0 in if (fd < 0) Nothing (Just {fd=fd, watches=[], state=st})
where
c_init :: !Int -> *Int
c_init i = code {
ccall clean_inotify_init "I:I"
}
inotify_close :: *(Inotify st) -> st
inotify_close {fd,state} = c_close fd state
where
c_close :: !*Int !st -> st
c_close fd st = code {
ccall close "I:V:A"
}
inotify_add_watch :: (INCallback st) !Int !String !*(Inotify st) -> *(Either Int INWatch, *Inotify st)
inotify_add_watch f mask fname inot=:{fd,watches}
= let (w, fd`) = c_add_watch fd fname mask in
( if (w == -1) (Left errno) (Right w)
, {inot & fd=fd`, watches=[(w,f):watches]}
)
where
c_add_watch :: !*Int !String !Int -> *(!Int, !*Int)
c_add_watch inot fname mask = code {
ccall clean_inotify_add_watch "ISI:VII"
}
inotify_rm_watch :: !INWatch !*(Inotify st) -> *(Bool, *Inotify st)
inotify_rm_watch w inot=:{fd}
= case c_inotify_rm_watch fd w of (0, fd`) = (True, {inot & fd=fd`})
(_, fd`) = (False, {inot & fd=fd`})
where
c_inotify_rm_watch :: !*Int !Int -> *(!Int, !*Int)
c_inotify_rm_watch w i = code {
ccall clean_inotify_rm_watch "II:VII"
}
inotify_poll :: *(Inotify st) -> *Inotify st
inotify_poll inot=:{fd} = let (_,fd`) = c_poll fd in { inot & fd=fd` }
where
c_poll :: !*Int -> *(!Int, !*Int)
c_poll fd = code {
ccall clean_poll "I:VII"
}
inotify_check :: *(Inotify st) *World -> *(*Inotify st, *World)
inotify_check inot=:{fd,watches,state} w
# (ok, wds, masks, fd) = c_check fd
inot = { inot & fd=fd }
| not ok = (inot, w)
| (size wds) rem 4 <> 0 || (size masks) rem 4 <> 0 = (inot,w)
# (wds,masks) = (split 4 wds, split 4 masks)
| length wds <> length masks = (inot, w)
# wdsmasks = zip2 (map bytesToInt wds) (map bytesToInt masks)
# (fd,st,w`) = seq (map (check wdsmasks) watches) (inot.fd, state, w)
= ({ inot & fd=fd, state=st }, w`)
where
check :: [(Int,Int)] (INWatch, INCallback st) *(*Int, st, *World) -> *(*Int, st, *World)
check wdsmasks (watch,f) (fd,st,w)
# (st,w) = seq [\(st,w) -> f mask st w \\ (wd,mask) <- wdsmasks | wd == watch] (st,w)
//# (st,w) = f (length wds) st w
= (fd,st,w)
bytesToInt :: {#Char} -> Int
bytesToInt cs = sum [toInt c * (8 ^ p) \\ c <-: cs & p <- [0..]]
split :: Int String -> [String]
split n s
| size s > n = [s % (0,n-1) : split n (s % (n, size s - 1))]
| size s == n = [s]
| s == "" = []
c_check :: !*Int -> *(!Bool, !String, !String, !*Int)
c_check fd = code {
ccall clean_inotify_check "I:VISSI"
}
errno :: Int
errno = err 0
where
err :: !Int -> Int
err i = code {
ccall clean_errno "I:I"
}
CPM=cpm
CCFLAGS=-Wall -l -linotify
INO_OBJ=Clean\ System\ Files/inotify_c.o
all: test
$(INO_OBJ): inotify_c.c
mkdir -p Clean\ System\ Files
$(CC) $(CCFLAGS) -c $< -o Clean\ System\ Files/inotify_c.o
test: test.icl $(wildcard *.*cl) $(INO_OBJ)
$(CPM) project $@.prj build
run_test: test
./test
clean:
rm -rfv Clean\ System\ Files
.PHONY: all run_test clean
#include <errno.h>
#include <fcntl.h>
#include <poll.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <sys/inotify.h>
#include <unistd.h>
#include "Clean.h"
char* clstocs(CleanString* cs) {
char* s = calloc(CleanStringLength(cs) + 1, 1);
uint8_t i;
for (i = 0; i < CleanStringLength(cs); i++)
s[i] = CleanStringCharacters(cs)[i];
s[i] = 0;
return s;
}
static struct {int length; char chars[1]; } empty_string = {0,""};
int clean_errno(int ignored) {
return errno;
}
int clean_inotify_init(int ignored) {
int fd;
fd = inotify_init();
if (fd < 0)
return 0;
fcntl(fd, IN_NONBLOCK);
return fd;
}
void clean_inotify_add_watch(int fd, CleanString* fname_, int mask, int *re_watch, int *re_fd) {
char* fname = clstocs(fname_);
*re_watch = inotify_add_watch(fd, fname, mask);
free(fname);
*re_fd = fd;
}
void clean_inotify_rm_watch(int fd, int watch, int *re_code, int *re_fd) {
*re_fd = fd;
*re_code = inotify_rm_watch(fd, watch);
}
void clean_poll(int fd, int *re_nrevents, int *re_fd) {
struct pollfd pfd = {fd, POLLIN, 0};
*re_nrevents = poll(&pfd, 1, -1);
*re_fd = fd;
}
static CleanStringVariable(wds_string, 1024);
static CleanStringVariable(masks_string, 1024);
void clean_inotify_check(int fd,
int *re_ok, CleanString* re_wds, CleanString* re_masks, int *re_fd) {
char buf[4096] __attribute__((aligned(__alignof__(struct inotify_event))));
const struct inotify_event *ev;
ssize_t len;
char *ptr;
struct pollfd pfd = {fd, POLLIN, 0};
int poll_n;
char *wds_ptr = CleanStringCharacters(wds_string);
char *masks_ptr = CleanStringCharacters(masks_string);
CleanStringLength(wds_string) = 0;
CleanStringLength(masks_string) = 0;
*re_ok = 0;
*re_fd = fd;
*re_wds = (CleanString) &empty_string;
*re_masks = (CleanString) &empty_string;
for (;;) {
poll_n = poll(&pfd, 1, 50);
if (poll_n < 0) {
return;
} else if (poll_n == 0) {
break;
}
len = read(fd, buf, sizeof buf);
if (len == -1 && errno != EAGAIN) {
return;
}
if (len <= 0) {
break;
}
for (ptr = buf; ptr < buf + len;
ptr += sizeof(struct inotify_event) + ev->len) {
ev = (const struct inotify_event*) ptr;
memcpy(masks_ptr, &ev->mask, 4);
masks_ptr += 4;
CleanStringLength(masks_string) += 4;
memcpy(wds_ptr, &ev->wd, sizeof(int));
wds_ptr += sizeof(int);
CleanStringLength(wds_string) += sizeof(int);
}
}
*re_wds = (CleanString) wds_string;
*re_masks = (CleanString) masks_string;
*re_ok = 1;
}
module test
import StdFile
import Data.Either
import Data.Maybe
import Inotify
Start w
# (Just inot) = inotify_init 0
# (Right watch, inot)
= inotify_add_watch (echo "file1") IN_ALL_EVENTS "file1" inot
# (Right watch, inot)
= inotify_add_watch (echo "file2") IN_ALL_EVENTS "file2" inot
# (io,w) = stdio w
# io = io <<< "Do something with file1 or file2\n"
# (ok,w) = fclose io w
# (inot, w) = loop inot w
= inotify_close inot
where
loop :: !*(Inotify st) !*World -> *(*Inotify st, *World)
loop inot w
# inot = inotify_poll inot
# (inot, w) = inotify_check inot w
= loop inot w
echo :: String INEvent Int *World -> *(Int, *World)
echo fname ev i w
# (io,w) = stdio w
# io = io <<< "EVENT: [" <<< fname <<< "; " <<< ev <<< "]\n"
# (ok,w) = fclose io w
= (i, w)
Version: 1.4
Global
ProjectRoot: .
Target: StdEnv
Exec: {Project}/test
CodeGen
CheckStacks: False
CheckIndexes: True
Application
HeapSize: 2097152
StackSize: 512000
ExtraMemory: 8192
IntialHeapSize: 204800
HeapSizeMultiplier: 4096
ShowExecutionTime: False
ShowGC: False
ShowStackSize: False
MarkingCollector: False
DisableRTSFlags: False
StandardRuntimeEnv: True
Profile
Memory: False
MemoryMinimumHeapSize: 0
Time: False
Stack: False
Output
Output: ShowConstructors
Font: Monaco
FontSize: 9
WriteStdErr: False
Link
LinkMethod: Static
GenerateRelocations: False
GenerateSymbolTable: False
GenerateLinkMap: False
LinkResources: False
ResourceSource:
GenerateDLL: False
ExportedNames:
Paths
Path: {Project}
Path: {Application}/lib/clean-platform/OS-Independent
Path: {Application}/lib/Generics
Precompile:
Postlink:
MainModule
Name: test
Dir: {Project}
Compiler
NeverMemoryProfile: False
NeverTimeProfile: False
StrictnessAnalysis: True
ListTypes: StrictExportTypes
ListAttributes: True
Warnings: True
Verbose: True
ReadableABC: False
ReuseUniqueNodes: True
Fusion: False
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment