source: trunk/source/xdump/xarmfasload.lisp @ 14170

Last change on this file since 14170 was 14170, checked in by gb, 9 years ago

Darwin/ARM changes.

File size: 4.3 KB
Line 
1;;;-*- Mode: Lisp; Package: CCL -*-
2;;;
3;;;   Portions copyright (C) 2010 Clozure Associates
4;;;   This file is part of Clozure CL. 
5;;;
6;;;   Clozure CL is licensed under the terms of the Lisp Lesser GNU Public
7;;;   License , known as the LLGPL and distributed with Clozure CL as the
8;;;   file "LICENSE".  The LLGPL consists of a preamble and the LGPL,
9;;;   which is distributed with Clozure CL as the file "LGPL".  Where these
10;;;   conflict, the preamble takes precedence. 
11;;;
12;;;   Clozure CL is referenced in the preamble as the "LIBRARY."
13;;;
14;;;   The LLGPL is also available online at
15;;;   http://opensource.franz.com/preamble.html
16
17(in-package "CCL")
18
19(eval-when (:compile-toplevel :execute)
20  (require "FASLENV" "ccl:xdump;faslenv")
21  (require "ARM-LAP"))
22
23(eval-when (:compile-toplevel :load-toplevel :execute)
24  (require "XFASLOAD" "ccl:xdump;xfasload"))
25
26
27(defun xload-arm-lap-word (instruction-form)
28  (if (listp instruction-form)
29    (uvref (uvref (compile nil
30                           `(lambda (&lap 0)
31                             (arm-lap-function () ((?? 0))
32                              ,instruction-form)))
33                  1)
34           0)
35    instruction-form))
36
37(defparameter *arm-macro-apply-code*
38  (let* ((code-vector (uvref (compile nil
39          '(lambda (&lap 0)
40            (arm-lap-function () ()
41             (build-lisp-frame imm0)
42             (bla .SPheap-rest-arg)
43             (vpop1 arg_z)
44             (mov arg_y fname)
45             (mov arg_x '#.$xnotfun)
46             (set-nargs 3)
47             (ba .SPksignalerr))))
48                             1))
49         (n (uvsize code-vector))
50         (u32-vector (make-array n
51                                 :element-type '(unsigned-byte 32))))
52    (declare (fixnum n))
53    (dotimes (i n u32-vector)
54      (setf (uvref u32-vector i)
55            (uvref code-vector i)))))
56
57
58(defun arm-fixup-macro-apply-code ()
59  *arm-macro-apply-code*)
60
61
62(defparameter *arm-closure-trampoline-code*
63  (let* ((code0 (xload-arm-lap-word '(ldr pc (:@ pc (:$ 4))))))
64    (make-array 4
65                :element-type '(unsigned-byte 32)
66                :initial-contents
67                (list code0 0 3 (arm::arm-subprimitive-address '.SPcall-closure)))))
68
69
70;;; For now, do this with a UUO so that the kernel can catch it.
71(defparameter *arm-udf-code*
72  (let* ((code '((uuo-error-udf-call (:? al) fname))))
73    (make-array (length code)
74                :element-type '(unsigned-byte 32)
75                :initial-contents
76                (mapcar #'xload-arm-lap-word code))))
77
78
79(defun arm-initialize-static-space ()
80  (xload-make-word-ivector arm::subtag-u32-vector 1021 *xload-static-space*)
81  ;; Make NIL.  Note that NIL is sort of a misaligned cons (it
82  ;; straddles two doublewords.)
83  (xload-make-cons *xload-target-nil* 0 *xload-static-space*)
84  (xload-make-cons 0 *xload-target-nil* *xload-static-space*))
85
86
87
88(defparameter *linuxarm-xload-backend*
89  (make-backend-xload-info
90   :name :linuxarm
91   :macro-apply-code-function 'arm-fixup-macro-apply-code
92   :closure-trampoline-code *arm-closure-trampoline-code*
93   :udf-code *arm-udf-code*
94   :default-image-name "ccl:ccl;arm-boot"
95   :default-startup-file-name "level-1.lafsl"
96   :subdirs '("ccl:level-0;ARM;")
97   :compiler-target-name :linuxarm
98   :image-base-address #x50000000
99   :nil-relative-symbols arm::*arm-nil-relative-symbols*
100   :static-space-init-function 'arm-initialize-static-space
101   :purespace-reserve (ash 64 20)
102   :static-space-address (- (- arm::nil-value arm::fulltag-nil) (ash 1 12))
103))
104
105(add-xload-backend *linuxarm-xload-backend*)
106
107(defparameter *darwinarm-xload-backend*
108  (make-backend-xload-info
109   :name :darwinarm
110   :macro-apply-code-function 'arm-fixup-macro-apply-code
111   :closure-trampoline-code *arm-closure-trampoline-code*
112   :udf-code *arm-udf-code*
113   :default-image-name "ccl:ccl;arm-boot.image"
114   :default-startup-file-name "level-1.dafsl"
115   :subdirs '("ccl:level-0;ARM;")
116   :compiler-target-name :darwinarm
117   :image-base-address (+ (- arm::nil-value arm::fulltag-nil) (ash 1 12))
118   :nil-relative-symbols arm::*arm-nil-relative-symbols*
119   :static-space-init-function 'arm-initialize-static-space
120   :purespace-reserve (ash 64 20)
121   :static-space-address (- (- arm::nil-value arm::fulltag-nil) (ash 1 12))
122))
123
124(add-xload-backend *darwinarm-xload-backend*)
125
126
127
128
129#+linuxarm-target
130(progn
131(setq *xload-default-backend* *linuxarm-xload-backend*)
132)
133
134
135
136
137
138
Note: See TracBrowser for help on using the repository browser.