Added generate-ffi-for-files to batch process a bunch of .h's
Mon Sep 4 22:03:34 PDT 2006 Daniel Dickison (danieldickison@gmail.com)
* Added generate-ffi-for-files to batch process a bunch of .h's
diff -rN -u old-c2ffi/C-to-FFI.lisp new-c2ffi/C-to-FFI.lisp
--- old-c2ffi/C-to-FFI.lisp 2014-07-28 09:32:05.000000000 -0700
+++ new-c2ffi/C-to-FFI.lisp 1969-12-31 16:00:00.000000000 -0800
@@ -1,173 +0,0 @@
-;;; Copyright 2006 Daniel Dickison (danieldickison@cmu.edu)
-
-(in-package :c2ffi)
-
-(export '(make-uffi-for-files
- parse-header-xml
- make-uffi-defs
- eval-defs
- write-defs))
-
-
-
-(defun make-uffi-for-files (dir &key gcc-options-file (in-package *package*))
- (format *terminal-io* "~&~%Running: ~S~%Options: ~S~%" *gccxml-command-path* (truename gcc-options-file))
- (dolist (infile (directory dir))
- (let ((xmlfile (make-pathname :type "xml"
- :directory (append (pathname-directory infile) '("XML"))
- :defaults infile))
- (lispfile (make-pathname :type "lisp"
- :directory (append (pathname-directory infile) '("UFFI"))
- :defaults infile)))
- (ensure-directories-exist xmlfile)
- (ensure-directories-exist lispfile)
- (format *terminal-io* "~&~%Input: ~S~%XML: ~S~%UFFI: ~S~%" infile xmlfile lispfile)
-
- ;; Run GCC-XML.
- (generate-xml infile xmlfile gcc-options-file)
-
- ;; Run the XML parser and UFFI generator.
- (let ((xml (parse-header-xml xmlfile)))
- (write-defs (make-uffi-defs xml)
- lispfile
- :in-package in-package)))))
-
-
-
-
-(defun write-defs (defs filepath &key (in-package *package*))
- (with-open-file (f filepath
- :direction :output
- :if-exists :supersede)
- (when in-package
- (write `(in-package ,(if (packagep in-package)
- (package-name in-package)
- in-package))
- :stream f :readably t :escape t :level nil :lines nil :pretty t)
- (terpri f))
- (dolist (def defs)
- (write def
- :stream f :readably t :escape t :level nil :lines nil :pretty t)
- (terpri f))))
-
-(defun eval-defs (defs)
- (eval (cons 'progn defs)))
-
-
-
-;;;;;;;;;;;; Types and Names ;;;;;;;;;;;;
-
-(defvar *foreign-names* nil)
-(defvar *foreign-types* nil)
-
-(defun print-types ()
- (maphash #'(lambda (id type)
- (format t "~7@A => ~s~%" id type))
- *foreign-types*))
-
-(defun get-name-with-id (id)
- (or (gethash id *foreign-names*)
- (error "ID ~S does not map to a name." id)))
-
-(defun get-name-symbol (id)
- (intern (string-upcase (get-name-with-id id))))
-
-(defun get-type-with-id (id)
- (multiple-value-bind
- (entry exists?) (gethash id *foreign-types*)
- (unless exists?
- (error "Type with ID ~S does not exist." id))
- (etypecase entry
- (list (mapcar #'(lambda (token)
- (if (stringp token)
- (get-type-with-id token)
- token))
- entry))
- (string (get-type-with-id entry))
- (symbol entry))))
-
-(defun type-generator (node-type)
- (case (intern node-type :keyword)
- ((:|Typedef|
- :|CvQualifiedType|) #'typedef-type-generator)
- (:|PointerType| #'pointertype-type-generator)
- (:|FunctionType| #'FunctionType-type-generator)
- (:|FundamentalType| #'FundamentalType-type-generator)
- ((:|Struct|
- :|Enumeration|) #'StructType-type-generator)))
-
-(defun translate-to-uffi-type (type)
- (case type
- (:long-int :long)
- (:long-long-int :long-long)
- (t type)))
-
-(defun FundamentalType-type-generator (node prev-node)
- (declare (ignore prev-node))
- (translate-to-uffi-type
- (intern (string-upcase (string-replace (node-attribute "name" node)
- " " "-"
- :all t))
- :keyword)))
-
-(defun TypeDef-type-generator (node prev-node)
- (declare (ignore prev-node))
- (aif (node-attribute "name" node)
- (intern (string-upcase it))
- (node-attribute "type" node)))
-
-(defun PointerType-type-generator (node prev-node)
- (declare (ignore prev-node))
- `(* ,(node-attribute "type" node)))
-
-(defun FunctionType-type-generator (node prev-node)
- "This simply returns a pointer for now."
- (declare (ignore node prev-node))
- :address)
-
-(defun StructType-type-generator (node prev-node)
- "If this entry is 'artificial', the previous node defines its type name."
- (if (aand (node-attribute "artificial" node)
- (string= it "1"))
- (node-attribute "id" prev-node)
- (intern (string-upcase (node-attribute "name" node)))))
-
-
-
-
-
-
-(defparameter *test-xml* "USER:Library;Lisp;MyCode;CL-C-Parser;Test Files;XPWidgets.xml")
-
-(defun parse-header-xml (&optional (filepath *test-xml*))
- (with-open-file (stream filepath)
- (parse stream)))
-
-(defun id-mappings (root)
- (let ((names (make-hash-table :test #'equal))
- (types (make-hash-table :test #'equal))
- (prev-node nil)
- (id nil))
- (do-nodes-df (node root)
- (setf id (node-attribute "id" node))
- (when id
- (awhen (gethash id names)
- (error "Duplicate ID ~S (~A)." id it))
- (setf (gethash id names)
- (if (aand (node-attribute "artificial" node)
- (string= it "1"))
- (node-attribute "name" prev-node)
- (node-attribute "name" node)))
- (awhen (type-generator (node-name node))
- (setf (gethash id types) (funcall it node prev-node))))
- (setf prev-node node))
-
- (setf *foreign-names* names)
- (setf *foreign-types* types)
- (values names types)))
-
-
-
-
-
-
diff -rN -u old-c2ffi/GCC-XML.lisp new-c2ffi/GCC-XML.lisp
--- old-c2ffi/GCC-XML.lisp 2014-07-28 09:32:05.000000000 -0700
+++ new-c2ffi/GCC-XML.lisp 2014-07-28 09:32:05.000000000 -0700
@@ -3,10 +3,18 @@
(export '(generate-xml))
(defun generate-xml (h-file xml-file &optional gcc-opts-file)
+ (format *terminal-io* "~&~%Running: ~S~%Options: ~S~%Input: ~S~%Output: ~S~%"
+ *gccxml-command-path* (truename gcc-opts-file)
+ (namestring (truename h-file))
+ (namestring xml-file))
+
+ #+:openmcl
(ccl:run-program (namestring *gccxml-command-path*)
(list* (namestring (truename h-file))
(namestring xml-file)
(when gcc-opts-file
(list (namestring (truename gcc-opts-file)))))
:output *terminal-io*
- :error *error-output*))
\ No newline at end of file
+ :error *error-output*)
+ #-:openmcl
+ (error "Generate-XML is currently only implemented for OpenMCL."))
diff -rN -u old-c2ffi/UFFI-Generator.lisp new-c2ffi/UFFI-Generator.lisp
--- old-c2ffi/UFFI-Generator.lisp 2014-07-28 09:32:05.000000000 -0700
+++ new-c2ffi/UFFI-Generator.lisp 2014-07-28 09:32:05.000000000 -0700
@@ -1,8 +1,6 @@
(in-package :c2ffi)
-(export '(make-uffi-defs))
-
-
+#|
(defun make-uffi-defs (root)
"Returns a list of UFFI definitions, in the order of:
1. typedefs and enums
@@ -73,3 +71,4 @@
(collect (list
(intern (string-upcase (node-attribute "name" field)))
(get-type-with-id (node-attribute "type" field))))))))
+|#
\ No newline at end of file
diff -rN -u old-c2ffi/c2ffi.asd new-c2ffi/c2ffi.asd
--- old-c2ffi/c2ffi.asd 2014-07-28 09:32:05.000000000 -0700
+++ new-c2ffi/c2ffi.asd 2014-07-28 09:32:05.000000000 -0700
@@ -12,18 +12,26 @@
(:file "GCC-XML"
:depends-on ("Package" "Pathnames"))
(:file "FFI-Generator"
- :depends-on ("Package" "String-Utilities" "XML-Utilities"))))
-; (:file "CFFI-Generator"
-; :depends-on ("Package" "FFI-Generator"))))
-;
-; (:file "C-to-FFI"
-; :depends-on ("Pathnames" "Package" "GCC-XML"
-; "XML-Utilities" "String-Utilities"))
-; (:file "UFFI-Generator"
-; :depends-on ("Package" "C-to-FFI"))))
+ :depends-on ("Package" "String-Utilities" "XML-Utilities"))
+ (:file "c2ffi"
+ :depends-on ("Package" "GCC-XML" "FFI-Generator"))
+
+ #+:cffi
+ (:file "CFFI-Generator"
+ :depends-on ("Package" "FFI-Generator"))
+
+ #+:uffi
+ (:file "UFFI-Generator"
+ :depends-on ("Package" "C-to-FFI"))))
(defsystem "c2ffi-cffi"
:author "Daniel Dickison (danieldickison@gmail.com)"
:version "0.1"
:depends-on ("c2ffi" "xmls" "cl-utilities" "anaphora" "cffi")
:components ((:file "CFFI-Generator")))
+
+(defsystem "c2ffi-uffi"
+ :author "Daniel Dickison (danieldickison@gmail.com)"
+ :version "0.1"
+ :depends-on ("c2ffi" "xmls" "cl-utilities" "anaphora" "cffi")
+ :components ((:file "UFFI-Generator")))
diff -rN -u old-c2ffi/c2ffi.lisp new-c2ffi/c2ffi.lisp
--- old-c2ffi/c2ffi.lisp 1969-12-31 16:00:00.000000000 -0800
+++ new-c2ffi/c2ffi.lisp 2014-07-28 09:32:05.000000000 -0700
@@ -0,0 +1,32 @@
+;;; Copyright 2006 Daniel Dickison (danieldickison@cmu.edu)
+
+(in-package :c2ffi)
+
+(export '(generate-ffi-for-files
+ eval-bindings))
+
+
+(defun generate-ffi-for-files (dir
+ &key (generator-class 'cffi-generator)
+ gcc-options-file
+ in-package)
+ (dolist (infile (directory dir))
+ (let* ((xmlfile (make-pathname
+ :type "xml"
+ :directory (append (pathname-directory infile) '("XML"))
+ :defaults infile))
+ (generator (make-instance generator-class
+ :xml-file xmlfile)))
+ (ensure-directories-exist xmlfile)
+
+ ;; Run GCC-XML.
+ (generate-xml infile xmlfile gcc-options-file)
+
+ ;; Run the FFI generator.
+ (write-bindings generator :in-package in-package))))
+
+(defun eval-bindings (defs)
+ (eval (cons 'progn defs)))
+
+
+