From cea63d21887f793750d26fd577b21f15b093e12b Mon Sep 17 00:00:00 2001 From: dtc <dtc> Date: Wed, 21 Jan 1998 19:23:48 +0000 Subject: [PATCH] Complex-float support for the Alpha backend. --- compiler/alpha/array.lisp | 122 +++++++++++++- compiler/alpha/float.lisp | 302 +++++++++++++++++++++++++++++++++- compiler/alpha/type-vops.lisp | 98 ++++++++++- compiler/alpha/vm.lisp | 22 ++- 4 files changed, 532 insertions(+), 12 deletions(-) diff --git a/compiler/alpha/array.lisp b/compiler/alpha/array.lisp index f4fdf5c79..39f980837 100644 --- a/compiler/alpha/array.lisp +++ b/compiler/alpha/array.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/alpha/array.lisp,v 1.2 1994/10/31 04:39:51 ram Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/alpha/array.lisp,v 1.3 1998/01/21 19:23:48 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -13,6 +13,7 @@ ;;; ;;; Written by William Lott ;;; Conversion by Sean Hallgren +;;; Complex-float support by Douglas Crosher 1998. ;;; (in-package "ALPHA") @@ -145,7 +146,10 @@ (def-full-data-vector-frobs simple-array-unsigned-byte-32 unsigned-num unsigned-reg) - +#+signed-array +(def-full-data-vector-frobs simple-array-signed-byte-30 tagged-num any-reg) +#+signed-array +(def-full-data-vector-frobs simple-array-signed-byte-32 signed-num signed-reg) ;;; Integer vectors whos elements are smaller than a byte. I.e. bit, 2-bit, ;;; and 4-bit vectors. @@ -439,3 +443,117 @@ (define-vop (get-vector-subtype get-header-data)) (define-vop (set-vector-subtype set-header-data)) + +;;; Complex float arrays. +#+complex-float +(progn + +(define-vop (data-vector-ref/simple-array-complex-single-float) + (:note "inline array access") + (:translate data-vector-ref) + (:policy :fast-safe) + (:args (object :scs (descriptor-reg)) + (index :scs (any-reg))) + (:arg-types simple-array-complex-single-float positive-fixnum) + (:results (value :scs (complex-single-reg))) + (:temporary (:scs (interior-reg)) lip) + (:result-types complex-single-float) + (:generator 5 + (let ((real-tn (complex-single-reg-real-tn value))) + (inst addq object index lip) + (inst addq lip index lip) + (inst lds real-tn + (- (* vector-data-offset word-bytes) other-pointer-type) + lip)) + (let ((imag-tn (complex-single-reg-imag-tn value))) + (inst lds imag-tn + (- (* (1+ vector-data-offset) word-bytes) other-pointer-type) + lip)))) + +(define-vop (data-vector-set/simple-array-complex-single-float) + (:note "inline array store") + (:translate data-vector-set) + (:policy :fast-safe) + (:args (object :scs (descriptor-reg)) + (index :scs (any-reg)) + (value :scs (complex-single-reg) :target result)) + (:arg-types simple-array-complex-single-float positive-fixnum + complex-single-float) + (:results (result :scs (complex-single-reg))) + (:result-types complex-single-float) + (:temporary (:scs (interior-reg)) lip) + (:generator 5 + (let ((value-real (complex-single-reg-real-tn value)) + (result-real (complex-single-reg-real-tn result))) + (inst addq object index lip) + (inst addq lip index lip) + (inst sts value-real + (- (* vector-data-offset word-bytes) other-pointer-type) + lip) + (unless (location= result-real value-real) + (inst fmove value-real result-real))) + (let ((value-imag (complex-single-reg-imag-tn value)) + (result-imag (complex-single-reg-imag-tn result))) + (inst sts value-imag + (- (* (1+ vector-data-offset) word-bytes) other-pointer-type) + lip) + (unless (location= result-imag value-imag) + (inst fmove value-imag result-imag))))) + +(define-vop (data-vector-ref/simple-array-complex-double-float) + (:note "inline array access") + (:translate data-vector-ref) + (:policy :fast-safe) + (:args (object :scs (descriptor-reg)) + (index :scs (any-reg))) + (:arg-types simple-array-complex-double-float positive-fixnum) + (:results (value :scs (complex-double-reg))) + (:result-types complex-double-float) + (:temporary (:scs (interior-reg)) lip) + (:generator 7 + (let ((real-tn (complex-double-reg-real-tn value))) + (inst addq object index lip) + (inst addq lip index lip) + (inst addq lip index lip) + (inst addq lip index lip) + (inst ldt real-tn + (- (* vector-data-offset word-bytes) other-pointer-type) + lip)) + (let ((imag-tn (complex-double-reg-imag-tn value))) + (inst ldt imag-tn + (- (* (+ vector-data-offset 2) word-bytes) other-pointer-type) + lip)))) + +(define-vop (data-vector-set/simple-array-complex-double-float) + (:note "inline array store") + (:translate data-vector-set) + (:policy :fast-safe) + (:args (object :scs (descriptor-reg)) + (index :scs (any-reg)) + (value :scs (complex-double-reg) :target result)) + (:arg-types simple-array-complex-double-float positive-fixnum + complex-double-float) + (:results (result :scs (complex-double-reg))) + (:result-types complex-double-float) + (:temporary (:scs (interior-reg)) lip) + (:generator 20 + (let ((value-real (complex-double-reg-real-tn value)) + (result-real (complex-double-reg-real-tn result))) + (inst addq object index lip) + (inst addq lip index lip) + (inst addq lip index lip) + (inst addq lip index lip) + (inst stt value-real + (- (* vector-data-offset word-bytes) other-pointer-type) + lip) + (unless (location= result-real value-real) + (inst fmove value-real result-real))) + (let ((value-imag (complex-double-reg-imag-tn value)) + (result-imag (complex-double-reg-imag-tn result))) + (inst stt value-imag + (- (* (+ vector-data-offset 2) word-bytes) other-pointer-type) + lip) + (unless (location= result-imag value-imag) + (inst fmove value-imag result-imag))))) + +) ; end progn complex-float diff --git a/compiler/alpha/float.lisp b/compiler/alpha/float.lisp index 5f8937515..ec1abb9c4 100644 --- a/compiler/alpha/float.lisp +++ b/compiler/alpha/float.lisp @@ -6,7 +6,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/alpha/float.lisp,v 1.3 1997/06/07 19:04:38 pw Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/alpha/float.lisp,v 1.4 1998/01/21 19:23:47 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -15,6 +15,7 @@ ;;; Written by Rob MacLachlan ;;; Conversion by Sean Hallgren ;;; IEEE variants by Paul Werkowski +;;; Complex-float support by Douglas Crosher 1998. ;;; (in-package "ALPHA") @@ -134,9 +135,216 @@ (frob move-single-float-argument single-reg single-stack nil) (frob move-double-float-argument double-reg double-stack t)) + +;;;; Complex float move functions +#+complex-float +(progn + +(defun complex-single-reg-real-tn (x) + (make-random-tn :kind :normal :sc (sc-or-lose 'single-reg *backend*) + :offset (tn-offset x))) +(defun complex-single-reg-imag-tn (x) + (make-random-tn :kind :normal :sc (sc-or-lose 'single-reg *backend*) + :offset (1+ (tn-offset x)))) + +(defun complex-double-reg-real-tn (x) + (make-random-tn :kind :normal :sc (sc-or-lose 'double-reg *backend*) + :offset (tn-offset x))) +(defun complex-double-reg-imag-tn (x) + (make-random-tn :kind :normal :sc (sc-or-lose 'double-reg *backend*) + :offset (1+ (tn-offset x)))) + + +(define-move-function (load-complex-single 2) (vop x y) + ((complex-single-stack) (complex-single-reg)) + (let ((real-tn (complex-single-reg-real-tn y))) + (inst lds real-tn (* (tn-offset x) vm:word-bytes) (current-nfp-tn vop))) + (let ((imag-tn (complex-single-reg-imag-tn y))) + (inst lds imag-tn (* (1+ (tn-offset x)) vm:word-bytes) + (current-nfp-tn vop)))) + +(define-move-function (store-complex-single 2) (vop x y) + ((complex-single-reg) (complex-single-stack)) + (let ((real-tn (complex-single-reg-real-tn x))) + (inst sts real-tn (* (tn-offset y) vm:word-bytes) (current-nfp-tn vop))) + (let ((imag-tn (complex-single-reg-imag-tn x))) + (inst sts imag-tn (* (1+ (tn-offset y)) vm:word-bytes) + (current-nfp-tn vop)))) + + +(define-move-function (load-complex-double 4) (vop x y) + ((complex-double-stack) (complex-double-reg)) + (let ((nfp (current-nfp-tn vop)) + (offset (* (tn-offset x) vm:word-bytes))) + (let ((real-tn (complex-double-reg-real-tn y))) + (inst ldt real-tn offset nfp)) + (let ((imag-tn (complex-double-reg-imag-tn y))) + (inst ldt imag-tn (+ offset (* 2 vm:word-bytes)) nfp)))) + +(define-move-function (store-complex-double 4) (vop x y) + ((complex-double-reg) (complex-double-stack)) + (let ((nfp (current-nfp-tn vop)) + (offset (* (tn-offset y) vm:word-bytes))) + (let ((real-tn (complex-double-reg-real-tn x))) + (inst stt real-tn offset nfp)) + (let ((imag-tn (complex-double-reg-imag-tn x))) + (inst stt imag-tn (+ offset (* 2 vm:word-bytes)) nfp)))) + +;;; +;;; Complex float register to register moves. +;;; +(define-vop (complex-single-move) + (:args (x :scs (complex-single-reg) :target y + :load-if (not (location= x y)))) + (:results (y :scs (complex-single-reg) :load-if (not (location= x y)))) + (:note "complex single float move") + (:generator 0 + (unless (location= x y) + ;; Note the complex-float-regs are aligned to every second + ;; float register so there is not need to worry about overlap. + (let ((x-real (complex-single-reg-real-tn x)) + (y-real (complex-single-reg-real-tn y))) + (inst fmove x-real y-real)) + (let ((x-imag (complex-single-reg-imag-tn x)) + (y-imag (complex-single-reg-imag-tn y))) + (inst fmove x-imag y-imag))))) +;;; +(define-move-vop complex-single-move :move + (complex-single-reg) (complex-single-reg)) + +(define-vop (complex-double-move) + (:args (x :scs (complex-double-reg) + :target y :load-if (not (location= x y)))) + (:results (y :scs (complex-double-reg) :load-if (not (location= x y)))) + (:note "complex double float move") + (:generator 0 + (unless (location= x y) + ;; Note the complex-float-regs are aligned to every second + ;; float register so there is not need to worry about overlap. + (let ((x-real (complex-double-reg-real-tn x)) + (y-real (complex-double-reg-real-tn y))) + (inst fmove x-real y-real)) + (let ((x-imag (complex-double-reg-imag-tn x)) + (y-imag (complex-double-reg-imag-tn y))) + (inst fmove x-imag y-imag))))) +;;; +(define-move-vop complex-double-move :move + (complex-double-reg) (complex-double-reg)) + +;;; +;;; Move from a complex float to a descriptor register allocating a +;;; new complex float object in the process. +;;; +(define-vop (move-from-complex-single) + (:args (x :scs (complex-single-reg) :to :save)) + (:results (y :scs (descriptor-reg))) + (:temporary (:scs (non-descriptor-reg)) ndescr) + (:note "complex single float to pointer coercion") + (:generator 13 + (with-fixed-allocation (y ndescr vm:complex-single-float-type + vm:complex-single-float-size) + (let ((real-tn (complex-single-reg-real-tn x))) + (inst sts real-tn (- (* vm:complex-single-float-real-slot + vm:word-bytes) + vm:other-pointer-type) + y)) + (let ((imag-tn (complex-single-reg-imag-tn x))) + (inst sts imag-tn (- (* vm:complex-single-float-imag-slot + vm:word-bytes) + vm:other-pointer-type) + y))))) +;;; +(define-move-vop move-from-complex-single :move + (complex-single-reg) (descriptor-reg)) + +(define-vop (move-from-complex-double) + (:args (x :scs (complex-double-reg) :to :save)) + (:results (y :scs (descriptor-reg))) + (:temporary (:scs (non-descriptor-reg)) ndescr) + (:note "complex double float to pointer coercion") + (:generator 13 + (with-fixed-allocation (y ndescr vm:complex-double-float-type + vm:complex-double-float-size) + (let ((real-tn (complex-double-reg-real-tn x))) + (inst stt real-tn (- (* vm:complex-double-float-real-slot + vm:word-bytes) + vm:other-pointer-type) + y)) + (let ((imag-tn (complex-double-reg-imag-tn x))) + (inst stt imag-tn (- (* vm:complex-double-float-imag-slot + vm:word-bytes) + vm:other-pointer-type) + y))))) +;;; +(define-move-vop move-from-complex-double :move + (complex-double-reg) (descriptor-reg)) + +;;; +;;; Move from a descriptor to a complex float register +;;; +(macrolet ((frob (name sc double-p real-value imag-value) + `(progn + (define-vop (,name) + (:args (x :scs (descriptor-reg))) + (:results (y :scs (,sc))) + (:note "pointer to complex float coercion") + (:generator 2 + (let ((real-tn (complex-double-reg-real-tn y))) + (inst ,(if double-p 'ldt 'lds) real-tn + (- (* ,real-value vm:word-bytes) + vm:other-pointer-type) + x)) + (let ((imag-tn (complex-double-reg-imag-tn y))) + (inst ,(if double-p 'ldt 'lds) imag-tn + (- (* ,imag-value vm:word-bytes) + vm:other-pointer-type) + x)))) + (define-move-vop ,name :move (descriptor-reg) (,sc))))) + (frob move-to-complex-single complex-single-reg nil + complex-single-float-real-slot complex-single-float-imag-slot) + (frob move-to-complex-double complex-double-reg t + complex-double-float-real-slot complex-double-float-imag-slot)) +;;; +;;; Complex float move-argument vop +;;; +(macrolet ((frob (name sc stack-sc double-p) + `(progn + (define-vop (,name) + (:args (x :scs (,sc) :target y) + (nfp :scs (any-reg) + :load-if (not (sc-is y ,sc)))) + (:results (y)) + (:note "complex float argument move") + (:generator ,(if double-p 2 1) + (sc-case y + (,sc + (unless (location= x y) + (let ((x-real (complex-double-reg-real-tn x)) + (y-real (complex-double-reg-real-tn y))) + (inst fmove x-real y-real)) + (let ((x-imag (complex-double-reg-imag-tn x)) + (y-imag (complex-double-reg-imag-tn y))) + (inst fmove x-imag y-imag)))) + (,stack-sc + (let ((offset (* (tn-offset y) vm:word-bytes))) + (let ((real-tn (complex-double-reg-real-tn x))) + (inst ,(if double-p 'stt 'sts) real-tn offset nfp)) + (let ((imag-tn (complex-double-reg-imag-tn x))) + (inst ,(if double-p 'stt 'sts) imag-tn offset nfp))))))) + (define-move-vop ,name :move-argument + (,sc descriptor-reg) (,sc))))) + (frob move-complex-single-float-argument + complex-single-reg complex-single-stack nil) + (frob move-complex-double-float-argument + complex-double-reg complex-double-stack t)) + +) ; progn complex-float + (define-move-vop move-argument :move-argument - (single-reg double-reg) (descriptor-reg)) + (single-reg double-reg + #+complex-float complex-single-reg #+complex-float complex-double-reg) + (descriptor-reg)) ;;;; Arithmetic VOPs: @@ -549,3 +757,93 @@ (inst mt_fpcr temp1 temp1 temp1) (inst excb) (move res new)))) + + +;;;; Complex float VOPs + +#+complex-float +(progn + +(define-vop (make-complex-single-float) + (:translate complex) + (:args (x :scs (single-reg) :target r) + (y :scs (single-reg) :to :save)) + (:arg-types single-float single-float) + (:results (r :scs (complex-single-reg) :from (:argument 0))) + (:result-types complex-single-float) + (:note "inline complex single-float creation") + (:policy :fast-safe) + (:generator 5 + (let ((r-real (complex-single-reg-real-tn r))) + (unless (location= x r-real) + (inst fmove x r-real))) + (let ((r-imag (complex-single-reg-imag-tn r))) + (unless (location= y r-imag) + (inst fmove y r-imag))))) + +(define-vop (make-complex-double-float) + (:translate complex) + (:args (x :scs (double-reg) :target r) + (y :scs (double-reg) :to :save)) + (:arg-types double-float double-float) + (:results (r :scs (complex-double-reg) :from (:argument 0))) + (:result-types complex-double-float) + (:note "inline complex double-float creation") + (:policy :fast-safe) + (:generator 5 + (let ((r-real (complex-double-reg-real-tn r))) + (unless (location= x r-real) + (inst fmove x r-real))) + (let ((r-imag (complex-double-reg-imag-tn r))) + (unless (location= y r-imag) + (inst fmove y r-imag))))) + +(define-vop (complex-single-float-value) + (:args (x :scs (complex-single-reg) :target r)) + (:arg-types complex-single-float) + (:results (r :scs (single-reg))) + (:result-types single-float) + (:variant-vars offset) + (:policy :fast-safe) + (:generator 3 + (let ((value-tn (make-random-tn :kind :normal + :sc (sc-or-lose 'single-reg *backend*) + :offset (+ offset (tn-offset x))))) + (unless (location= value-tn r) + (inst fmove value-tn r))))) + +(define-vop (realpart/complex-single-float complex-single-float-value) + (:translate realpart) + (:note "complex single float realpart") + (:variant 0)) + +(define-vop (imagpart/complex-single-float complex-single-float-value) + (:translate imagpart) + (:note "complex single float imagpart") + (:variant 1)) + +(define-vop (complex-double-float-value) + (:args (x :scs (complex-double-reg) :target r)) + (:arg-types complex-double-float) + (:results (r :scs (double-reg))) + (:result-types double-float) + (:variant-vars offset) + (:policy :fast-safe) + (:generator 3 + (let ((value-tn (make-random-tn :kind :normal + :sc (sc-or-lose 'double-reg *backend*) + :offset (+ offset (tn-offset x))))) + (unless (location= value-tn r) + (inst fmove value-tn r))))) + +(define-vop (realpart/complex-double-float complex-double-float-value) + (:translate realpart) + (:note "complex double float realpart") + (:variant 0)) + +(define-vop (imagpart/complex-double-float complex-double-float-value) + (:translate imagpart) + (:note "complex double float imagpart") + (:variant 1)) + +) ; progn complex-float diff --git a/compiler/alpha/type-vops.lisp b/compiler/alpha/type-vops.lisp index aa7c2f951..1c51aa45e 100644 --- a/compiler/alpha/type-vops.lisp +++ b/compiler/alpha/type-vops.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/alpha/type-vops.lisp,v 1.2 1994/10/31 04:39:51 ram Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/alpha/type-vops.lisp,v 1.3 1998/01/21 19:23:46 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -15,6 +15,7 @@ ;;; Written by William Lott ;;; Earlier versions by Rob MacLachlan and Christopher Hoover. ;;; Alpha conversion by Sean Hallgren +;;; Complex-float support by Douglas Crosher 1998. ;;; (in-package "ALPHA") @@ -255,7 +256,28 @@ object-not-ratio-error ratio-type) (def-type-vops complexp check-complex complex - object-not-complex-error complex-type) + object-not-complex-error complex-type + #+complex-float complex-single-float-type + #+complex-float complex-double-float-type) + +#+complex-float +(def-type-vops complex-rational-p check-complex-rational nil + object-not-complex-rational-error complex-type) + +#+complex-float +(def-type-vops complex-float-p check-complex-float nil + object-not-complex-float-error + complex-single-float-type complex-double-float-type) + +#+complex-float +(def-type-vops complex-single-float-p check-complex-single-float + complex-single-float object-not-complex-single-float-error + complex-single-float-type) + +#+complex-float +(def-type-vops complex-double-float-p check-complex-double-float + complex-double-float object-not-complex-double-float-error + complex-double-float-type) (def-type-vops single-float-p check-single-float single-float object-not-single-float-error single-float-type) @@ -302,6 +324,34 @@ object-not-simple-array-unsigned-byte-32-error simple-array-unsigned-byte-32-type) +#+signed-array +(def-type-vops simple-array-signed-byte-8-p + check-simple-array-signed-byte-8 + simple-array-signed-byte-8 + object-not-simple-array-signed-byte-8-error + simple-array-signed-byte-8-type) + +#+signed-array +(def-type-vops simple-array-signed-byte-16-p + check-simple-array-signed-byte-16 + simple-array-signed-byte-16 + object-not-simple-array-signed-byte-16-error + simple-array-signed-byte-16-type) + +#+signed-array +(def-type-vops simple-array-signed-byte-30-p + check-simple-array-signed-byte-30 + simple-array-signed-byte-30 + object-not-simple-array-signed-byte-30-error + simple-array-signed-byte-30-type) + +#+signed-array +(def-type-vops simple-array-signed-byte-32-p + check-simple-array-signed-byte-32 + simple-array-signed-byte-32 + object-not-simple-array-signed-byte-32-error + simple-array-signed-byte-32-type) + (def-type-vops simple-array-single-float-p check-simple-array-single-float simple-array-single-float object-not-simple-array-single-float-error simple-array-single-float-type) @@ -310,6 +360,20 @@ simple-array-double-float object-not-simple-array-double-float-error simple-array-double-float-type) +#+complex-float +(def-type-vops simple-array-complex-single-float-p + check-simple-array-complex-single-float + simple-array-complex-single-float + object-not-simple-array-complex-single-float-error + simple-array-complex-single-float-type) + +#+complex-float +(def-type-vops simple-array-complex-double-float-p + check-simple-array-complex-double-float + simple-array-complex-double-float + object-not-simple-array-complex-double-float-error + simple-array-complex-double-float-type) + (def-type-vops base-char-p check-base-char base-char object-not-base-char-error base-char-type) @@ -355,29 +419,49 @@ simple-string-type simple-bit-vector-type simple-vector-type simple-array-unsigned-byte-2-type simple-array-unsigned-byte-4-type simple-array-unsigned-byte-8-type simple-array-unsigned-byte-16-type - simple-array-unsigned-byte-32-type simple-array-single-float-type - simple-array-double-float-type complex-string-type - complex-bit-vector-type complex-vector-type) + simple-array-unsigned-byte-32-type + #+signed-array simple-array-signed-byte-8-type + #+signed-array simple-array-signed-byte-16-type + #+signed-array simple-array-signed-byte-30-type + #+signed-array simple-array-signed-byte-32-type + simple-array-single-float-type simple-array-double-float-type + #+complex-float simple-array-complex-single-float-type + #+complex-float simple-array-complex-double-float-type + complex-string-type complex-bit-vector-type complex-vector-type) (def-type-vops simple-array-p check-simple-array nil object-not-simple-array-error simple-array-type simple-string-type simple-bit-vector-type simple-vector-type simple-array-unsigned-byte-2-type simple-array-unsigned-byte-4-type simple-array-unsigned-byte-8-type simple-array-unsigned-byte-16-type simple-array-unsigned-byte-32-type - simple-array-single-float-type simple-array-double-float-type) + #+signed-array simple-array-signed-byte-8-type + #+signed-array simple-array-signed-byte-16-type + #+signed-array simple-array-signed-byte-30-type + #+signed-array simple-array-signed-byte-32-type + simple-array-single-float-type simple-array-double-float-type + #+complex-float simple-array-complex-single-float-type + #+complex-float simple-array-complex-double-float-type) (def-type-vops arrayp check-array nil object-not-array-error simple-array-type simple-string-type simple-bit-vector-type simple-vector-type simple-array-unsigned-byte-2-type simple-array-unsigned-byte-4-type simple-array-unsigned-byte-8-type simple-array-unsigned-byte-16-type simple-array-unsigned-byte-32-type + #+signed-array simple-array-signed-byte-8-type + #+signed-array simple-array-signed-byte-16-type + #+signed-array simple-array-signed-byte-30-type + #+signed-array simple-array-signed-byte-32-type simple-array-single-float-type simple-array-double-float-type + #+complex-float simple-array-complex-single-float-type + #+complex-float simple-array-complex-double-float-type complex-string-type complex-bit-vector-type complex-vector-type complex-array-type) (def-type-vops numberp check-number nil object-not-number-error even-fixnum-type odd-fixnum-type bignum-type ratio-type - single-float-type double-float-type complex-type) + single-float-type double-float-type complex-type + #+complex-float complex-single-float-type + #+complex-float complex-double-float-type) (def-type-vops rationalp check-rational nil object-not-rational-error even-fixnum-type odd-fixnum-type ratio-type bignum-type) diff --git a/compiler/alpha/vm.lisp b/compiler/alpha/vm.lisp index 518d5241c..db5698b44 100644 --- a/compiler/alpha/vm.lisp +++ b/compiler/alpha/vm.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/alpha/vm.lisp,v 1.2 1994/10/31 04:39:51 ram Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/alpha/vm.lisp,v 1.3 1998/01/21 19:23:45 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -156,6 +156,10 @@ (single-stack non-descriptor-stack) ; single-floats (double-stack non-descriptor-stack :element-size 2 :alignment 2) ; double floats. + #+complex-float + (complex-single-stack non-descriptor-stack :element-size 2) + #+complex-float + (complex-double-stack non-descriptor-stack :element-size 2) ;; **** Things that can go in the integer registers. @@ -227,6 +231,22 @@ :save-p t :alternate-scs (double-stack)) + #+complex-float + (complex-single-reg float-registers + :locations #.(loop for i from 4 to 31 by 2 collect i) + :element-size 2 + :constant-scs () + :save-p t + :alternate-scs (complex-single-stack)) + + #+complex-float + (complex-double-reg float-registers + :locations #.(loop for i from 4 to 31 by 2 collect i) + :element-size 2 + :constant-scs () + :save-p t + :alternate-scs (complex-double-stack)) + ;; A catch or unwind block. (catch-block control-stack :element-size vm:catch-block-size)) -- GitLab