;;;; Linkage table specifics

;;;; This software is part of the SBCL system. See the README file for
;;;; more information.
;;;;
;;;; This software is derived from the CMU CL system, which was
;;;; written at Carnegie Mellon University and released into the
;;;; public domain. The software is in the public domain and is
;;;; provided with absolutely no warranty. See the COPYING and CREDITS
;;;; files for more information.

;;;; Linkage table itself is a mmapped memory area in C-land, which is
;;;; initialized by INIT-LINKAGE-TABLE once all shared objects have
;;;; been reopened, based on the information stored in *LINKAGE-INFO*.
;;;;
;;;; For data entries the linkage table holds the real address
;;;; of the foreign symbol, and for code the entries are jumps
;;;; to the real addresses.

(in-package "SB!IMPL")

;;; Used to serialize modifications to *linkage-info* and the linkage-table
;;; proper. Calls thru linkage-table are unaffected.
(defvar *linkage-table-lock*
  (sb!thread:make-mutex :name "linkage-table lock"))

(define-alien-routine arch-write-linkage-table-jmp void
  (table-address system-area-pointer)
  (real-address system-area-pointer))

(define-alien-routine arch-write-linkage-table-ref void
  (table-address system-area-pointer)
  (real-address system-area-pointer))

(defvar *linkage-info* (make-hash-table :test 'equal))

(defstruct linkage-info datap address)

(defun write-linkage-table-entry (table-address real-address datap)
  (/show0 "write-linkage-table-entry")
  (let ((reloc (int-sap table-address))
	(target (int-sap real-address)))
    (if datap
	(arch-write-linkage-table-ref reloc target)
	(arch-write-linkage-table-jmp reloc target))))

;;; Add the linkage information about a foreign symbol in the
;;; persistent table, and write the linkage-table entry.
(defun link-foreign-symbol (name datap)
  (/show0 "link-foreign-symbol")
  (let ((table-address (+ (* (hash-table-count *linkage-info*)
			     sb!vm:linkage-table-entry-size)
			  sb!vm:linkage-table-space-start))
	(real-address (get-dynamic-foreign-symbol-address name)))
    (when real-address
      (unless (< table-address sb!vm:linkage-table-space-end)
	(error "Linkage-table full (~D entries): cannot link ~S."
	       (hash-table-count *linkage-info*)
	       name))
      (write-linkage-table-entry table-address real-address datap)
      (setf (gethash name *linkage-info*)
	    (make-linkage-info :address table-address :datap datap)))))

;;; Add a foreign linkage entry if none exists, return the address
;;; in the linkage table.
(defun ensure-foreign-symbol-linkage (name datap)
  (/show0 "ensure-foreign-symbol-linkage")
  (sb!thread:with-mutex (*linkage-table-lock*)
    (let ((info (or (gethash name *linkage-info*)
                    (link-foreign-symbol name datap))))
      (when info
        (linkage-info-address info)))))

;;; Initialize the linkage-table. Called during initialization after
;;; all shared libraries have been reopened.
(defun linkage-table-reinit ()
  (/show0 "linkage-table-reinit")
  ;; No locking here, as this should be done just once per image initialization,
  ;; before any threads user are spawned.
  (maphash (lambda (name info)
	     (let ((datap (linkage-info-datap info))
		   (table-address (linkage-info-address info))
		   (real-address (get-dynamic-foreign-symbol-address name)))
	       (cond (real-address
                      (write-linkage-table-entry table-address
                                                 real-address
                                                 datap))
                     (t
                      (/show0 "oops")
                      (cerror "Ignore. Attempts to access this foreign symbol ~
                               will lead to badness characterized by ~
                               segfaults, and potential corruption."
                              "Could not resolve foreign function ~S for ~
                               linkage-table." name)))))
	   *linkage-info*))