Changeset 818

Timestamp:

May 8, 2004, 1:20:38 PM (21 years ago)

Author:

Gary Byers

Message:

Use #?. Find cfstrings in const section, too.

File:

• trunk/ccl/examples/objc-runtime.lisp (modified) (6 diffs)

trunk/ccl/examples/objc-runtime.lisp

@@ -278 +278 @@
     (let* ((image-count (#_ _dyld_image_count)))
       (when (> image-count (car cfstring-sections))
+        (flet ((func (sectaddr size)
+                 (let* ((addr (%ptr-to-int sectaddr))
+                        (limit (+ addr size))
+                        (already (member addr (cdr cfstring-sections) :key #'car)))
+                   (if already
+                     (rplacd already limit)
+                     (push (cons addr limit) (cdr cfstring-sections))))))
         (process-section-in-all-libraries
          #$SEG_DATA
-         "__cfstring"
-         #'(lambda (sectaddr size)
-             (let* ((addr (%ptr-to-int sectaddr))
-                    (limit (+ addr size))
-                    (already (member addr (cdr cfstring-sections) :key #'car)))
-               (if already
-                 (rplacd already limit)
-                 (push (cons addr limit) (cdr cfstring-sections))))))
-        (setf (car cfstring-sections) image-count))))
+         "__const"
+         #'func)
+        (process-section-in-all-libraries
+         #$SEG_DATA
+         "__cfstr"
+         #'func)))
+        (setf (car cfstring-sections) image-count)))
   (defun pointer-in-cfstring-section-p (ptr)
     (let* ((addr (%ptr-to-int ptr)))
@@ -294 +299 @@
         (when (and (>= addr (car s))
                    (< addr (cdr s)))
-          (return t))))))
+          (return t)))))
+  (defun cfstring-sections ()
+    (cdr cfstring-sections)))
                
                                           
@@ -348 +355 @@
 
 (defun get-appkit-version ()
-  (%get-double-float (foreign-symbol-address #+apple-objc "_NSAppKitVersionNumber" #+gnu-objc "NSAppKitVersionNumber")))
+  #+apple-objc
+  #?NSAppKitVersionNumber
+  #+gnu-objc
+  (get-foundation-version))
 
 (defun get-foundation-version ()
-  (%get-double-float (foreign-symbol-address #+apple-objc "_NSFoundationVersionNumber" #+gnu-objc "NSFoundationVersionNumber")))
+  #?NSFoundationVersionNumber
+  #+gnu-objc (%get-cstring (foreign-symbol-address "gnustep_base_version")))
 
 (defparameter *appkit-library-version-number* (get-appkit-version))
@@ -1565 +1576 @@
 (progn
 (defloadvar *original-deallocate-hook*
-    (%get-ptr (foreign-symbol-address "__dealloc")))
+        #?_dealloc)
 
 (defcallback deallocate-nsobject (:address obj :int)
@@ -1573 +1584 @@
 
 (defun install-lisp-deallocate-hook ()
-  (setf (%get-ptr (foreign-symbol-address "__dealloc")) deallocate-nsobject))
+  (setf #?_dealloc deallocate-nsobject))
 
 #+later
@@ -1581 +1592 @@
 (defun uninstall-lisp-deallocate-hook ()
   (clrhash *objc-object-slot-vectors*)
-  (setf (%get-ptr (foreign-symbol-address "__dealloc")) *original-deallocate-hook*))
+  (setf #?_dealloc *original-deallocate-hook*))
 
 (pushnew #'uninstall-lisp-deallocate-hook *save-exit-functions* :test #'eq