/[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.3 - (hide annotations)
Fri Mar 19 15:18:59 2010 UTC (4 years ago) by rtoy
Branch: MAIN
CVS Tags: post-merge-intl-branch, snapshot-2010-04
Changes since 1.2: +3 -1 lines
Merge intl-branch 2010-03-18 to HEAD.  To build, you need to use
boot-2010-02-1 as the bootstrap file.  You should probably also use
the new -P option for build.sh to generate and update the po files
while building.
1 moore 1.1 (in-package "LISP")
2    
3 rtoy 1.3 (intl:textdomain "cmucl")
4    
5 toy 1.2 (sys:register-lisp-runtime-feature :linkage-table)
6    
7 moore 1.1 ;;; 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 rtoy 1.3 (error _"~A is not defined as a foreign symbol"
58 moore 1.1 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