/[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.6 - (show annotations)
Wed Oct 30 09:36:45 2002 UTC (11 years, 5 months ago) by kaz
Branch: MAIN
Changes since 1.5: +30 -20 lines
Merging from mcvs-1-0-branch.

* code/unix-bindings/unix.lisp: Rewrote defpackage to take only
selected symbols from CLISP's FFI package rather using the whole
thing. FFI, and the packages it uses, are moving targets.
The symbol def-c-call-out is interned in unix-funcs.
(unix-funcs:def-c-call-out): New internal macro. CLISP says that
ffi:def-c-call-out is obsolescent.

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

  ViewVC Help
Powered by ViewVC 1.1.5