/[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 - (hide 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 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     (defpackage :unix-funcs
6     (:use :ffi :lisp)
7     (:shadow :open :close)
8 kaz 1.2 (: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 kaz 1.1
25     (in-package :unix-funcs)
26    
27     (push :clisp-unix-funcs *features*)
28 kaz 1.2
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 kaz 1.1
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