/[meta-cvs]/meta-cvs/F-258A1D35AE34AADD34D34F5A328405CC.lisp
ViewVC logotype

Contents of /meta-cvs/F-258A1D35AE34AADD34D34F5A328405CC.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.4 - (show annotations)
Sat Aug 31 20:53:13 2002 UTC (11 years, 7 months ago) by kaz
Branch: MAIN
CVS Tags: mcvs-0-22, mcvs-0-23
Changes since 1.3: +8 -3 lines
Merging symlink-branch to main trunk.
1 ;;; This source file is part of the Meta-CVS program,
2 ;;; which is distributed under the GNU license.
3 ;;; Copyright 2002 Kaz Kylheku
4
5 (defpackage :unix-funcs
6 (:use :ffi :lisp)
7 (:shadow :open :close)
8 (:export :null-pointer-p :errno :strerror :eperm :enoent :esrch :eintr :eio
9 :enxio :e2big :enoexec :ebadf :echild :eagain :enomem :eacces
10 :efault :enotblk :ebusy :eexist :exdev :enodev :enotdir :eisdir
11 :einval :enfile :emfile :enotty :etxtbsy :efbig :enospc :espipe
12 :erofs :emlink :epipe :edom :erange :edeadlk :enametoolong :enolck
13 :enosys :enotempty :eloop :ewouldblock :dirent :opendir :closedir
14 :readdir :ino :name :open :close :chdir :fchdir :link :symlink
15 :readlink :unlink :rmdir :stat :stat :lstat :fstat :mode :nlink :uid
16 :gid :rdev :blksize :blocks :atime :mtime :ctime :s-ifmt :s-ifdir
17 :s-ifchr :s-ifblk :s-ifreg :s-ififo :s-iflnk :s-ifsock :s-isdir
18 :s-ischr :s-isblk :s-isreg :s-isfifo :s-islnk :s-issock :s-isuid
19 :s-isgid :s-isvtx :s-iread :s-iwrite :s-iexec :s-irusr :s-iwusr
20 :s-ixusr :s-irwxu :s-irgrp :s-iwgrp :s-ixgrp :s-irwxg :s-iroth
21 :s-iwoth :s-ixoth :s-irwxo :accessperms :deffilemode :o-accmode
22 :o-rdonly :o-wronly :o-rdwr :o-creat :o-excl :o-noctty :o-trunc
23 :o-append :o-nonblock :o-sync :o-async :o-ndelay :o-fsync :getcwd))
24
25 (in-package :unix-funcs)
26
27 (push :clisp-unix-funcs *features*)
28
29 ;;;
30 ;;; Null pointer test, needed in CLISP 2.27 and older.
31 ;;;
32
33 (def-c-call-out null-pointer-p
34 (:name "impl_null_pointer_p")
35 (:arguments (pointer c-pointer))
36 (:return-type boolean))
37
38 ;;;
39 ;;; <errno.h>
40 ;;;
41
42 (def-c-call-out get-errno
43 (:name "impl_get_errno")
44 (:arguments)
45 (:return-type int))
46
47 (def-c-call-out set-errno
48 (:name "impl_set_errno")
49 (:arguments (value int))
50 (:return-type int))
51
52 (defsetf get-errno set-errno)
53 (define-symbol-macro errno (get-errno))
54
55 (def-c-call-out strerror
56 (:arguments (errnum int))
57 (:return-type c-string :none))
58
59 (defconstant eperm 1)
60 (defconstant enoent 2)
61 (defconstant esrch 3)
62 (defconstant eintr 4)
63 (defconstant eio 5)
64 (defconstant enxio 6)
65 (defconstant e2big 7)
66 (defconstant enoexec 8)
67 (defconstant ebadf 9)
68 (defconstant echild 10)
69 (defconstant eagain 11)
70 (defconstant enomem 12)
71 (defconstant eacces 13)
72 (defconstant efault 14)
73 (defconstant enotblk 15)
74 (defconstant ebusy 16)
75 (defconstant eexist 17)
76 (defconstant exdev 18)
77 (defconstant enodev 19)
78 (defconstant enotdir 20)
79 (defconstant eisdir 21)
80 (defconstant einval 22)
81 (defconstant enfile 23)
82 (defconstant emfile 24)
83 (defconstant enotty 25)
84 (defconstant etxtbsy 26)
85 (defconstant efbig 27)
86 (defconstant enospc 28)
87 (defconstant espipe 29)
88 (defconstant erofs 30)
89 (defconstant emlink 31)
90 (defconstant epipe 32)
91 (defconstant edom 33)
92 (defconstant erange 34)
93 (defconstant edeadlk 35)
94 (defconstant enametoolong 36)
95 (defconstant enolck 37)
96 (defconstant enosys 38)
97 (defconstant enotempty 39)
98 (defconstant eloop 40)
99 (defconstant ewouldblock eagain)
100
101 ;;;
102 ;;; <dirent.h>
103 ;;;
104
105 (def-c-struct dirent
106 (ino ulong)
107 (name (c-array-max character 1024)))
108
109 (def-c-call-out opendir
110 (:arguments (name c-string))
111 (:return-type c-pointer))
112
113 (def-c-call-out closedir
114 (:arguments (dirp c-pointer))
115 (:return-type int))
116
117 (def-c-call-out readdir
118 (:name "impl_readdir")
119 (:arguments (dirp c-pointer))
120 (:return-type (c-ptr dirent)))
121
122 ;;;
123 ;;; <unistd.h> -- open, close
124 ;;;
125
126 (def-c-call-out open
127 (:arguments (name c-string)
128 (flags int)
129 (mode uint))
130 (:return-type int))
131
132 (def-c-call-out close
133 (:arguments (fd int))
134 (:return-type int))
135
136 ;;;
137 ;;; <unistd.h> -- chdir, fchdir
138 ;;;
139
140 (def-c-call-out chdir
141 (:arguments (path c-string))
142 (:return-type int))
143
144 (def-c-call-out fchdir
145 (:arguments (fd int))
146 (:return-type int))
147
148 ;;;
149 ;;; <unistd.h> -- link, symlink, readlink, unlink, rmdir
150
151
152 (def-c-call-out link
153 (:arguments (from c-string)
154 (to c-string))
155 (:return-type int))
156
157 (def-c-call-out symlink
158 (:arguments (from c-string)
159 (to c-string))
160 (:return-type int))
161
162 (def-c-call-out readlink
163 (:name "impl_readlink")
164 (:arguments (path c-string))
165 (:return-type c-string :malloc-free))
166
167 (def-c-call-out unlink
168 (:arguments (path c-string))
169 (:return-type int))
170
171 (def-c-call-out rmdir
172 (:arguments (path c-string))
173 (:return-type int))
174
175 ;;;
176 ;;; <unistd.h> -- stat, lstat
177 ;;;
178
179 (def-c-struct stat
180 (dev ulong)
181 (ino ulong)
182 (mode ulong)
183 (nlink uint)
184 (uid uint)
185 (gid uint)
186 (rdev ulong)
187 (blksize ulong)
188 (blocks ulong)
189 (atime ulong)
190 (mtime ulong)
191 (ctime ulong))
192
193 (def-c-call-out stat
194 (:name "impl_stat")
195 (:arguments (name c-string)
196 (buf (c-ptr stat) :out))
197 (:return-type int))
198
199 (def-c-call-out lstat
200 (:name "impl_lstat")
201 (:arguments (name c-string)
202 (buf (c-ptr stat) :out))
203 (:return-type int))
204
205 (def-c-call-out fstat
206 (:name "impl_fstat")
207 (:arguments (fd int)
208 (buf (c-ptr stat) :out))
209 (:return-type int))
210
211 (defconstant s-ifmt #o170000)
212 (defconstant s-ifdir #o040000)
213 (defconstant s-ifchr #o020000)
214 (defconstant s-ifblk #o060000)
215 (defconstant s-ifreg #o100000)
216 (defconstant s-ififo #o010000)
217 (defconstant s-iflnk #o120000)
218 (defconstant s-ifsock #o140000)
219
220 (defmacro s-isdir (m) `(= (logand ,m s-ifmt) s-ifdir))
221 (defmacro s-ischr (m) `(= (logand ,m s-ifmt) s-ifchr))
222 (defmacro s-isblk (m) `(= (logand ,m s-ifmt) s-ifblk))
223 (defmacro s-isreg (m) `(= (logand ,m s-ifmt) s-ifreg))
224 (defmacro s-isfifo (m) `(= (logand ,m s-ifmt) s-iffifo))
225 (defmacro s-islnk (m) `(= (logand ,m s-ifmt) s-iflnk))
226 (defmacro s-issock (m) `(= (logand ,m s-ifmt) s-ifsock))
227
228 (defconstant s-isuid #o004000)
229 (defconstant s-isgid #o002000)
230 (defconstant s-isvtx #o001000)
231
232 (define-symbol-macro s-iread s-irusr)
233 (define-symbol-macro s-iwrite s-iwusr)
234 (define-symbol-macro s-iexec s-ixusr)
235
236 (defconstant s-irusr #o000400)
237 (defconstant s-iwusr #o000200)
238 (defconstant s-ixusr #o000100)
239 (defconstant s-irwxu (logior s-irusr s-iwusr s-ixusr))
240 (defconstant s-irgrp #o000040)
241 (defconstant s-iwgrp #o000020)
242 (defconstant s-ixgrp #o000010)
243 (defconstant s-irwxg (logior s-irgrp s-iwgrp s-ixgrp))
244 (defconstant s-iroth #o000004)
245 (defconstant s-iwoth #o000002)
246 (defconstant s-ixoth #o000001)
247 (defconstant s-irwxo (logior s-iroth s-iwoth s-ixoth))
248
249 (defconstant accessperms (logior s-irwxu s-irwxg s-irwxo))
250 (defconstant deffilemode (logior s-irusr s-iwusr s-irgrp s-iwgrp s-iroth s-iwoth))
251
252 ;;;
253 ;;; <unistd.h> -- getcwd
254
255 (def-c-call-out getcwd
256 (:name "impl_getcwd")
257 (:arguments)
258 (:return-type c-string :malloc-free))
259
260 ;;;
261 ;;; <fcntl.h>
262 ;;;
263
264 (defconstant o-accmode #o00003)
265 (defconstant o-rdonly #o00000)
266 (defconstant o-wronly #o00001)
267 (defconstant o-rdwr #o00002)
268 (defconstant o-creat #o00100)
269 (defconstant o-excl #o00200)
270 (defconstant o-noctty #o00400)
271 (defconstant o-trunc #o01000)
272 (defconstant o-append #o02000)
273 (defconstant o-nonblock #o04000)
274 (defconstant o-sync #o10000)
275 (defconstant o-async #o20000)
276 (defconstant o-ndelay o-nonblock)
277 (defconstant o-fsync o-sync)

  ViewVC Help
Powered by ViewVC 1.1.5