[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-----