source: branches/ia32/compiler/X86/X8632/x8632-backend.lisp @ 7357

Last change on this file since 7357 was 7357, checked in by rme, 13 years ago

Don't use "32" suffix on cross-compiling interface-db-directory names.

File size: 3.8 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;;#+darwinx86-target
45(pushnew *darwinx8632-backend* *known-x8632-backends* :key #'backend-name)
46
47(defvar *x8632-backend* (car *known-x8632-backends*))
48
49(defun fixup-x8632-backend ()
50  (dolist (b *known-x8632-backends*)
51    (setf #| (backend-lap-opcodes b) x86::*x86-opcodes* |#
52          (backend-p2-dispatch b) *x862-specials*
53          (backend-p2-vinsn-templates b)  *x8632-vinsn-templates*)
54    (or (backend-lap-macros b) (setf (backend-lap-macros b)
55                                     (make-hash-table :test #'equalp)))))
56
57
58(fixup-x8632-backend)
59
60#+x8632-target
61(setq *host-backend* *x8632-backend* *target-backend* *x8632-backend*)
62
63
64(defun setup-x8632-ftd (backend)
65  (or (backend-target-foreign-type-data backend)
66      (let* ((name (backend-name backend))
67             (ftd
68              (case name
69                (:darwinx8632
70                 (make-ftd :interface-db-directory
71                           (if (eq backend *host-backend*)
72                             "ccl:darwin-x86-headers;"
73                             "ccl:cross-darwin-x86-headers;")
74                           :interface-package-name "X86-DARWIN32"
75                           :attributes '(:bits-per-word  32
76                                         :signed-char t
77                                         :struct-by-value t
78                                         :prepend-underscore t)
79                           :ff-call-expand-function
80                           (intern "EXPAND-FF-CALL" "X86-DARWIN32")
81                           :ff-call-struct-return-by-implicit-arg-function
82                           (intern "RECORD-TYPE-RETURNS-STRUCTURE-AS-FIRST-ARG"
83                                   "X86-DARWIN32")
84                           :callback-bindings-function
85                           (intern "GENERATE-CALLBACK-BINDINGS" "X86-DARWIN32")
86                           :callback-return-value-function
87                           (intern "GENERATE-CALLBACK-RETURN-VALUE" "X86-DARWIN32"))))))
88        (install-standard-foreign-types ftd)
89        (use-interface-dir :libc ftd)
90        (setf (backend-target-foreign-type-data backend) ftd))))
91
92#-x8632-target
93(setup-x8632-ftd *x8632-backend*)
94
95(pushnew *x8632-backend* *known-backends* :key #'backend-name)
96
97(provide "X8632-BACKEND")
Note: See TracBrowser for help on using the repository browser.