summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Lisp/constant-data.lisp39
-rw-r--r--Lisp/data-types.lisp8
-rw-r--r--Lisp/libobjcl.lisp55
-rw-r--r--Lisp/method-invocation.lisp10
4 files changed, 1 insertions, 111 deletions
diff --git a/Lisp/constant-data.lisp b/Lisp/constant-data.lisp
index 7922c4f..7d973b7 100644
--- a/Lisp/constant-data.lisp
+++ b/Lisp/constant-data.lisp
@@ -55,28 +55,6 @@
(complex . #\j)))
-(defparameter *objcl-data-map*
- '((id . id-val)
- (class . class-val)
- (exc . exc-val)
- (sel . sel-val)
- (chr . char-val)
- (uchr . char-val)
- (sht . short-val)
- (usht . short-val)
- (int . int-val)
- (uint . int-val)
- (lng . long-val)
- (ulng . long-val)
- (lng-lng . long-long-val)
- (ulng-lng . long-long-val)
- (flt . float-val)
- (dbl . double-val)
- (bool . bool-val)
- (ptr . ptr-val)
- (charptr . charptr-val)))
-
-
(defparameter *objcl-type-map*
'((id . id)
(class . objc-class)
@@ -97,6 +75,7 @@
(ptr . c-pointer)
(charptr . string)))
+
(defparameter *objcl-c-type-map*
'((id . :pointer)
(class . :pointer)
@@ -125,26 +104,10 @@
(typep value type))
*objcl-type-map*)))
-(declaim (ftype (function (symbol) symbol) lisp-type->type-name))
-(defun lisp-type->type-name (lisp-type)
- (cdr (rassoc lisp-type *objcl-type-map*)))
-
-(declaim (ftype (function (symbol) symbol) type-name->lisp-type))
-(defun type-name->lisp-type (type-name)
- (cdr (assoc type-name *objcl-type-map*)))
-
-(declaim (ftype (function (symbol) symbol) type-name->slot-name))
-(defun type-name->slot-name (type-name)
- (cdr (assoc type-name *objcl-data-map*)))
-
(declaim (ftype (function (symbol) string) type-name->type-id))
(defun type-name->type-id (type-name)
(string (cdr (assoc type-name *objcl-api-type-names*))))
-(declaim (ftype (function (string) symbol) type-id->type-name))
-(defun type-id->type-name (type-id)
- (car (rassoc (char type-id 0) *objcl-api-type-names*)))
-
(declaim (ftype (function (symbol) symbol) type-name->c-type))
(defun type-name->c-type (type-name)
(cdr (assoc type-name *objcl-c-type-map*)))
diff --git a/Lisp/data-types.lisp b/Lisp/data-types.lisp
index 7515d3a..11ac9fe 100644
--- a/Lisp/data-types.lisp
+++ b/Lisp/data-types.lisp
@@ -188,11 +188,3 @@ an __exception__, you can simply send it the `self' message.
(pointer-eq (pointer-to obj1) (pointer-to obj2)))
(defmethod objcl-eql (obj1 obj2)
(eql obj1 obj2))
-
-
-(defun dealloc-obj-data (obj-data)
- (with-foreign-slots ((type data) obj-data obj-data)
- (when (and (pointerp type)
- (not (null-pointer-p type)))
- (foreign-string-free type)))
- (foreign-free obj-data))
diff --git a/Lisp/libobjcl.lisp b/Lisp/libobjcl.lisp
index 33bc460..aa9c436 100644
--- a/Lisp/libobjcl.lisp
+++ b/Lisp/libobjcl.lisp
@@ -374,61 +374,6 @@ If *selector-designator* is a __selector__, it is simply returned.
designator)))))
-(declaim (ftype (function (*)
- (values foreign-pointer &rest nil))
- lisp->obj-data))
-(defun lisp->obj-data (value)
- (let ((obj-data (foreign-alloc 'obj-data))
- (type-name (lisp-value->type-name value)))
- (with-foreign-slots ((type data) obj-data obj-data)
- (setf (foreign-slot-value data
- 'obj-data-union
- (type-name->slot-name type-name))
- (typecase value
- (symbol (selector value))
- ((or id objc-class selector exception)
- (pointer-to value))
- (string (foreign-string-alloc value))
- (otherwise value)))
- (setf type
- (foreign-string-alloc (type-name->type-id type-name))))
- obj-data))
-
-
-(declaim (ftype (function (foreign-pointer)
- (values (or number string symbol selector id
- objc-class boolean foreign-pointer)
- &rest nil))
- obj-data->lisp))
-(defun obj-data->lisp (obj-data)
- (with-foreign-slots ((type data) obj-data obj-data)
- (let* ((type-name (type-id->type-name (if (stringp type)
- type
- (foreign-string-to-lisp type))))
- (lisp-type (type-name->lisp-type type-name))
- (value (if (eq 'void type-name)
- (values)
- (foreign-slot-value data
- 'obj-data-union
- (type-name->slot-name type-name)))))
- (case lisp-type
- ((id objc-class selector exception)
- (make-instance lisp-type :pointer value) )
- ((string) (foreign-string-to-lisp value))
- (otherwise value)))))
-
-
-(declaim (ftype (function (foreign-pointer) (values string &rest nil))
- foreign-string-to-lisp/dealloc))
-(defun foreign-string-to-lisp/dealloc (foreign-string)
- "Convert a (possibly freshly allocated) C string into a Lisp string
-and free the C string afterwards."
-
- (unwind-protect
- (foreign-string-to-lisp foreign-string)
- (foreign-string-free foreign-string)))
-
-
(defun parse-typespec (typestring &optional (start 0))
"Parse a typestring like \"@0:4{_NSRange=II}8\" into something like (ID ()).
diff --git a/Lisp/method-invocation.lisp b/Lisp/method-invocation.lisp
index a2a21f2..94f1bb2 100644
--- a/Lisp/method-invocation.lisp
+++ b/Lisp/method-invocation.lisp
@@ -470,10 +470,6 @@ Returns: *result* --- the return value of the method invocation.
;;; (@* "Helper functions")
-(defun arglist->objc-arglist (arglist)
- (arglist-intersperse-types (mapcar #'lisp->obj-data arglist)))
-
-
(defun dealloc-objc-arglist (objc-arglist)
(do ((objc-arglist objc-arglist (cddr objc-arglist)))
((null objc-arglist))
@@ -481,12 +477,6 @@ Returns: *result* --- the return value of the method invocation.
(dealloc-obj-data (second objc-arglist))))
-(defun arglist-intersperse-types (arglist)
- (mapcan #'(lambda (arg)
- (list :pointer arg))
- arglist))
-
-
(defun constructor-name-p (method-name)
(flet ((method-name-starts-with (prefix)
(and (>= (length method-name) (length prefix))