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

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

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.5 by kaz, Fri Sep 6 02:17:27 2002 UTC revision 1.5.2.5 by kaz, Wed Apr 23 05:37:35 2003 UTC
# Line 2  Line 2 
2  ;;; which is distributed under the GNU license.  ;;; which is distributed under the GNU license.
3  ;;; Copyright 2002 Kaz Kylheku  ;;; Copyright 2002 Kaz Kylheku
4    
5    (push :clisp-unix-funcs *features*)
6    
7  (defpackage :unix-funcs  (defpackage :unix-funcs
8    (:use :ffi :lisp)    (:use :common-lisp)
9    (:shadow :open :close)    (:shadowing-import-from :ffi
10    (:export :null-pointer-p :errno :strerror :eperm :enoent :esrch :eintr :eio      :def-call-out :def-c-struct :c-array-max :c-pointer :c-ptr :c-string :int
11             :enxio :e2big :enoexec :ebadf :echild :eagain :enomem :eacces      :uint :ulong :boolean :character :c-array-ptr)
12             :efault :enotblk :ebusy :eexist :exdev :enodev :enotdir :eisdir    (:shadow
13             :einval :enfile :emfile :enotty :etxtbsy :efbig :enospc :espipe      :open :close)
14             :erofs :emlink :epipe :edom :erange :edeadlk :enametoolong :enolck    (:intern
15             :enosys :enotempty :eloop :ewouldblock :dirent :opendir :closedir      :def-c-call-out)
16             :readdir :ino :name :open :close :chdir :fchdir :link :symlink    (:export
17             :readlink :unlink :rmdir :stat :stat :lstat :fstat :chmod      :null-pointer-p :errno :strerror :eperm :enoent :esrch :eintr :eio
18             :mode :nlink :uid      :enxio :e2big :enoexec :ebadf :echild :eagain :enomem :eacces
19             :gid :rdev :blksize :blocks :atime :mtime :ctime :s-ifmt :s-ifdir      :efault :enotblk :ebusy :eexist :exdev :enodev :enotdir :eisdir
20             :s-ifchr :s-ifblk :s-ifreg :s-ififo :s-iflnk :s-ifsock :s-isdir      :einval :enfile :emfile :enotty :etxtbsy :efbig :enospc :espipe
21             :s-ischr :s-isblk :s-isreg :s-isfifo :s-islnk :s-issock :s-isuid      :erofs :emlink :epipe :edom :erange :edeadlk :enametoolong :enolck
22             :s-isgid :s-isvtx :s-iread :s-iwrite :s-iexec :s-irusr :s-iwusr      :enosys :enotempty :eloop :ewouldblock :dirent :opendir :closedir
23             :s-ixusr :s-irwxu :s-irgrp :s-iwgrp :s-ixgrp :s-irwxg :s-iroth      :readdir :ino :name :open :close :chdir :fchdir :link :symlink
24             :s-iwoth :s-ixoth :s-irwxo :accessperms :deffilemode :o-accmode      :readlink :unlink :rmdir :stat :stat :lstat :fstat :chmod
25             :o-rdonly :o-wronly :o-rdwr :o-creat :o-excl :o-noctty :o-trunc      :mode :nlink :uid
26             :o-append :o-nonblock :o-sync :o-async :o-ndelay :o-fsync :getcwd))      :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        :run-program default-sigchld ctermid))
35    
36  (in-package :unix-funcs)  (in-package :unix-funcs)
37    
38  (push :clisp-unix-funcs *features*)  (defmacro def-c-call-out (sym &body args)
39      `(def-call-out ,sym (:language :stdc) ,@args))
40    
41  ;;;  ;;;
42  ;;; Null pointer test, needed in CLISP 2.27 and older.  ;;; Null pointer test, needed in CLISP 2.27 and older.
43  ;;;  ;;;
44    
45  (def-c-call-out null-pointer-p  (def-c-call-out null-pointer-p
46    (:name "impl_null_pointer_p")    (:name "mcvs_null_pointer_p")
47    (:arguments (pointer c-pointer))    (:arguments (pointer c-pointer))
48    (:return-type boolean))    (:return-type boolean))
49    
# Line 41  Line 52 
52  ;;;  ;;;
53    
54  (def-c-call-out get-errno  (def-c-call-out get-errno
55    (:name "impl_get_errno")    (:name "mcvs_get_errno")
56    (:arguments)    (:arguments)
57    (:return-type int))    (:return-type int))
58    
59  (def-c-call-out set-errno  (def-c-call-out set-errno
60    (:name "impl_set_errno")    (:name "mcvs_set_errno")
61    (:arguments (value int))    (:arguments (value int))
62    (:return-type int))    (:return-type int))
63    
# Line 116  Line 127 
127    (:return-type int))    (:return-type int))
128    
129  (def-c-call-out readdir  (def-c-call-out readdir
130    (:name "impl_readdir")    (:name "mcvs_readdir")
131    (:arguments (dirp c-pointer))    (:arguments (dirp c-pointer))
132    (:return-type (c-ptr dirent)))    (:return-type (c-ptr dirent)))
133    
# Line 161  Line 172 
172    (:return-type int))    (:return-type int))
173    
174  (def-c-call-out readlink  (def-c-call-out readlink
175    (:name "impl_readlink")    (:name "mcvs_readlink")
176    (:arguments (path c-string))    (:arguments (path c-string))
177    (:return-type c-string :malloc-free))    (:return-type c-string :malloc-free))
178    
# Line 192  Line 203 
203    (ctime ulong))    (ctime ulong))
204    
205  (def-c-call-out stat  (def-c-call-out stat
206    (:name "impl_stat")    (:name "mcvs_stat")
207    (:arguments (name c-string)    (:arguments (name c-string)
208                (buf (c-ptr stat) :out))                (buf (c-ptr stat) :out))
209    (:return-type int))    (:return-type int))
210    
211  (def-c-call-out lstat  (def-c-call-out lstat
212    (:name "impl_lstat")    (:name "mcvs_lstat")
213    (:arguments (name c-string)    (:arguments (name c-string)
214                (buf (c-ptr stat) :out))                (buf (c-ptr stat) :out))
215    (:return-type int))    (:return-type int))
216    
217  (def-c-call-out fstat  (def-c-call-out fstat
218    (:name "impl_fstat")    (:name "mcvs_fstat")
219    (:arguments (fd int)    (:arguments (fd int)
220                (buf (c-ptr stat) :out))                (buf (c-ptr stat) :out))
221    (:return-type int))    (:return-type int))
# Line 257  Line 268 
268    
269  ;;;  ;;;
270  ;;; <unistd.h> -- getcwd  ;;; <unistd.h> -- getcwd
271    ;;;
272    
273  (def-c-call-out getcwd  (def-c-call-out getcwd
274    (:name "impl_getcwd")    (:name "mcvs_getcwd")
275      (:arguments)
276      (:return-type c-string :malloc-free))
277    
278    ;;;
279    ;;; <unistd.h> -- fork, wait*, exec*
280    ;;;
281    
282    (def-c-call-out default-sigchld
283      (:name "mcvs_default_sigchld"))
284    
285    (def-c-call-out spawn
286      (:name "mcvs_spawn")
287      (:arguments (name c-string)
288                  (argv (c-array-ptr c-string) :in :malloc-free))
289      (:return-type int))
290    
291    (defun run-program (name &key arguments)
292      (push name arguments)
293      (spawn name (coerce arguments 'vector)))
294    
295    ;;;
296    ;;; Terminal related functions
297    ;;;
298    
299    (def-c-call-out ctermid
300      (:name "mcvs_ctermid")
301    (:arguments)    (:arguments)
302    (:return-type c-string :malloc-free))    (:return-type c-string :malloc-free))
303    

Legend:
Removed from v.1.5  
changed lines
  Added in v.1.5.2.5

  ViewVC Help
Powered by ViewVC 1.1.5