/[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.2 - (show annotations)
Sun Aug 4 18:15:18 2002 UTC (11 years, 8 months ago) by kaz
Branch: MAIN
CVS Tags: mcvs-0-21
Changes since 1.1: +25 -16 lines
Working back support for CLISP 2.27.

* code/install.sh: Bogus *null-pointer* hack is no longer added
to the generated mcvs script, since we have our own FFI functions for
doing the test.

* code/unix-bindings/unix.lisp (unix-funcs:null-pointer-p): New
function, tests a C pointer for null, returns T or NIL.
* code/unix-bindings/impl.c (impl_null_pointer_p): New function,
C implementation of unix-funcs:null-pointer-p.

* code/clisp-unix.lisp (pointer-null): New macro, uses
ffi:foreign-address-null under CLISP 2.28 or greater, or
unix-funcs:null-pointer-p, under an older CLISP.
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 :unlink :rmdir :stat :stat :lstat :fstat :mode :nlink :uid :gid
16 :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))
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, 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 unlink
163 (:arguments (path c-string))
164 (:return-type int))
165
166 (def-c-call-out rmdir
167 (:arguments (path c-string))
168 (:return-type int))
169
170 ;;;
171 ;;; <unistd.h> -- stat, lstat
172 ;;;
173
174 (def-c-struct stat
175 (dev ulong)
176 (ino ulong)
177 (mode ulong)
178 (nlink uint)
179 (uid uint)
180 (gid uint)
181 (rdev ulong)
182 (blksize ulong)
183 (blocks ulong)
184 (atime ulong)
185 (mtime ulong)
186 (ctime ulong))
187
188 (def-c-call-out stat
189 (:name "impl_stat")
190 (:arguments (name c-string)
191 (buf (c-ptr stat) :out))
192 (:return-type int))
193
194 (def-c-call-out lstat
195 (:name "impl_lstat")
196 (:arguments (name c-string)
197 (buf (c-ptr stat) :out))
198 (:return-type int))
199
200 (def-c-call-out fstat
201 (:name "impl_fstat")
202 (:arguments (fd int)
203 (buf (c-ptr stat) :out))
204 (:return-type int))
205
206 (defconstant s-ifmt #o170000)
207 (defconstant s-ifdir #o040000)
208 (defconstant s-ifchr #o020000)
209 (defconstant s-ifblk #o060000)
210 (defconstant s-ifreg #o100000)
211 (defconstant s-ififo #o010000)
212 (defconstant s-iflnk #o120000)
213 (defconstant s-ifsock #o140000)
214
215 (defmacro s-isdir (m) `(= (logand ,m s-ifmt) s-ifdir))
216 (defmacro s-ischr (m) `(= (logand ,m s-ifmt) s-ifchr))
217 (defmacro s-isblk (m) `(= (logand ,m s-ifmt) s-ifblk))
218 (defmacro s-isreg (m) `(= (logand ,m s-ifmt) s-ifreg))
219 (defmacro s-isfifo (m) `(= (logand ,m s-ifmt) s-iffifo))
220 (defmacro s-islnk (m) `(= (logand ,m s-ifmt) s-iflnk))
221 (defmacro s-issock (m) `(= (logand ,m s-ifmt) s-ifsock))
222
223 (defconstant s-isuid #o004000)
224 (defconstant s-isgid #o002000)
225 (defconstant s-isvtx #o001000)
226
227 (define-symbol-macro s-iread s-irusr)
228 (define-symbol-macro s-iwrite s-iwusr)
229 (define-symbol-macro s-iexec s-ixusr)
230
231 (defconstant s-irusr #o000400)
232 (defconstant s-iwusr #o000200)
233 (defconstant s-ixusr #o000100)
234 (defconstant s-irwxu (logior s-irusr s-iwusr s-ixusr))
235 (defconstant s-irgrp #o000040)
236 (defconstant s-iwgrp #o000020)
237 (defconstant s-ixgrp #o000010)
238 (defconstant s-irwxg (logior s-irgrp s-iwgrp s-ixgrp))
239 (defconstant s-iroth #o000004)
240 (defconstant s-iwoth #o000002)
241 (defconstant s-ixoth #o000001)
242 (defconstant s-irwxo (logior s-iroth s-iwoth s-ixoth))
243
244 (defconstant accessperms (logior s-irwxu s-irwxg s-irwxo))
245 (defconstant deffilemode (logior s-irusr s-iwusr s-irgrp s-iwgrp s-iroth s-iwoth))
246
247 ;;;
248 ;;; <fcntl.h>
249 ;;;
250
251 (defconstant o-accmode #o00003)
252 (defconstant o-rdonly #o00000)
253 (defconstant o-wronly #o00001)
254 (defconstant o-rdwr #o00002)
255 (defconstant o-creat #o00100)
256 (defconstant o-excl #o00200)
257 (defconstant o-noctty #o00400)
258 (defconstant o-trunc #o01000)
259 (defconstant o-append #o02000)
260 (defconstant o-nonblock #o04000)
261 (defconstant o-sync #o10000)
262 (defconstant o-async #o20000)
263 (defconstant o-ndelay o-nonblock)
264 (defconstant o-fsync o-sync)

  ViewVC Help
Powered by ViewVC 1.1.5