[10d2c0]: contrib / sb-bsd-sockets / def-to-lisp.lisp Maximize Restore History

Download this file

def-to-lisp.lisp    71 lines (65 with data), 3.1 kB

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
(in-package :SB-BSD-SOCKETS-SYSTEM)
(defvar *export-symbols* nil)
(defun c-for-structure (stream lisp-name c-struct)
(destructuring-bind (c-name &rest elements) c-struct
(format stream "printf(\"(define-c-struct ~A %d)\\n\",sizeof (~A));~%" lisp-name c-name)
(dolist (e elements)
(destructuring-bind (lisp-type lisp-el-name c-type c-el-name) e
(format stream "printf(\"(define-c-accessor ~A-~A ~A ~A \");~%"
lisp-name lisp-el-name lisp-name lisp-type)
;; offset
(format stream "{ ~A t;printf(\"%d \",((unsigned long)&(t.~A)) - ((unsigned long)&(t)) ); }~%"
c-name c-el-name)
;; length
(format stream "{ ~A t;printf(\"%d\",(sizeof t.~A));}~%"
c-name c-el-name)
(format stream "printf(\")\\n\");~%")))))
(defun c-for-function (stream lisp-name alien-defn)
(destructuring-bind (c-name &rest definition) alien-defn
(let ((*print-right-margin* nil))
(format stream "printf(\"(declaim (inline ~A))\\n\");~%"
lisp-name)
(princ "printf(\"(def-foreign-routine (" stream)
(princ "\\\"" stream) (princ c-name stream) (princ "\\\" " stream)
(princ lisp-name stream)
(princ " ) " stream)
(dolist (d definition)
(write d :length nil
:right-margin nil :stream stream)
(princ " " stream))
(format stream ")\\n\");")
(terpri stream))))
(defun print-c-source (stream headers definitions package-name)
;(format stream "#include \"struct.h\"~%")
(let ((*print-right-margin* nil))
(loop for i in headers
do (format stream "#include <~A>~%" i))
(format stream "main() { ~%
printf(\"(in-package ~S)\\\n\");~%" package-name)
(format stream "printf(\"(defconstant size-of-int %d)\\\n\",sizeof (int));~%")
(format stream "printf(\"(defconstant size-of-char %d)\\\n\",sizeof (char));~%")
(format stream "printf(\"(defconstant size-of-long %d)\\\n\",sizeof (long));~%")
(dolist (def definitions)
(destructuring-bind (type lispname cname &optional doc) def
(cond ((eq type :integer)
(format stream
"printf(\"(defconstant ~A %d \\\"~A\\\")\\\n\",~A);~%"
lispname doc cname))
((eq type :string)
(format stream
"printf(\"(defvar ~A %S \\\"~A\\\")\\\n\",~A);~%"
lispname doc cname))
((eq type :function)
(c-for-function stream lispname cname))
((eq type :structure)
(c-for-structure stream lispname cname))
(t
(format stream
"printf(\";; Non hablo Espagnol, Monsieur~%")))))
(format stream "exit(0);~%}")))
(defun c-constants-extract (filename output-file package)
(with-open-file (f output-file :direction :output)
(with-open-file (i filename :direction :input)
(let* ((headers (read i))
(definitions (read i)))
(print-c-source f headers definitions package)))))