[Openmcl-cvs-notifications] r10119 - /trunk/source/lib/nfcomp.lisp
rme at clozure.com
rme at clozure.com
Fri Jul 18 22:45:42 EDT 2008
Author: rme
Date: Fri Jul 18 22:45:42 2008
New Revision: 10119
Log:
Additions for x8632, primarily support for writing x8632 concatenated
functions.
Modified:
trunk/source/lib/nfcomp.lisp
Modified: trunk/source/lib/nfcomp.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/lib/nfcomp.lisp (original)
+++ trunk/source/lib/nfcomp.lisp Fri Jul 18 22:45:42 2008
@@ -38,6 +38,8 @@
(require "PPC32-ARCH")
#+ppc64-target
(require "PPC64-ARCH")
+#+x8632-target
+(require "X8632-ARCH")
#+x8664-target
(require "X8664-ARCH")
) ;eval-when (:compile-toplevel :execute)
@@ -1000,6 +1002,8 @@
#.ppc64::fulltag-imm-1
#.ppc64::fulltag-imm-2
#.ppc64::fulltag-imm-3))
+ #+x8632-target
+ (#.x8632::tag-imm)
#+x8664-target
((#.x8664::fulltag-imm-0
#.x8664::fulltag-imm-1))
@@ -1009,6 +1013,8 @@
(=3D (the fixnum (logand type-code ppc32::full-tag-mask)) ppc32=
::fulltag-immheader)
#+ppc64-target
(=3D (the fixnum (logand type-code ppc64::lowtagmask)) ppc64::l=
owtag-immheader)
+ #+x8632-target
+ (=3D (the fixnum (logand type-code x8632::fulltagmask)) x8632::fulltag=
-immheader)
#+x8664-target
(and (=3D (the fixnum (lisptag exp)) x8664::tag-misc)
(logbitp (the (unsigned-byte 16) (logand type-code x8664::=
fulltagmask))
@@ -1021,7 +1027,8 @@
(case type-code
((#.target::subtag-pool #.target::subtag-weak #.target::subta=
g-lock) (fasl-unknown exp))
(#+ppc-target #.target::subtag-symbol
- #+x86-target #.target::tag-symbol (fasl-scan-sy=
mbol exp))
+ #+x8632-target #.target::subtag-symbol
+ #+x8664-target #.target::tag-symbol (fasl-scan-symbol exp))
((#.target::subtag-instance #.target::subtag-struct)
(fasl-scan-user-form exp))
(#.target::subtag-package (fasl-scan-ref exp))
@@ -1032,7 +1039,9 @@
(fasl-lock-hash-table exp))
(fasl-scan-user-form exp))
(fasl-scan-gvector exp)))
- #+x86-target
+ #+x8632-target
+ (#.target::subtag-function (fasl-scan-clfun exp))
+ #+x8664-target
(#.target::tag-function (fasl-scan-clfun exp))
(t (fasl-scan-gvector exp)))))))))
=
@@ -1061,7 +1070,7 @@
=
#+x86-target
(defun fasl-scan-clfun (f)
- (let* ((fv (%function-to-function-vector f))
+ (let* ((fv (function-to-function-vector f))
(size (uvsize fv))
(ncode-words (%function-code-words f)))
(fasl-scan-ref f)
@@ -1428,12 +1437,12 @@
(=3D (typecode (uvref f 0)) target::subtag-u8-vector))
(fasl-xdump-clfun f)
(let* ((code-size (%function-code-words f))
- (function-vector (%function-to-function-vector f))
+ (function-vector (function-to-function-vector f))
(function-size (uvsize function-vector)))
(fasl-out-opcode $fasl-clfun f)
(fasl-out-count function-size)
(fasl-out-count code-size)
- (fasl-out-ivect function-vector 0 (ash code-size 3))
+ (fasl-out-ivect function-vector 0 (ash code-size target::word-shift))
(do* ((k code-size (1+ k)))
((=3D k function-size))
(declare (fixnum k))
@@ -1442,32 +1451,45 @@
=
=
=
-;;; Write a "concatenated function"; for now, assume that the target
-;;; is x8664.
+;;; Write a "concatenated function".
(defun fasl-xdump-clfun (f)
- (let* ((code (uvref f 0))
- (code-size (dpb (uvref code 3)
- (byte 8 24)
- (dpb (uvref code 2)
- (byte 8 16)
- (dpb (uvref code 1)
- (byte 8 8)
- (uvref code 0)))))
- (function-size (ash (uvsize code) -3)))
- (assert (=3D (- function-size code-size) (1- (uvsize f))))
- (fasl-out-opcode $fasl-clfun f)
- (fasl-out-count function-size)
- (fasl-out-count code-size)
- (fasl-out-ivect code 0 (ash code-size 3))
- (do* ((i 1 (1+ i))
- (n (uvsize f)))
- ((=3D i n))
- (declare (fixnum i n))
- (fasl-dump-form (%svref f i)))))
- =
- =
-
-
+ (target-arch-case
+ (:x8632
+ (let* ((code (uvref f 0))
+ (function-size (ash (uvsize code) -2))
+ (imm-words (dpb (uvref code 1) (byte 8 8) (uvref code 0)))
+ (imm-bytes (ash imm-words 2))
+ (other-words (- function-size imm-words)))
+ (assert (=3D other-words (1- (uvsize f))))
+ (fasl-out-opcode $fasl-clfun f)
+ (fasl-out-count function-size)
+ (fasl-out-count imm-words)
+ (fasl-out-ivect code 0 imm-bytes)
+ (do ((i 1 (1+ i))
+ (n (uvsize f)))
+ ((=3D i n))
+ (declare (fixnum i n))
+ (fasl-dump-form (%svref f i)))))
+ (:x8664
+ (let* ((code (uvref f 0))
+ (code-size (dpb (uvref code 3)
+ (byte 8 24)
+ (dpb (uvref code 2)
+ (byte 8 16)
+ (dpb (uvref code 1)
+ (byte 8 8)
+ (uvref code 0)))))
+ (function-size (ash (uvsize code) -3)))
+ (assert (=3D (- function-size code-size) (1- (uvsize f))))
+ (fasl-out-opcode $fasl-clfun f)
+ (fasl-out-count function-size)
+ (fasl-out-count code-size)
+ (fasl-out-ivect code 0 (ash code-size 3))
+ (do* ((i 1 (1+ i))
+ (n (uvsize f)))
+ ((=3D i n))
+ (declare (fixnum i n))
+ (fasl-dump-form (%svref f i)))))))
=
(defun fasl-dump-codevector (c)
(if (and (not (eq *fasl-backend* *host-backend*))
More information about the Openmcl-cvs-notifications
mailing list