source: trunk/source/compiler/X86/X8632/x8632-backend.lisp @ 11326

Last change on this file since 11326 was 11326, checked in by gb, 12 years ago

FreeBSD x8632 changes.

File size: 13.1 KB
Line 
1;;;-*- Mode: Lisp; Package: CCL -*-
2
3(in-package "CCL")
4(eval-when (:compile-toplevel :load-toplevel :execute)
5  (require "BACKEND"))
6
7(eval-when (:compile-toplevel :execute)
8  (require "NXENV")
9  (require "X8632ENV"))
10
11(defvar *x8632-vinsn-templates* (make-hash-table :test #'eq))
12
13(defvar *known-x8632-backends* ())
14
15#+darwinx86-target
16(defvar *darwinx8632-backend*
17  (make-backend :lookup-opcode 'lookup-x86-opcode
18                :lookup-macro #'false
19                :lap-opcodes x86::*x86-opcode-templates*
20                :define-vinsn 'define-x86-vinsn
21                :p2-dispatch *x862-specials*
22                :p2-vinsn-templates *x8632-vinsn-templates*
23                :p2-template-hash-name '*x8632-vinsn-templates*
24                :p2-compile 'x862-compile
25                :platform-syscall-mask (logior platform-os-darwin platform-cpu-x86 platform-word-size-32) 
26                :target-specific-features
27                '(:x8632 :x86-target :darwin-target :darwinx86-target :x8632-target
28                  :darwinx8632-target
29                  :little-endian-target
30                  :32-bit-target)
31                :target-fasl-pathname (make-pathname :type "dx32fsl")
32                :target-platform (logior platform-cpu-x86
33                                         platform-os-darwin
34                                         platform-word-size-32)
35                :target-os :darwinx86
36                :name :darwinx8632
37                :target-arch-name :x8632
38                :target-foreign-type-data nil
39                :target-arch x8632::*x8632-target-arch*
40                :lisp-context-register x8632::fs
41                :num-arg-regs 2
42                ))
43
44
45#+darwinx86-target
46(pushnew *darwinx8632-backend* *known-x8632-backends* :key #'backend-name)
47
48#+linuxx86-target
49(defvar *linuxx8632-backend*
50  (make-backend :lookup-opcode 'lookup-x86-opcode
51                :lookup-macro #'false
52                :lap-opcodes x86::*x86-opcode-templates*
53                :define-vinsn 'define-x86-vinsn
54                :p2-dispatch *x862-specials*
55                :p2-vinsn-templates *x8632-vinsn-templates*
56                :p2-template-hash-name '*x8632-vinsn-templates*
57                :p2-compile 'x862-compile
58                :platform-syscall-mask (logior platform-os-linux platform-cpu-x86 platform-word-size-32) 
59                :target-specific-features
60                '(:x8632 :x86-target :linux-target :linuxx86-target :x8632-target
61                  :linuxx8632-target
62                  :little-endian-target
63                  :32-bit-target)
64                :target-fasl-pathname (make-pathname :type "lx32fsl")
65                :target-platform (logior platform-cpu-x86
66                                         platform-os-linux
67                                         platform-word-size-32)
68                :target-os :linuxx86
69                :name :linuxx8632
70                :target-arch-name :x8632
71                :target-foreign-type-data nil
72                :target-arch x8632::*x8632-target-arch*
73                :lisp-context-register x8632::fs
74                :num-arg-regs 2
75                ))
76
77#+linuxx86-target
78(pushnew *linuxx8632-backend* *known-x8632-backends* :key #'backend-name)
79
80#+windows-target
81(defvar *win32-backend*
82  (make-backend :lookup-opcode 'lookup-x86-opcode
83                :lookup-macro #'false
84                :lap-opcodes x86::*x86-opcode-templates*
85                :define-vinsn 'define-x86-vinsn
86                :p2-dispatch *x862-specials*
87                :p2-vinsn-templates *x8632-vinsn-templates*
88                :p2-template-hash-name '*x8632-vinsn-templates*
89                :p2-compile 'x862-compile
90                :platform-syscall-mask (logior platform-os-windows platform-cpu-x86 platform-word-size-32) 
91                :target-specific-features
92                '(:x8632 :x86-target :windows-target :win32-target :x8632-target
93                  :windowsx8632-target
94                  :little-endian-target
95                  :32-bit-target)
96                :target-fasl-pathname (make-pathname :type "wx32fsl")
97                :target-platform (logior platform-cpu-x86
98                                         platform-os-windows
99                                         platform-word-size-32)
100                :target-os :win32
101                :name :win32
102                :target-arch-name :x8632
103                :target-foreign-type-data nil
104                :target-arch x8632::*x8632-target-arch*
105                :lisp-context-register x8632::es
106                :num-arg-regs 2
107                ))
108
109#+windows-target
110(pushnew *win32-backend* *known-x8632-backends* :key #'backend-name)
111
112#+solaris-target
113(defvar *solaris-x8632-backend*
114  (make-backend :lookup-opcode 'lookup-x86-opcode
115                :lookup-macro #'false
116                :lap-opcodes x86::*x86-opcode-templates*
117                :define-vinsn 'define-x86-vinsn
118                :p2-dispatch *x862-specials*
119                :p2-vinsn-templates *x8632-vinsn-templates*
120                :p2-template-hash-name '*x8632-vinsn-templates*
121                :p2-compile 'x862-compile
122                :platform-syscall-mask (logior platform-os-solaris platform-cpu-x86 platform-word-size-32) 
123                :target-specific-features
124                '(:x8632 :x86-target :solaris-target :x8632-target
125                  :solarisx8632-target
126                  :little-endian-target
127                  :32-bit-target)
128                :target-fasl-pathname (make-pathname :type "sx32fsl")
129                :target-platform (logior platform-cpu-x86
130                                         platform-os-solaris
131                                         platform-word-size-32)
132                :target-os :solarisx8632
133                :name :solarisx8632
134                :target-arch-name :x8632
135                :target-foreign-type-data nil
136                :target-arch x8632::*x8632-target-arch*
137                :lisp-context-register x8632::fs
138                :num-arg-regs 2
139                ))
140#+solaris-target
141(pushnew *solaris-x8632-backend* *known-x8632-backends* :key #'backend-name)
142
143#+freebsd-target
144(defvar *freebsd-x8632-backend*
145  (make-backend :lookup-opcode 'lookup-x86-opcode
146                :lookup-macro #'false
147                :lap-opcodes x86::*x86-opcode-templates*
148                :define-vinsn 'define-x86-vinsn
149                :p2-dispatch *x862-specials*
150                :p2-vinsn-templates *x8632-vinsn-templates*
151                :p2-template-hash-name '*x8632-vinsn-templates*
152                :p2-compile 'x862-compile
153                :platform-syscall-mask (logior platform-os-freebsd platform-cpu-x86 platform-word-size-32) 
154                :target-specific-features
155                '(:x8632 :x86-target :freebsd-target :x8632-target
156                  :freebsdsx8632-target
157                  :little-endian-target
158                  :32-bit-target)
159                :target-fasl-pathname (make-pathname :type "fx32fsl")
160                :target-platform (logior platform-cpu-x86
161                                         platform-os-freebsd
162                                         platform-word-size-32)
163                :target-os :freebsdx8632
164                :name :freebsdx8632
165                :target-arch-name :x8632
166                :target-foreign-type-data nil
167                :target-arch x8632::*x8632-target-arch*
168                :lisp-context-register x8632::fs
169                :num-arg-regs 2
170                ))
171
172#+freebsd-target
173(pushnew *freebsd-x8632-backend* *known-x8632-backends* :key #'backend-name)
174
175(defvar *x8632-backend* (car *known-x8632-backends*))
176
177(defun fixup-x8632-backend ()
178  (dolist (b *known-x8632-backends*)
179    (setf #| (backend-lap-opcodes b) x86::*x86-opcodes* |#
180          (backend-p2-dispatch b) *x862-specials*
181          (backend-p2-vinsn-templates b)  *x8632-vinsn-templates*)
182    (or (backend-lap-macros b) (setf (backend-lap-macros b)
183                                     (make-hash-table :test #'equalp)))))
184
185
186(fixup-x8632-backend)
187
188#+x8632-target
189(setq *host-backend* *x8632-backend* *target-backend* *x8632-backend*)
190
191
192(defun setup-x8632-ftd (backend)
193  (or (backend-target-foreign-type-data backend)
194      (let* ((name (backend-name backend))
195             (ftd
196              (case name
197                (:darwinx8632
198                 (make-ftd :interface-db-directory "ccl:darwin-x86-headers;"
199                           :interface-package-name "X86-DARWIN32"
200                           :attributes '(:bits-per-word  32
201                                         :signed-char t
202                                         :struct-by-value t
203                                         :prepend-underscore t)
204                           :ff-call-expand-function
205                           (intern "EXPAND-FF-CALL" "X86-DARWIN32")
206                           :ff-call-struct-return-by-implicit-arg-function
207                           (intern "RECORD-TYPE-RETURNS-STRUCTURE-AS-FIRST-ARG"
208                                   "X86-DARWIN32")
209                           :callback-bindings-function
210                           (intern "GENERATE-CALLBACK-BINDINGS" "X86-DARWIN32")
211                           :callback-return-value-function
212                           (intern "GENERATE-CALLBACK-RETURN-VALUE" "X86-DARWIN32")))
213                (:linuxx8632
214                 (make-ftd :interface-db-directory "ccl:x86-headers;"
215                           :interface-package-name "X86-LINUX32"
216                           :attributes '(:bits-per-word  32
217                                         :signed-char nil
218                                         :struct-by-value t
219                                         :float-results-in-x87 t)
220                           :ff-call-expand-function
221                           (intern "EXPAND-FF-CALL" "X86-LINUX32")
222                           :ff-call-struct-return-by-implicit-arg-function
223                           (intern "RECORD-TYPE-RETURNS-STRUCTURE-AS-FIRST-ARG"
224                                   "X86-LINUX32")
225                           :callback-bindings-function
226                           (intern "GENERATE-CALLBACK-BINDINGS" "X86-LINUX32")
227                           :callback-return-value-function
228                           (intern "GENERATE-CALLBACK-RETURN-VALUE" "X86-LINUX32")))
229                (:win32
230                 (make-ftd :interface-db-directory "ccl:win32-headers;"
231                           :interface-package-name "WIN32"
232                           :attributes '(:bits-per-word  32
233                                         :signed-char nil
234                                         :struct-by-value t
235                                         :float-results-in-x87 t)
236                           :ff-call-expand-function
237                           (intern "EXPAND-FF-CALL" "WIN32")
238                           :ff-call-struct-return-by-implicit-arg-function
239                           (intern "RECORD-TYPE-RETURNS-STRUCTURE-AS-FIRST-ARG"
240                                   "WIN32")
241                           :callback-bindings-function
242                           (intern "GENERATE-CALLBACK-BINDINGS" "WIN32")
243                           :callback-return-value-function
244                           (intern "GENERATE-CALLBACK-RETURN-VALUE" "WIN32")))
245                (:solarisx8632
246                 (make-ftd :interface-db-directory "ccl:solarisx86-headers;"
247                           :interface-package-name "X86-SOLARIS32"
248                           :attributes '(:bits-per-word  32
249                                         :signed-char nil
250                                         :struct-by-value t
251                                         :float-results-in-x87 t)
252                           :ff-call-expand-function
253                           (intern "EXPAND-FF-CALL" "X86-SOLARIS32")
254                           :ff-call-struct-return-by-implicit-arg-function
255                           (intern "RECORD-TYPE-RETURNS-STRUCTURE-AS-FIRST-ARG"
256                                   "X86-SOLARIS32")
257                           :callback-bindings-function
258                           (intern "GENERATE-CALLBACK-BINDINGS" "X86-SOLARIS32")
259                           :callback-return-value-function
260                           (intern "GENERATE-CALLBACK-RETURN-VALUE" "X86-SOLARIS32")))
261                (:freebsdx8632
262                 (make-ftd :interface-db-directory "ccl:freebsd-headers;"
263                           :interface-package-name "X86-FREEBSD32"
264                           :attributes '(:bits-per-word  32
265                                         :signed-char nil
266                                         :struct-by-value t
267                                         :float-results-in-x87 t)
268                           :ff-call-expand-function
269                           (intern "EXPAND-FF-CALL" "X86-FREEBSD32")
270                           :ff-call-struct-return-by-implicit-arg-function
271                           (intern "RECORD-TYPE-RETURNS-STRUCTURE-AS-FIRST-ARG"
272                                   "X86-FREEBSD32")
273                           :callback-bindings-function
274                           (intern "GENERATE-CALLBACK-BINDINGS" "X86-FREEBSD32")
275                           :callback-return-value-function
276                           (intern "GENERATE-CALLBACK-RETURN-VALUE" "X86-FREEBSD32")))
277                )))
278        (install-standard-foreign-types ftd)
279        (use-interface-dir :libc ftd)
280        (setf (backend-target-foreign-type-data backend) ftd))))
281
282#-x8632-target
283(setup-x8632-ftd *x8632-backend*)
284
285(pushnew *x8632-backend* *known-backends* :key #'backend-name)
286
287#+x8632-target
288(require "X8632-VINSNS")
289
290(provide "X8632-BACKEND")
291
Note: See TracBrowser for help on using the repository browser.