[PATCH] Make clg work on sbcl/x86-64
Gabriel Ebner <[email protected]> Sat, 25 Feb 2006 23:03:52 +0000 (UTC)
| Newsgroups | gmane.lisp.clg.devel |
|---|---|
| Message-ID | <[email protected]> |
The attached patch makes clg run on sbcl/x86-64. It figures out the type sizes and alignment at compile-time and looks where the spaces are in nm output. Gabriel.
amd64-v2.diff
(text/plain, 4.7 KB)
? amd64-v1.diff
? amd64-v2.diff
? atk/atk.fasl
? atk/defpackage.fasl
? atk/export.fasl
? cairo/cairo.fasl
? cairo/defpackage.fasl
? cairo/export.fasl
? gdk/defpackage.fasl
? gdk/export.fasl
? gdk/gdk.fasl
? gdk/gdkevents.fasl
? gdk/gdktypes.fasl
? gdk/pixbuf.fasl
? glib/defpackage.fasl
? glib/export.fasl
? glib/ffi.fasl
? glib/gboxed.fasl
? glib/gcallback.fasl
? glib/genums.fasl
? glib/gerror.fasl
? glib/ginterface.fasl
? glib/glib.fasl
? glib/gobject.fasl
? glib/gparam.fasl
? glib/gtype.fasl
? glib/proxy.fasl
? glib/utils.fasl
? gtk/defpackage.fasl
? gtk/export.fasl
? gtk/gtk.fasl
? gtk/gtkaction.fasl
? gtk/gtkcontainer.fasl
? gtk/gtkobject.fasl
? gtk/gtkselection.fasl
? gtk/gtkstyle.fasl
? gtk/gtktext.fasl
? gtk/gtktree.fasl
? gtk/gtktypes.fasl
? gtk/gtkutils.fasl
? gtk/gtkwidget.fasl
? pango/defpackage.fasl
? pango/export.fasl
? pango/pango.fasl
? tools/asdf-extensions.fasl
? tools/autoexport.fasl
? tools/config.fasl
Index: gdk/gdk.lisp
===================================================================
RCS file: /cvsroot/clg/clg/gdk/gdk.lisp,v
retrieving revision 1.21
diff -u -r1.21 gdk.lisp
--- gdk/gdk.lisp 9 Feb 2006 22:31:28 -0000 1.21
+++ gdk/gdk.lisp 25 Feb 2006 22:53:02 -0000
@@ -340,7 +340,7 @@
(root-y int)
(timestamp unsigned-int))
-;; komplett s langt
+;; komplett så langt
(defbinding window-set-user-data () nil
(window window)
Index: glib/ffi.lisp
===================================================================
RCS file: /cvsroot/clg/clg/glib/ffi.lisp,v
retrieving revision 1.25
diff -u -r1.25 ffi.lisp
--- glib/ffi.lisp 19 Feb 2006 22:25:31 -0000 1.25
+++ glib/ffi.lisp 25 Feb 2006 22:53:03 -0000
@@ -311,20 +311,46 @@
(def-type-method unbound-value ()
"First return value is true if the type has an unbound value, second return value is the actual unbound value")
+#+sbcl
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (defun sb-sizeof-bits (type)
+ (sb-alien-internals:alien-type-bits
+ (sb-alien-internals:parse-alien-type type nil)))
+
+ (defun sb-sizeof (type)
+ (/ (sb-sizeof-bits type) 8)))
;; Sizes of fundamental C types in bytes (8 bits)
-(defconstant +size-of-short+ 2)
-(defconstant +size-of-int+ 4)
-(defconstant +size-of-long+ 4)
-(defconstant +size-of-pointer+ 4)
-(defconstant +size-of-float+ 4)
-(defconstant +size-of-double+ 8)
+(defconstant +size-of-short+
+ #+sbcl (sb-sizeof 'sb-alien:short)
+ #-sbcl 2)
+(defconstant +size-of-int+
+ #+sbcl (sb-sizeof 'sb-alien:int)
+ #-sbcl 4)
+(defconstant +size-of-long+
+ #+sbcl (sb-sizeof 'sb-alien:long)
+ #-sbcl 4)
+(defconstant +size-of-pointer+
+ #+sbcl (sb-sizeof 'sb-alien:system-area-pointer)
+ #-sbcl 4)
+(defconstant +size-of-float+
+ #+sbcl (sb-sizeof 'sb-alien:float)
+ #-sbcl 4)
+(defconstant +size-of-double+
+ #+sbcl (sb-sizeof 'sb-alien:double)
+ #-sbcl 8)
;; Sizes of fundamental C types in bits
(defconstant +bits-of-byte+ 8)
-(defconstant +bits-of-short+ 16)
-(defconstant +bits-of-int+ 32)
-(defconstant +bits-of-long+ 32)
+(defconstant +bits-of-short+
+ #+sbcl (sb-sizeof-bits 'sb-alien:short)
+ #-sbcl 16)
+(defconstant +bits-of-int+
+ #+sbcl (sb-sizeof-bits 'sb-alien:int)
+ #-sbcl 32)
+(defconstant +bits-of-long+
+ #+sbcl (sb-sizeof-bits 'sb-alien:long)
+ #-sbcl 32)
(deftype int () '(signed-byte #.+bits-of-int+))
Index: glib/gtype.lisp
===================================================================
RCS file: /cvsroot/clg/clg/glib/gtype.lisp,v
retrieving revision 1.46
diff -u -r1.46 gtype.lisp
--- glib/gtype.lisp 19 Feb 2006 22:25:31 -0000 1.46
+++ glib/gtype.lisp 25 Feb 2006 22:53:04 -0000
@@ -30,7 +30,7 @@
(defbinding type-init () nil)
(type-init)
-(deftype type-number () '(unsigned 32))
+(deftype type-number () 'unsigned-long)
(deftype gtype () 'symbol)
@@ -197,7 +197,7 @@
(unwind-protect
(loop
as symbol = (let ((line (read-line (process-output process) nil)))
- (when line (subseq line 11)))
+ (when line (subseq line (1+ (position #\Space line :from-end t)))))
while symbol
when (and
(> (length symbol) 9)
Index: glib/proxy.lisp
===================================================================
RCS file: /cvsroot/clg/clg/glib/proxy.lisp,v
retrieving revision 1.35
diff -u -r1.35 proxy.lisp
--- glib/proxy.lisp 19 Feb 2006 19:23:23 -0000 1.35
+++ glib/proxy.lisp 25 Feb 2006 22:53:04 -0000
@@ -445,7 +445,12 @@
(call-next-method))
;; TODO: call some C code to detect this a compile time
- (defconstant +struct-alignmen+ 4)
+ (defconstant +struct-alignmen+
+ #+sbcl (/ (sb-alien-internals:alien-type-alignment
+ (sb-alien-internals:parse-alien-type
+ 'system-area-pointer nil))
+ 8)
+ #-sbcl 4)
(defun align-offset (size)
(if (zerop (mod size +struct-alignmen+))
signature.asc
(application/pgp-signature, 189 B)
-----BEGIN PGP SIGNATURE----- Version: GnuPG v1.4.2 (GNU/Linux) iD8DBQFEAOJYja6QLvw1CaARAo/nAJ45e3IAIUmCJB+KmefE6m7h3QZNBQCfc4/d Ql6jLfj+n66pB08X1ojsKcA= =yjH/ -----END PGP SIGNATURE-----