[osicat-cvs] CVS update: src/grovel-constants.lisp src/osicat.asd src/osicat.lisp src/release.txt
Nikodemus Siivola
nsiivola at common-lisp.net
Sun Feb 29 11:29:14 UTC 2004
Update of /project/osicat/cvsroot/src
In directory common-lisp.net:/tmp/cvs-serv32116
Modified Files:
grovel-constants.lisp osicat.asd osicat.lisp release.txt
Log Message:
Moved ffi code away from osicat.lisp, with-c-file now consolidates *default-pathname-defaults* and the os current directory.
Date: Sun Feb 29 06:29:14 2004
Author: nsiivola
Index: src/grovel-constants.lisp
diff -u src/grovel-constants.lisp:1.2 src/grovel-constants.lisp:1.3
--- src/grovel-constants.lisp:1.2 Thu Oct 23 19:48:05 2003
+++ src/grovel-constants.lisp Sun Feb 29 06:29:14 2004
@@ -1,3 +1,30 @@
+;; Copyright (c) 2003 Nikodemus Siivola
+;;
+;; Permission is hereby granted, free of charge, to any person obtaining
+;; a copy of this software and associated documentation files (the
+;; "Software"), to deal in the Software without restriction, including
+;; without limitation the rights to use, copy, modify, merge, publish,
+;; distribute, sublicense, and/or sell copies of the Software, and to
+;; permit persons to whom the Software is furnished to do so, subject to
+;; the following conditions:
+;;
+;; The above copyright notice and this permission notice shall be included
+;; in all copies or substantial portions of the Software.
+;;
+;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
+;; IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
+;; CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
+;; TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
+;; SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+
+;;;; A simple groveler loosely based on various SBCL grovelers.
+;;;;
+;;;; Jargon note: A groveler is a lisp program that writes a C-program
+;;;; that writes a lisp program. The purpose of this excercise is to
+;;;; extract C-side definitions in a portable manner.
+
(in-package :osicat-system)
(defun write-groveler (file constants)
@@ -33,7 +60,9 @@
(setf *grovel*
(lambda (c obj lisp)
(write-groveler c
- '( ;; File types
+ '(;; File types
+ ;; OAOOM Warning: these are explicitly listed
+ ;; in osicat.lisp as well.
(mode-mask . S_IFMT)
(directory . S_IFDIR)
(character-device . S_IFCHR)
Index: src/osicat.asd
diff -u src/osicat.asd:1.3 src/osicat.asd:1.4
--- src/osicat.asd:1.3 Tue Nov 18 03:18:58 2003
+++ src/osicat.asd Sun Feb 29 06:29:14 2004
@@ -1,4 +1,4 @@
-;; Copyright (c) 2003 Nikodemus Siivola <nikodemus at random-state.net>
+;; Copyright (c) 2003, 2004 Nikodemus Siivola <nikodemus at random-state.net>
;;
;; Permission is hereby granted, free of charge, to any person obtaining
;; a copy of this software and associated documentation files (the
@@ -24,6 +24,8 @@
(in-package :osicat-system)
+;;;; C-SOURCE FILE HANDLING
+
(defvar *gcc* "/usr/bin/gcc")
(defvar *gcc-options* '(#-darwin "-shared"
#+darwin "-bundle"
@@ -47,6 +49,8 @@
(namestring (car (output-files o c)))))
(error 'operation-error :component c :operation o)))
+;;;; GROVELING
+
(defclass grovel-file (cl-source-file) ())
(defmethod perform ((o compile-op) (c grovel-file))
@@ -57,21 +61,25 @@
(constants (merge-pathnames "grovel.lisp-temp" output-file))
(*grovel*))
(declare (special *grovel*))
- (load filename)
+ ;; Loading the groveler will bind the *govel* hook.
+ (load filename)
(and (funcall (the function *grovel*) c-source a-dot-out constants)
(compile-file constants :output-file output-file))))
-;;; The actual system
+;;;; SYSTEM
+
(defsystem :osicat
:depends-on (:uffi)
:components
((:c-source-file "osicat-glue")
(:file "packages")
- (:file "macros" :depends-on ("packages"))
(:grovel-file "grovel-constants" :depends-on ("packages"))
- (:file "foreign-types" :depends-on ("packages"))
+ (:file "early-util" :depends-on ("packages"))
+ (:file "ffi" :depends-on ("early-util"))
(:file "osicat" :depends-on
- ("osicat-glue" "foreign-types" "macros" "grovel-constants"))))
+ ("osicat-glue" "ffi" "grovel-constants"))))
+
+;;;; TESTING
(defsystem :osicat-test
:depends-on (:osicat :rt)
Index: src/osicat.lisp
diff -u src/osicat.lisp:1.8 src/osicat.lisp:1.9
--- src/osicat.lisp:1.8 Sun Oct 26 11:10:33 2003
+++ src/osicat.lisp Sun Feb 29 06:29:14 2004
@@ -1,4 +1,4 @@
-;; Copyright (c) 2003 Nikodemus Siivola
+;; Copyright (c) 2003, 2004 Nikodemus Siivola
;;
;; Permission is hereby granted, free of charge, to any person obtaining
;; a copy of this software and associated documentation files (the
@@ -21,53 +21,47 @@
(in-package :osicat)
-(def-function ("osicat_mode" c-file-mode) ((name :cstring) (follow-p :int))
- :module "osicat"
- :returning :int)
-
-(define-condition bug (error)
- ((message :reader message :initarg :message))
- (:report (lambda (condition stream)
- (format stream "~A. This seems to be a bug in Osicat.~
- Please report on osicat-devel at common-lisp.net."
- (message condition)))))
-
-;;; KLUDGE: Would macrolet frob be preferable here? I can't see why...
-(eval
- `(defun c-file-kind (c-file follow-p)
- (let ((mode (c-file-mode c-file (if follow-p 1 0))))
- (unless (minusp mode)
- (case (logand mode-mask mode)
- ,@(mapcar
- (lambda (sym)
- (list (eval sym)
- (intern (symbol-name sym) :keyword)))
- ;; OAOOM: These are in grovel-constants.lisp as well.
- '(directory character-device block-device
- regular-file symbolic-link pipe socket))
- (t (error
- 'bug :message
- (format nil "Unknown file mode: ~H." mode))))))))
+(macrolet ((def ()
+ `(defun c-file-kind (c-file follow-p)
+ (let ((mode (c-file-mode c-file (if follow-p 1 0))))
+ (unless (minusp mode)
+ (case (logand mode-mask mode)
+ ,@(mapcar
+ (lambda (sym)
+ (list (eval sym)
+ (intern (symbol-name sym) :keyword)))
+ ;; OAOOM Warning:
+ ;; These are in grovel-constants.lisp as well.
+ '(directory character-device block-device
+ regular-file symbolic-link pipe socket))
+ (t (error
+ 'bug :message
+ (format nil "Unknown file mode: ~H." mode)))))))))
+ (def))
-(defmacro with-c-file ((c-file pathname &optional required-kind follow-p) &body forms)
- ;; FIXME: This assumes that OS has the same idea of current dir as Lisp
+(defmacro with-c-file
+ ((c-file pathname &optional required-kind follow-p) &body forms)
(with-unique-names (path kind)
- `(let ((,path ,pathname))
+ ;; We merge the pathname to consolidate *default-pathname-defaults*
+ ;; and C-sides idea of current directory: relative *d-p-d* gives
+ ;; way to the C-side, whereas absolute ones take precedence.
+ `(let ((,path (merge-pathnames ,pathname)))
(when (wild-pathname-p ,path)
(error "Pathname is wild: ~S." ,path))
(with-cstring (,c-file (namestring ,path))
- (let ((,kind (c-file-kind ,c-file ,follow-p)))
- ,(etypecase required-kind
- (keyword `(unless (eq ,required-kind ,kind)
- (if ,kind
- (error "~A is ~A, not ~A."
- ,path ,kind ,required-kind)
- (error "~A ~S does not exist."
- ,required-kind ,path))))
- ((eql t) `(unless ,kind
- (error "~A does not exist." ,path)))
- (null nil))
- , at forms)))))
+ ,@(if required-kind
+ `((let ((,kind (c-file-kind ,c-file ,follow-p)))
+ ,(etypecase required-kind
+ (keyword `(unless (eq ,required-kind ,kind)
+ (if ,kind
+ (error "~A is ~A, not ~A."
+ ,path ,kind ,required-kind)
+ (error "~A ~S does not exist."
+ ,required-kind ,path))))
+ ((eql t) `(unless ,kind
+ (error "~A does not exist." ,path))))
+ , at forms))
+ forms)))))
(defun file-kind (pathspec)
"function FILE-KIND pathspec => file-kind
@@ -87,22 +81,6 @@
(with-cstring (cfile (namestring path))
(c-file-kind cfile nil))))
-(def-function "opendir" ((name :cstring))
- :module "osicat"
- :returning :pointer-void)
-
-(def-function "closedir" ((dir :pointer-void))
- :module "osicat"
- :returning :int)
-
-(def-function "readdir" ((dir :pointer-void))
- :module "osicat"
- :returning :pointer-void)
-
-(def-function "osicat_dirent_name" ((entry :pointer-void))
- :module "osicat"
- :returning :cstring)
-
(defmacro with-directory-iterator ((iterator pathspec) &body body)
"macro WITH-DIRECTORY-ITERATOR (iterator pathspec) &body forms => value
@@ -124,26 +102,30 @@
`(let ((,dir ,pathspec))
(with-c-file (,cdir ,dir :directory t)
(let ((,dp nil)
- (,default (make-pathname :name nil
- :type nil
- :directory (append ;KLUDGE: deal with missing /'s
- (pathname-directory ,dir)
- (remove-if (lambda (o)
- (or (null o)
- (keywordp o)))
- (list (pathname-name ,dir)
- (pathname-type ,dir))))
- :defaults ,dir)))
+ (,default
+ (make-pathname :name nil :type nil
+ :directory
+ (append ;KLUDGE: deal with missing /'s
+ (pathname-directory ,dir)
+ (remove-if (lambda (o)
+ (or (null o)
+ (keywordp o)))
+ (list (pathname-name ,dir)
+ (pathname-type ,dir))))
+ :defaults ,dir)))
(unwind-protect
(labels ((,iterator ()
(let ((entry (readdir ,dp)))
(if (null-pointer-p entry)
nil
- (let ((namestring (convert-from-cstring
- (osicat-dirent-name entry))))
- (if (member namestring '("." "..") :test #'equal)
+ (let ((namestring
+ (convert-from-cstring
+ (osicat-dirent-name entry))))
+ (if (member namestring '("." "..")
+ :test #'equal)
(,iterator)
- (merge-pathnames namestring ,default)))))))
+ (merge-pathnames namestring
+ ,default)))))))
(setf ,dp (opendir ,cdir))
(when (null-pointer-p ,dp)
(error "Error opening directory ~S." ,dir))
@@ -167,10 +149,6 @@
while entry
collect (funcall function entry))))
-(def-function "rmdir" ((name :cstring))
- :module "osicat"
- :returning :int)
-
(defun delete-directory (pathspec)
"function DELETE-DIRECTORY pathspec => T
@@ -184,21 +162,6 @@
pathspec
(error "Could not delete directory ~S." pathspec))))
-(def-function "getenv" ((name :cstring))
- :module "osicat"
- :returning :cstring)
-
-(def-function "setenv" ((name :cstring) (value :cstring) (replace :int))
- :module "osicat"
- :returning :int)
-
-(def-function "unsetenv" ((name :cstring))
- :module "osicat"
- :returning :int)
-
-(def-array-pointer cstring-array :cstring)
-(def-foreign-var "environ" 'cstring-array "osicat")
-
(defmacro with-c-name ((cname name) &body forms)
(with-unique-names (n-name)
`(let ((,n-name ,name))
@@ -256,11 +219,6 @@
the environment use (SETF ENVIRONMENT-VARIABLE) and
MAKUNBOUND-ENVIRONMENT-VARIABLE.")
-(def-function "readlink"
- ((name :cstring) (buffer (* :unsigned-char)) (size :size-t))
- :module "osicat"
- :returning :int)
-
(defun read-link (pathspec)
"function READ-LINK pathspec => pathname
@@ -283,14 +241,6 @@
(pathname str)))
(free-foreign-object buffer)))))
-(def-function "symlink" ((old :cstring) (new :cstring))
- :module "osicat"
- :returning :int)
-
-(def-function "link" ((old :cstring) (new :cstring))
- :module "osicat"
- :returning :int)
-
(defun make-link (target link &key hard)
"function MAKE-LINK target link &key hard => pathname
@@ -306,10 +256,6 @@
(pathname link)
(error "Could not create ~A link ~S -> ~S."
(if hard "hard" "symbolic") link target)))))
-
-(def-function "chmod" ((name :cstring) (mode :mode-t))
- :module "osicat"
- :returning :int)
(define-symbol-macro +permissions+
(load-time-value (mapcar (lambda (x)
Index: src/release.txt
diff -u src/release.txt:1.3 src/release.txt:1.4
--- src/release.txt:1.3 Sun Oct 26 09:19:32 2003
+++ src/release.txt Sun Feb 29 06:29:14 2004
@@ -1,6 +1,6 @@
osicat.asd
-foreign-types.lisp
-macros.lisp
+ffi.lisp
+early-util.lisp
grovel-constants.lisp
packages.lisp
osicat.lisp
More information about the Osicat-cvs
mailing list