source: branches/qres/ccl/xdump/xppcfasload.lisp @ 15278

Last change on this file since 15278 was 13070, checked in by gz, 10 years ago

r13066, r13067 from trunk: copyrights etc

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 5.1 KB
Line 
1;;;-*- Mode: Lisp; Package: CCL -*-
2;;;
3;;;   Copyright (C) 1994-2001 Digitool, Inc
4;;;   Portions copyright (C) 2001-2009 Clozure Associates
5;;;   This file is part of Clozure CL. 
6;;;
7;;;   Clozure CL is licensed under the terms of the Lisp Lesser GNU Public
8;;;   License , known as the LLGPL and distributed with Clozure CL as the
9;;;   file "LICENSE".  The LLGPL consists of a preamble and the LGPL,
10;;;   which is distributed with Clozure CL as the file "LGPL".  Where these
11;;;   conflict, the preamble takes precedence. 
12;;;
13;;;   Clozure CL is referenced in the preamble as the "LIBRARY."
14;;;
15;;;   The LLGPL is also available online at
16;;;   http://opensource.franz.com/preamble.html
17
18(in-package "CCL")
19
20(eval-when (:compile-toplevel :execute)
21  (require "FASLENV" "ccl:xdump;faslenv")
22  (require "PPC-LAP"))
23
24(eval-when (:compile-toplevel :load-toplevel :execute)
25  (require "XFASLOAD" "ccl:xdump;xfasload"))
26
27
28(defun xload-ppc-lap-word (instruction-form)
29  (uvref (uvref (compile nil
30                         `(lambda (&lap 0)
31                           (ppc-lap-function () ((?? 0))
32                            ,instruction-form)))
33                  0)
34         (target-arch-case
35          (:ppc32 0)
36          (:ppc64 1))))
37
38(defparameter *ppc-macro-apply-code*
39  (let* ((code '((mflr loc-pc)
40                 (bla .SPheap-rest-arg)
41                 (mtlr loc-pc)
42                 (vpop arg_z)
43                 (mr arg_y fname)
44                 (li arg_x '#.$xnotfun)
45                 (set-nargs 3)
46                 (ba .SPksignalerr))))
47    (make-array (length code)
48                :element-type '(unsigned-byte 32)
49                :initial-contents
50                (mapcar #'xload-ppc-lap-word code))))
51
52
53(defun ppc-fixup-macro-apply-code ()
54  (let* ((codev *ppc-macro-apply-code*))
55    (setf (uvref codev 5)
56          (logior (logand #xffff00000 (uvref *ppc-macro-apply-code* 5))
57                  (target-arch-case
58                   (:ppc32 (ash $xnotfun ppc32::fixnumshift))
59                   (:ppc64 (ash $xnotfun ppc64::fixnumshift)))))
60    codev))
61
62
63(defparameter *ppc-closure-trampoline-code*
64  (let* ((code '((ba .SPcall-closure))))
65    (make-array (length code)
66                :element-type '(unsigned-byte 32)
67                :initial-contents
68                (mapcar #'xload-ppc-lap-word code))))
69
70
71;;; For now, do this with a UUO so that the kernel can catch it.
72(defparameter *ppc-udf-code*
73  (let* ((code '((uuo_interr #.arch::error-udf-call 0))))
74    (make-array (length code)
75                :element-type '(unsigned-byte 32)
76                :initial-contents
77                (mapcar #'xload-ppc-lap-word code))))
78
79
80(defun ppc32-initialize-static-space ()
81  (xload-make-word-ivector ppc32::subtag-u32-vector 1027 *xload-static-space*)
82  ;; Make NIL.  Note that NIL is sort of a misaligned cons (it
83  ;; straddles two doublewords.)
84  (xload-make-cons *xload-target-nil* 0 *xload-static-space*)
85  (xload-make-cons 0 *xload-target-nil* *xload-static-space*))
86
87(defun ppc64-initialize-static-space ()
88  (xload-make-ivector *xload-static-space*
89                      (xload-target-subtype :unsigned-64-bit-vector) 
90                      (1- (/ 4096 8))))
91
92(defparameter *ppc32-xload-backend*
93  (make-backend-xload-info
94   :name #+darwinppc-target :darwinppc32 #+linuxppc-target :linuxppc32
95   :macro-apply-code-function 'ppc-fixup-macro-apply-code
96   :closure-trampoline-code *ppc-closure-trampoline-code*
97   :udf-code *ppc-udf-code*
98   :default-image-name
99   #+linuxppc-target "ccl:ccl;ppc-boot"
100   #+darwinppc-target "ccl:ccl;ppc-boot.image"
101   :default-startup-file-name
102   #+linuxppc-target "level-1.pfsl"
103   #+darwinppc-target "level-1.dfsl"
104   :subdirs '("ccl:level-0;PPC;PPC32;" "ccl:level-0;PPC;")
105   :compiler-target-name
106   #+linuxppc-target :linuxppc32
107   #+darwinppc-target :darwinppc32
108   :image-base-address
109   #+darwinppc-target #x04000000
110   #+linuxppc-target #x31000000
111   :nil-relative-symbols ppc::*ppc-nil-relative-symbols*
112   :static-space-init-function 'ppc32-initialize-static-space
113   :purespace-reserve (ash 64 20)
114   :static-space-address (ash 2 12)
115))
116
117(add-xload-backend *ppc32-xload-backend*)
118
119(defparameter *ppc64-xload-backend*
120  (make-backend-xload-info
121   :name #+darwinppc-target :darwinppc64 #+linuxppc-target :linuxppc64
122   :macro-apply-code-function 'ppc-fixup-macro-apply-code
123   :closure-trampoline-code *ppc-closure-trampoline-code*
124   :udf-code *ppc-udf-code*
125   :default-image-name
126   #+linuxppc-target "ccl:ccl;ppc-boot64"
127   #+darwinppc-target "ccl:ccl;ppc-boot64.image"
128   :default-startup-file-name
129   #+linuxppc-target "level-1.p64fsl"
130   #+darwinppc-target "level-1.d64fsl"
131   :subdirs '("ccl:level-0;PPC;PPC64;" "ccl:level-0;PPC;")
132   :compiler-target-name
133   #+linuxppc-target :linuxppc64
134   #+darwinppc-target :darwinppc64
135   :image-base-address #x100000000
136   :nil-relative-symbols ppc::*ppc-nil-relative-symbols*
137   :static-space-init-function 'ppc64-initialize-static-space
138   :purespace-reserve (ash 64 20)
139   :static-space-address (ash 2 12)
140   ))
141
142(add-xload-backend *ppc64-xload-backend*)
143
144#+ppc32-target
145(progn
146(setq *xload-default-backend* *ppc32-xload-backend*)
147)
148
149#+ppc64-target
150(progn
151
152  (setq *xload-default-backend* *ppc64-xload-backend*))
153
154
155
156
Note: See TracBrowser for help on using the repository browser.