/[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 - (hide 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 kaz 1.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 kaz 1.6 (push :clisp-unix-funcs *features*)
6    
7 kaz 1.1 (defpackage :unix-funcs
8 kaz 1.6 (: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 kaz 1.1
35     (in-package :unix-funcs)
36    
37 kaz 1.6 (defmacro def-c-call-out (sym &body args)
38     `(def-call-out ,sym (:language :stdc) ,@args))
39 kaz 1.2
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 kaz 1.1
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 kaz 1.4 ;;; <unistd.h> -- link, symlink, readlink, unlink, rmdir
161 kaz 1.1
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 kaz 1.4
173     (def-c-call-out readlink
174     (:name "impl_readlink")
175     (:arguments (path c-string))
176     (:return-type c-string :malloc-free))
177 kaz 1.1
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 kaz 1.5 ;;; <unistd.h> -- stat, lstat, chmod
188 kaz 1.1 ;;;
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 kaz 1.5 (def-c-call-out chmod
223     (:arguments (name c-string)
224     (mode uint))
225     (:return-type int))
226    
227 kaz 1.1 (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 kaz 1.3
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 kaz 1.1
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