source: branches/arm/xdump/xarmfasload.lisp @ 13789

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

Lots of (mostly small) changes.

File size: 3.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  (uvref (uvref (compile nil
29                         `(lambda (&lap 0)
30                           (arm-lap-function () ((?? 0))
31                            ,instruction-form)))
32                  1)
33         0))
34
35(defparameter *arm-macro-apply-code*
36  (let* ((code '((build-lisp-frame imm0)
37                 (bl .SPheap-rest-arg)
38                 (vpop1 arg_z)
39                 (mov arg_y fname)
40                 (mov arg_x '#.$xnotfun)
41                 (set-nargs 3)
42                 (ba .SPksignalerr))))
43    (make-array (length code)
44                :element-type '(unsigned-byte 32)
45                :initial-contents
46                (mapcar #'xload-arm-lap-word code))))
47
48
49(defun arm-fixup-macro-apply-code ()
50  *arm-macro-apply-code*)
51
52
53(defparameter *arm-closure-trampoline-code*
54  (let* ((code '((ba .SPcall-closure))))
55    (make-array (length code)
56                :element-type '(unsigned-byte 32)
57                :initial-contents
58                (mapcar #'xload-arm-lap-word code))))
59
60
61;;; For now, do this with a UUO so that the kernel can catch it.
62(defparameter *arm-udf-code*
63  (let* ((code '((uuo-error-udf-call (:? al) fname))))
64    (make-array (length code)
65                :element-type '(unsigned-byte 32)
66                :initial-contents
67                (mapcar #'xload-arm-lap-word code))))
68
69
70(defun arm-initialize-static-space ()
71  (xload-make-word-ivector arm::subtag-u32-vector 1023 *xload-static-space*)
72  ;; Make NIL.  Note that NIL is sort of a misaligned cons (it
73  ;; straddles two doublewords.)
74  (xload-make-cons *xload-target-nil* 0 *xload-static-space*)
75  (xload-make-cons 0 *xload-target-nil* *xload-static-space*))
76
77
78
79(defparameter *linuxarm-xload-backend*
80  (make-backend-xload-info
81   :name :linuxarm
82   :macro-apply-code-function 'arm-fixup-macro-apply-code
83   :closure-trampoline-code *arm-closure-trampoline-code*
84   :udf-code *arm-udf-code*
85   :default-image-name "ccl:ccl;arm-boot"
86   :default-startup-file-name "level-1.lafsl"
87   :subdirs '("ccl:level-0;ARM;")
88   :compiler-target-name :linuxarm
89   :image-base-address (+ (ash 1 28) (ash 1 12))
90   :nil-relative-symbols arm::*arm-nil-relative-symbols*
91   :static-space-init-function 'arm-initialize-static-space
92   :purespace-reserve (ash 8 20)
93   :static-space-address (- (ash 1 28) (ash 1 12))
94))
95
96(add-xload-backend *linuxarm-xload-backend*)
97
98
99
100
101#+linuxarm-backend
102(progn
103(setq *xload-default-backend* *linuxarm-xload-backend*)
104)
105
106
107
108
109
110
Note: See TracBrowser for help on using the repository browser.