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

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

Don't use "ba" pseudo-instruction.

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