/[cmucl]/src/code/foreign-linkage.lisp
ViewVC logotype

Contents of /src/code/foreign-linkage.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.4 - (show annotations)
Tue Apr 20 17:57:44 2010 UTC (4 years ago) by rtoy
Branch: MAIN
CVS Tags: sparc-tramp-assem-base, release-20b-pre1, release-20b-pre2, sparc-tramp-assem-2010-07-19, GIT-CONVERSION, cross-sol-x86-merged, RELEASE_20b, cross-sol-x86-base, snapshot-2010-12, snapshot-2010-11, snapshot-2011-09, snapshot-2011-06, snapshot-2011-07, snapshot-2011-04, snapshot-2011-02, snapshot-2011-03, snapshot-2011-01, snapshot-2010-05, snapshot-2010-07, snapshot-2010-06, snapshot-2010-08, cross-sol-x86-2010-12-20, cross-sparc-branch-base, HEAD
Branch point for: cross-sparc-branch, RELEASE-20B-BRANCH, sparc-tramp-assem-branch, cross-sol-x86-branch
Changes since 1.3: +1 -1 lines
Change uses of _"foo" to (intl:gettext "foo").  This is because slime
may get confused with source locations if the reader macros are
installed.
1 (in-package "LISP")
2
3 (intl:textdomain "cmucl")
4
5 (sys:register-lisp-runtime-feature :linkage-table)
6
7 ;;; This gets created by genesis and lives in the static area.
8 (defvar *linkage-table-data*)
9
10 ;;; Key is symbol name, value is index into *linkage-table-data*
11 (defvar *foreign-linkage-symbols* (make-hash-table :test #'equal))
12
13 ;;; Very unlispy layout of the *linkage-table-data*:
14 ;;; symbol name
15 ;;; type - a fixnum, 1 = code, 2 = data
16 ;;; library list - the library list at the time the symbol is registered.
17
18 (defconstant +linkage-data-entry-size+ 3)
19
20 (defun add-linkage-data (symbol-name type table loaded-libs)
21 (let ((sym-type (ecase type
22 (:code 1)
23 (:data 2)))
24 (entry-num (/ (fill-pointer table) +linkage-data-entry-size+)))
25 (vector-push-extend symbol-name table)
26 (vector-push-extend sym-type table)
27 (vector-push-extend loaded-libs table)
28 entry-num))
29
30 (defun foreign-linkage-entry (entry-num)
31 (let ((index (* entry-num +linkage-data-entry-size+)))
32 (values (aref *linkage-table-data* index)
33 (ecase (aref *linkage-table-data* (1+ index))
34 (1 :code)
35 (2 :data))
36 (aref *linkage-table-data* (+ index 2)))))
37
38 (defun foreign-linkage-symbols ()
39 (/ (length *linkage-table-data*) +linkage-data-entry-size+))
40
41 (defun add-foreign-linkage (symbol-name type table linkage-hash
42 make-linkage-stub-p)
43 (let ((entry-num (add-linkage-data symbol-name
44 type
45 table
46 (if make-linkage-stub-p
47 system::*global-table*
48 nil))))
49 (when make-linkage-stub-p
50 #-building-cross-compiler
51 (let ((result (alien:alien-funcall (alien:extern-alien
52 "os_link_one_symbol"
53 (alien:function c-call:int
54 c-call:long))
55 entry-num)))
56 (when (zerop result)
57 (error (intl:gettext "~A is not defined as a foreign symbol")
58 symbol-name))))
59 (setf (gethash symbol-name linkage-hash) entry-num)
60 entry-num))
61
62 ;;; Add a foreign linkage entry if none exists.
63 ;;;
64 ;;; If a linkage table is passed in it's assumed this is genesis and
65 ;;; we don't want to make an actual stub or entry in the table space.
66 (defun register-foreign-linkage (symbol-name type
67 &optional
68 (table *linkage-table-data* tablep)
69 (linkage-hash *foreign-linkage-symbols*))
70 (let ((entry-num (gethash symbol-name linkage-hash)))
71 (if entry-num
72 entry-num
73 (add-foreign-linkage symbol-name
74 type table
75 linkage-hash
76 (not tablep)))))
77
78 ;;; At world build time, build the linkage hash table
79
80 (defun foreign-linkage-init ()
81 ;; Sigh, would like to use LENGTH instead of FILL-POINTER but it's
82 ;; not generic enough during the init process!
83 ;; XXX I'm not sure that comment is true...
84 (loop for i from 0 below (/ (fill-pointer *linkage-table-data*)
85 +linkage-data-entry-size+)
86 do (setf (gethash (aref *linkage-table-data*
87 (* i +linkage-data-entry-size+))
88 *foreign-linkage-symbols*)
89 i)))

  ViewVC Help
Powered by ViewVC 1.1.5