-(defun init-type (init)
- (mapc
- #'(lambda (fname)
- (funcall (mkbinding fname 'type-number)))
- (mklist init)))
-
-(defun %init-types-in-library (pathname prefix ignore)
- (let ((process (ext:run-program
- "nm" (list "-D" (namestring (truename pathname)))
- :output :stream :wait nil))
- (fnames ()))
- (labels ((read-symbols ()
- (let ((line (read-line (ext:process-output process) nil)))
- (when line
- (let ((symbol (subseq line 11)))
- (when (and
- (> (length symbol) (length prefix))
- (string= prefix symbol :end2 (length prefix))
- (search "_get_type" symbol)
- (not (member symbol ignore :test #'string=)))
- (push symbol fnames)))
- (read-symbols)))))
- (read-symbols)
- (ext:process-close process)
- `(init-type ',fnames))))
-
-(defmacro init-types-in-library (filename &key (prefix "") ignore)
- (%init-types-in-library filename prefix ignore))
-
-
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (defvar *type-initializers* ())
+ (defun %find-types-in-library (pathname prefixes ignore)
+ (let ((process
+ (run-program
+ "/usr/bin/nm"
+ #+clisp :arguments
+ (list #-darwin"--defined-only" #-darwin"-D" "-g" #+darwin"-f"
+ #+darwin"-s" #+darwin"__TEXT" #+darwin"__text"
+ (namestring (truename pathname)))
+ :output :stream :wait nil)))
+ (unwind-protect
+ (loop
+ as line = (read-line
+ #+(or cmu sbcl) (process-output process)
+ #+clisp process
+ nil)
+ as symbol = (when line
+ (let ((pos (position #\Space line :from-end t)))
+ #-darwin(subseq line (1+ pos))
+ #+darwin
+ (when (char= (char line (1- pos)) #\T)
+ (subseq line (+ pos 2)))))
+ while line
+ when (and
+ symbol (> (length symbol) 9)
+ (not (char= (char symbol 0) #\_))
+ (or
+ (not prefixes)
+ (some #'(lambda (prefix)
+ (and
+ (> (length symbol) (length prefix))
+ (string= prefix symbol :end2 (length prefix))))
+ (mklist prefixes)))
+ (string= "_get_type" symbol :start2 (- (length symbol) 9))
+ (not (member symbol ignore :test #'string=)))
+ collect symbol)
+ (#+(or cmu sbcl)process-close
+ #+clisp close
+ process)))))
+
+
+(defmacro init-types-in-library (filename &key prefix ignore)
+ (let ((names (%find-types-in-library filename prefix ignore)))
+ `(progn
+ ,@(mapcar #'(lambda (name)
+ `(progn
+ (defbinding (,(intern name) ,name) () type-number)
+ (,(intern name))
+ (pushnew ',(intern name) *type-initializers*)))
+ names))))
+
+(defun find-type-init-function (type-number)
+ (loop
+ for type-init in *type-initializers*
+ when (= type-number (funcall type-init))
+ do (return type-init)))
+
+(defun register-type-as (type-number)
+ (or
+ (find-type-init-function type-number)
+ (find-foreign-type-name type-number)
+ (error "Unknown type-number: ~A" type-number)))
+
+(defun default-type-init-name (type)
+ (find-symbol (format nil "~A_~A_get_type"
+ (package-prefix *package*)
+ (substitute #\_ #\- (string-downcase type)))))