_Posix.icl 5.21 KB
Newer Older
1
implementation module System._Posix
Bas Lijnse's avatar
Bas Lijnse committed
2

3
import System._Pointer, System.Time
Bas Lijnse's avatar
Bas Lijnse committed
4 5
import StdInt

6
errno :: !*w -> (!Int,!*w)
Bas Lijnse's avatar
Bas Lijnse committed
7 8 9 10 11 12 13 14 15 16 17 18 19 20 21
errno world = (getErrno,world)
where
	getErrno :: Int
	getErrno = readInt4S errnoAddr 0
	
	errnoAddr :: Pointer
	errnoAddr = code {
		ccall __errno_location ":p"
	}

strerr :: !Int -> Pointer
strerr world = code {
	ccall strerror "I:p"
}

22
stat :: !{#Char} !{#Char} !*w -> (!Int,!*w)
Bas Lijnse's avatar
Bas Lijnse committed
23 24 25 26
stat path buf world = code {
	ccall stat "ss:I:A"
}

27
unlink :: !{#Char} !*w -> (!Int,!*w)
Bas Lijnse's avatar
Bas Lijnse committed
28 29 30
unlink path world = code {
	ccall unlink "s:I:A"
}
31
fork :: !*w -> (!Int,!*w)
Bas Lijnse's avatar
Bas Lijnse committed
32 33 34
fork world = code {
	ccall fork ":I:A"
}
35
execvp :: !{#Char} !{#Pointer} !*w -> (!Int,!*w)
Bas Lijnse's avatar
Bas Lijnse committed
36 37 38
execvp name argv world = code {
	ccall execvp "sA:I:A"
}
39
waitpid :: !Int !{#Int} !Int !*w -> (!Int,!*w)
Bas Lijnse's avatar
Bas Lijnse committed
40 41 42
waitpid pid status_p options world = code {
    ccall waitpid "IAI:I:A"
}
43
exit :: !Int !*w -> (!.a,!*w)
Bas Lijnse's avatar
Bas Lijnse committed
44 45 46
exit num world = code {
	ccall exit "I:p:A"
}
47
getcwd :: !{#Char} !Int !*w -> (!Pointer,!*w)
Bas Lijnse's avatar
Bas Lijnse committed
48 49 50
getcwd buf size_t world = code {
	ccall getcwd "sI:p:A"
}
51
chdir :: !{#Char} !*w -> (!Int,!*w)
Bas Lijnse's avatar
Bas Lijnse committed
52 53 54
chdir name world = code {
	ccall chdir "s:I:A"
}
55
mkdir :: !{#Char} !Int !*w -> (!Int,!*w)
Bas Lijnse's avatar
Bas Lijnse committed
56 57 58
mkdir name mode world = code {
	ccall mkdir "sI:I:A"
}
59
rmdir :: !{#Char} !*w -> (!Int,!*w)
Bas Lijnse's avatar
Bas Lijnse committed
60 61 62
rmdir name world = code {
	ccall rmdir "s:I:A"
}
63
rename :: !{#Char} !{#Char} !*w -> (!Int,!*w)
Bas Lijnse's avatar
Bas Lijnse committed
64 65 66
rename old new world = code {
	ccall rename "ss:I:A"
}
67
opendir	:: !{#Char} !*w -> (!Pointer,!*w)
Bas Lijnse's avatar
Bas Lijnse committed
68 69 70
opendir path world = code {
	ccall opendir "s:p:A"
}
71
closedir :: !Pointer !*w -> (!Int,!*w)
Bas Lijnse's avatar
Bas Lijnse committed
72 73 74
closedir dir world = code {
	ccall closedir "p:I:A"
}
75
readdir	:: !Pointer !*w -> (!Pointer,!*w)
Bas Lijnse's avatar
Bas Lijnse committed
76 77 78
readdir dir world = code {
	ccall readdir "p:p:A"
}
79 80 81 82
pipe :: !Pointer !*w -> (!Int, !*w)
pipe arr world = code {
    ccall pipe "p:I:A"
}
83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102
posix_openpt :: !Int !*w -> (!Int, !*w)
posix_openpt flags w = code {
	ccall posix_openpt "I:I:A"
}
grantpt     :: !Int !*w -> (!Int, !*w)
grantpt fp w = code {
	ccall grantpt "I:I:A"
}
unlockpt    :: !Int !*w -> (!Int, !*w)
unlockpt fp w = code {
	ccall unlockpt "I:I:A"
}
ptsname     :: !Int !*w -> (!Pointer, !*w)
ptsname fp w = code {
	ccall ptsname "I:p:A"
}
open        :: !Pointer !Int !*w -> (!Int, !*w)
open p flags w = code {
	ccall open "pI:I:A"
}
Mart Lubbers's avatar
Mart Lubbers committed
103 104 105 106
tcgetattr   :: !Int !Pointer !*w -> (!Int, !*w)
tcgetattr fp f w = code {
	ccall tcgetattr "Ip:I:A"
}
107
cfmakeraw   :: !Pointer !*w -> *w
Mart Lubbers's avatar
Mart Lubbers committed
108 109 110 111 112 113 114
cfmakeraw p w = code {
	ccall cfmakeraw "p:V:A"
}
tcsetattr   :: !Int !Int !Pointer !*w -> (!Int, !*w)
tcsetattr fp strategy p w = code {
	ccall tcsetattr "IIp:I:A"
}
115 116 117 118
setsid :: !*w -> *w
setsid w = code {
	ccall setsid ":V:A"
}
119 120 121 122 123 124 125 126 127
dup2 :: !Int !Int !*w -> (!Int, !*w)
dup2 old new world = code {
    ccall dup2 "II:I:A"
}
close :: !Int !*w -> (!Int, !*w)
close fd world = code {
    ccall close "I:I:A"
}

128 129 130 131 132
ioctl :: !Int !Int !Pointer !*w -> (!Int, !*w)
ioctl fd op ptr world = code {
    ccall ioctl "IIp:I:A"
}

133 134 135 136 137
fcntlArg :: !Int !Int !Int !*w -> (!Int, !*w)
fcntlArg fd op arg world = code {
    ccall fcntl "III:I:A"
}

138 139 140 141 142 143 144 145 146 147 148 149 150 151 152
read :: !Int !Pointer !Int !*w -> (!Int, !*w)
read fd buffer nBuffer world = code {
    ccall read "IpI:I:A"
}

write :: !Int !{#Char} !Int !*w -> (!Int, !*w)
write fd buffer nBuffer world = code {
    ccall write "IsI:I:A"
}

select_ :: !Int !Pointer !Pointer !Pointer !Pointer !*w -> (!Int, !*w)
select_ nfds readfds writefds exceptfds timeout world = code {
    ccall select "Ipppp:I:A"
}

153 154 155 156 157
kill :: !Int !Int !*w -> (!Int, !*w)
kill pid sig world = code {
    ccall kill "II:I:A"
}

158 159 160 161 162
timegm :: !{#Int} -> Int
timegm tm = code {
	ccall timegm "A:I"
}

Bas Lijnse's avatar
Bas Lijnse committed
163 164
malloc :: !Int -> Pointer
malloc num = code {
Mart Lubbers's avatar
Mart Lubbers committed
165
	ccall malloc "I:p"
Bas Lijnse's avatar
Bas Lijnse committed
166
}
167 168 169 170
mallocSt	:: !Int !*w -> (!Pointer, !*w)
mallocSt num w = code {
	ccall malloc "I:p:A"
}
171
free :: !Pointer -> Int
Bas Lijnse's avatar
Bas Lijnse committed
172 173 174
free ptr = code {
	ccall free "p:I"
}
175 176 177 178
freeSt :: !Pointer !*w -> *w
freeSt ptr world = code {
   ccall free "p:V:A"
}
Bas Lijnse's avatar
Bas Lijnse committed
179 180 181 182
memcpy_string_to_pointer :: !Pointer !{#Char} !Int -> Pointer
memcpy_string_to_pointer p s n = code {
    ccall memcpy "psp:p"
}
183 184 185 186
clock_gettime :: !Int !Pointer !*w -> (!Int, !*w)
clock_gettime _ _ _ = code {
	ccall clock_gettime "Ip:I:A"
}
187 188 189 190
nanosleep :: !Pointer !Pointer !*w -> (!Int, !*w)
nanosleep _ _ _ = code {
	ccall nanosleep "pp:I:A"
}
Bas Lijnse's avatar
Bas Lijnse committed
191 192 193 194 195 196 197 198 199 200 201 202 203 204

//Mapping to/from byte arrays
unpackStat :: !{#Char} -> Stat
unpackStat s =
    { st_dev			= IF_INT_64_OR_32 (unpackInt8  s 0)  (unpackInt4S s 0 /*8 bytes*/)
    , st_ino			= IF_INT_64_OR_32 (unpackInt8  s 8)  (unpackInt4S s 12)
    , st_mode			= IF_INT_64_OR_32 (unpackInt4S s 24) (unpackInt4S s 16)
    , st_nlink			= IF_INT_64_OR_32 (unpackInt8  s 16) (unpackInt4S s 20)
    , st_uid			= IF_INT_64_OR_32 (unpackInt4S s 28) (unpackInt4S s 24)
    , st_gid			= IF_INT_64_OR_32 (unpackInt4S s 32) (unpackInt4S s 28)
	, st_rdev			= IF_INT_64_OR_32 (unpackInt8  s 40) (unpackInt4S s 32 /*8 bytes*/)
    , st_size       	= IF_INT_64_OR_32 (unpackInt8  s 48) (unpackInt4S s 44)
    , st_blocks    		= IF_INT_64_OR_32 (unpackInt8  s 64) (unpackInt4S s 52)
    , st_blksize    	= IF_INT_64_OR_32 (unpackInt8  s 56) (unpackInt4S s 48)
Bas Lijnse's avatar
Bas Lijnse committed
205 206 207
	, st_atimespec		= IF_INT_64_OR_32 (unpackInt8  s 72  /*16 bytes*/) (unpackInt4S s 56 /*8 bytes*/)
	, st_mtimespec		= IF_INT_64_OR_32 (unpackInt8  s 88  /*16 bytes*/) (unpackInt4S s 64 /*8 bytes*/)
	, st_ctimespec		= IF_INT_64_OR_32 (unpackInt8  s 104 /*16 bytes*/) (unpackInt4S s 72 /*8 bytes*/)
Bas Lijnse's avatar
Bas Lijnse committed
208 209 210 211
    }

sizeOfStat :: Int
sizeOfStat = IF_INT_64_OR_32 144 88