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@random-state.net +;; Copyright (c) 2003, 2004 Nikodemus Siivola nikodemus@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@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)) - ,@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)))) + ,@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