diff --git a/code/defstruct.lisp b/code/defstruct.lisp index fb1b313679477af88ed80837f3431a203440e6a5..3ee24b5caab443652cad3544ef9f672aa118d2f2 100644 --- a/code/defstruct.lisp +++ b/code/defstruct.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/code/defstruct.lisp,v 1.59 1998/03/01 21:46:00 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/defstruct.lisp,v 1.60 1998/03/03 17:35:19 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -15,8 +15,7 @@ (in-package "LISP") (export '(defstruct copy-structure structure-object)) (in-package "KERNEL") -(export '( - default-structure-print make-structure-load-form +(export '(default-structure-print make-structure-load-form %compiler-defstruct %%compiler-defstruct %compiler-only-defstruct %make-instance @@ -70,6 +69,27 @@ (declare (type index index)) (%raw-set-double vec index val)) +#+complex-float +(progn + +(defun %raw-ref-complex-single (vec index) + (declare (type index index)) + (%raw-ref-complex-single vec index)) + +(defun %raw-ref-complex-double (vec index) + (declare (type index index)) + (%raw-ref-complex-double vec index)) + +(defun %raw-set-complex-single (vec index val) + (declare (type index index)) + (%raw-set-complex-single vec index val)) + +(defun %raw-set-complex-double (vec index val) + (declare (type index index)) + (%raw-set-complex-double vec index val)) + +) ; end progn complex-float + (defun %instance-layout (instance) (%instance-layout instance)) @@ -125,6 +145,10 @@ (defsetf %instance-ref %instance-set) (defsetf %raw-ref-single %raw-set-single) (defsetf %raw-ref-double %raw-set-double) +#+complex-float +(defsetf %raw-ref-complex-single %raw-set-complex-single) +#+complex-float +(defsetf %raw-ref-complex-double %raw-set-complex-double) (defsetf %instance-layout %set-instance-layout) (defsetf %funcallable-instance-info %set-funcallable-instance-info) @@ -238,7 +262,10 @@ (type t) ; declared type specifier ;; ;; If a raw slot, what it holds. T means not raw. - (raw-type t :type (member t single-float double-float unsigned-byte)) + (raw-type t :type (member t single-float double-float + #+complex-float complex-single-float + #+complex-float complex-double-float + unsigned-byte)) (read-only nil :type (member t nil))) (defun print-defstruct-description (structure stream depth) @@ -565,6 +592,12 @@ (values 'single-float 1)) ((subtypep type 'double-float) (values 'double-float 2)) + #+complex-float + ((subtypep type '(complex single-float)) + (values 'complex-single-float 2)) + #+complex-float + ((subtypep type '(complex double-float)) + (values 'complex-double-float 4)) (t (values nil nil))) (cond ((not raw-type) @@ -929,14 +962,26 @@ (ecase rtype (single-float '%raw-ref-single) (double-float '%raw-ref-double) + #+complex-float + (complex-single-float '%raw-ref-complex-single) + #+complex-float + (complex-double-float '%raw-ref-complex-double) (unsigned-byte 'aref) ((t) (if (eq (dd-type defstruct) 'funcallable-structure) '%funcallable-instance-info '%instance-ref))) - (if (eq rtype 'double-float) - (ash (dsd-index slot) -1) - (dsd-index slot)) + (case rtype + (double-float + (ash (dsd-index slot) -1)) + #+complex-float + (complex-double-float + (ash (dsd-index slot) -2)) + #+complex-float + (complex-single-float + (ash (dsd-index slot) -1)) + (t + (dsd-index slot))) (cond ((eq rtype 't) object) (data) diff --git a/code/exports.lisp b/code/exports.lisp index bd90f8a9f742b99af7d27495deb4bdbe7ac1ad88..a486f81ff2c44b6bf4e46c59cbc04ccbb006035f 100644 --- a/code/exports.lisp +++ b/code/exports.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/code/exports.lisp,v 1.143 1998/02/24 18:14:13 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/exports.lisp,v 1.144 1998/03/03 17:35:17 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -1402,8 +1402,12 @@ "%DOUBLE-FLOAT" "%DPB" "%EXP" "%FUNCTION-HEADER-ARGLIST" "%FUNCTION-HEADER-NAME" "%FUNCTION-HEADER-TYPE" "%HYPOT" "%LDB" "%LOG" "%LOGB" "%LOG10" "%LOG1P" "%MAKE-COMPLEX" - "%MAKE-FUNCALLABLE-INSTANCE" "%MAKE-RATIO" "%MASK-FIELD" "%NEGATE" - "%POW" "%RAW-BITS" "%SCALB" "%SCALBN" "%SET-FUNCALLABLE-INSTANCE-FUNCTION" + "%MAKE-FUNCALLABLE-INSTANCE" "%MAKE-RATIO" + "%MASK-FIELD" "%NEGATE" "%POW" + "%RAW-BITS" "%RAW-REF-COMPLEX-DOUBLE" "%RAW-REF-COMPLEX-SINGLE" + "%RAW-REF-DOUBLE" "%RAW-REF-SINGLE" "%RAW-SET-COMPLEX-DOUBLE" + "%RAW-SET-COMPLEX-SINGLE" "%RAW-SET-DOUBLE" "%RAW-SET-SINGLE" + "%SCALB" "%SCALBN" "%SET-FUNCALLABLE-INSTANCE-FUNCTION" "%SET-FUNCALLABLE-INSTANCE-INFO" "%SET-RAW-BITS" "%SET-SAP-REF-16" "%SET-SAP-REF-32" "%SET-SAP-REF-8" "%SET-SAP-REF-DOUBLE" "%SET-SAP-REF-SAP" "%SET-SAP-REF-SINGLE" "%SET-STACK-REF" "%SIN" @@ -1563,14 +1567,14 @@ "LAMBDA-WITH-ENVIRONMENT" "LAYOUT-PURE" "DSD-RAW-TYPE" "%COMPILER-DEFSTRUCT" "DEFSTRUCT-DESCRIPTION" "UNDEFINE-STRUCTURE" "BIGNUMP" "DD-COPIER" "UNDEFINE-FUNCTION-NAME" "DD-TYPE" - "%RAW-REF-SINGLE" "CLASS-STATE" "INSTANCE" "%RAW-SET-DOUBLE" + "CLASS-STATE" "INSTANCE" "*TYPE-SYSTEM-INITIALIZED*" "WEAK-POINTER-P" "FIND-LAYOUT" "DSD-NAME" "%TYPEP" "DD-RAW-INDEX" "DD-NAME" "CLASS-SUBCLASSES" - "CLASS-LAYOUT" "%RAW-REF-DOUBLE" "DD-RAW-LENGTH" "NOTE-NAME-DEFINED" + "CLASS-LAYOUT" "DD-RAW-LENGTH" "NOTE-NAME-DEFINED" "%CODE-CODE-SIZE" "DD-SLOTS" "%IMAGPART" "DSD-ACCESSOR" "CLASS-INIT" "%CODE-DEBUG-INFO" "DSD-%NAME" "LAYOUT-CLASS" "LAYOUT-INVALID" "%FUNCTION-NAME" "DSD-TYPE" "%INSTANCEP" - "DEFSTRUCT-SLOT-DESCRIPTION" "%RAW-SET-SINGLE" + "DEFSTRUCT-SLOT-DESCRIPTION" "MAKE-STRUCTURE-LOAD-FORM" "BITP" "%FUNCTION-ARGLIST" "%FUNCTION-NEXT" "LAYOUT-HASH-LENGTH" "DD-PREDICATE" "CLASS-PROPER-NAME" "%NOTE-TYPE-DEFINED" "LAYOUT-INFO" diff --git a/compiler/alpha/array.lisp b/compiler/alpha/array.lisp index 130dc4bc3190e71ca62d8a712b1cb96b6fa9727d..1f65f76f8cdde490b93b0f3d67b02da273701446 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.5 1998/01/22 02:24:22 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/alpha/array.lisp,v 1.6 1998/03/03 17:35:32 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -415,43 +415,6 @@ (unless (location= result value) (inst fmove value result)))) - -;;; These VOPs are used for implementing float slots in structures (whose raw -;;; data is an unsigned-32 vector. -;;; -(define-vop (raw-ref-single data-vector-ref/simple-array-single-float) - (:translate %raw-ref-single) - (:arg-types simple-array-unsigned-byte-32 positive-fixnum)) -;;; -(define-vop (raw-set-single data-vector-set/simple-array-single-float) - (:translate %raw-set-single) - (:arg-types simple-array-unsigned-byte-32 positive-fixnum single-float)) -;;; -(define-vop (raw-ref-double data-vector-ref/simple-array-double-float) - (:translate %raw-ref-double) - (:arg-types simple-array-unsigned-byte-32 positive-fixnum)) -;;; -(define-vop (raw-set-double data-vector-set/simple-array-double-float) - (:translate %raw-set-double) - (:arg-types simple-array-unsigned-byte-32 positive-fixnum double-float)) - - -;;; These vops are useful for accessing the bits of a vector irrespective of -;;; what type of vector it is. -;;; - -(define-full-reffer raw-bits * 0 other-pointer-type (unsigned-reg) unsigned-num - %raw-bits) -(define-full-setter set-raw-bits * 0 other-pointer-type (unsigned-reg) - unsigned-num %set-raw-bits #+gengc nil) - - - -;;;; Misc. Array VOPs. - -(define-vop (get-vector-subtype get-header-data)) -(define-vop (set-vector-subtype set-header-data)) - ;;; Complex float arrays. #+complex-float @@ -566,3 +529,65 @@ (inst fmove value-imag result-imag))))) ) ; end progn complex-float + + +;;; These VOPs are used for implementing float slots in structures (whose raw +;;; data is an unsigned-32 vector. +;;; +(define-vop (raw-ref-single data-vector-ref/simple-array-single-float) + (:translate %raw-ref-single) + (:arg-types simple-array-unsigned-byte-32 positive-fixnum)) +;;; +(define-vop (raw-set-single data-vector-set/simple-array-single-float) + (:translate %raw-set-single) + (:arg-types simple-array-unsigned-byte-32 positive-fixnum single-float)) +;;; +(define-vop (raw-ref-double data-vector-ref/simple-array-double-float) + (:translate %raw-ref-double) + (:arg-types simple-array-unsigned-byte-32 positive-fixnum)) +;;; +(define-vop (raw-set-double data-vector-set/simple-array-double-float) + (:translate %raw-set-double) + (:arg-types simple-array-unsigned-byte-32 positive-fixnum double-float)) + +#+complex-float +(progn +(define-vop (raw-ref-complex-single + data-vector-ref/simple-array-complex-single-float) + (:translate %raw-ref-complex-single) + (:arg-types simple-array-unsigned-byte-32 positive-fixnum)) +;;; +(define-vop (raw-set-complex-single + data-vector-set/simple-array-complex-single-float) + (:translate %raw-set-complex-single) + (:arg-types simple-array-unsigned-byte-32 positive-fixnum + complex-single-float)) +;;; +(define-vop (raw-ref-complex-double + data-vector-ref/simple-array-complex-double-float) + (:translate %raw-ref-complex-double) + (:arg-types simple-array-unsigned-byte-32 positive-fixnum)) +;;; +(define-vop (raw-set-complex-double + data-vector-set/simple-array-complex-double-float) + (:translate %raw-set-complex-double) + (:arg-types simple-array-unsigned-byte-32 positive-fixnum + complex-double-float)) +) ; end progn complex-float + + +;;; These vops are useful for accessing the bits of a vector irrespective of +;;; what type of vector it is. +;;; + +(define-full-reffer raw-bits * 0 other-pointer-type (unsigned-reg) unsigned-num + %raw-bits) +(define-full-setter set-raw-bits * 0 other-pointer-type (unsigned-reg) + unsigned-num %set-raw-bits #+gengc nil) + + + +;;;; Misc. Array VOPs. + +(define-vop (get-vector-subtype get-header-data)) +(define-vop (set-vector-subtype set-header-data)) diff --git a/compiler/generic/vm-fndb.lisp b/compiler/generic/vm-fndb.lisp index 36f1a901cdd57c2788222ef6ac71b446d781bcd9..07a8ffbb9191fc9a6eeaa5b6410d1bc3d8983aef 100644 --- a/compiler/generic/vm-fndb.lisp +++ b/compiler/generic/vm-fndb.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/generic/vm-fndb.lisp,v 1.58 1998/02/03 19:22:22 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/generic/vm-fndb.lisp,v 1.59 1998/03/03 17:35:22 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -113,7 +113,9 @@ (unsafe)) (defknown %layout-invalid-error (t layout) nil) + (deftype raw-vector () '(simple-array (unsigned-byte 32) (*))) + (defknown %raw-ref-single (raw-vector index) single-float (foldable flushable)) (defknown %raw-ref-double (raw-vector index) double-float @@ -128,6 +130,27 @@ (defknown (%set-raw-bits) (t fixnum (unsigned-byte 32)) (unsigned-byte 32) (unsafe)) +#+complex-float +(progn +(defknown %raw-ref-complex-single (raw-vector index) (complex single-float) + (foldable flushable)) +(defknown %raw-ref-complex-double (raw-vector index) (complex double-float) + (foldable flushable)) +#+long-float +(defknown %raw-ref-complex-long (raw-vector index) (complex long-float) + (foldable flushable)) +(defknown %raw-set-complex-single (raw-vector index (complex single-float)) + (complex single-float) + (unsafe)) +(defknown %raw-set-complex-double (raw-vector index (complex double-float)) + (complex double-float) + (unsafe)) +#+long-float +(defknown %raw-set-complex-long (raw-vector index (complex long-float)) + (complex long-float) + (unsafe)) +) ; end progn complex-float + (defknown allocate-vector ((unsigned-byte 8) index index) (simple-array * (*)) (flushable movable)) diff --git a/compiler/sparc/array.lisp b/compiler/sparc/array.lisp index b26877371515b1ae8f8cc4459578e60365a42cd6..70a6f22997d087cf31544921a75170fbcd6ee25b 100644 --- a/compiler/sparc/array.lisp +++ b/compiler/sparc/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/sparc/array.lisp,v 1.16 1998/01/21 05:10:20 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/sparc/array.lisp,v 1.17 1998/03/03 17:35:27 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -394,49 +394,6 @@ (inst fmovs result value) (inst fmovs-odd result value)))) -;;; These VOPs are used for implementing float slots in structures (whose raw -;;; data is an unsigned-32 vector. -;;; -(define-vop (raw-ref-single data-vector-ref/simple-array-single-float) - (:translate %raw-ref-single) - (:arg-types simple-array-unsigned-byte-32 positive-fixnum)) -;;; -(define-vop (raw-set-single data-vector-set/simple-array-single-float) - (:translate %raw-set-single) - (:arg-types simple-array-unsigned-byte-32 positive-fixnum single-float)) -;;; -(define-vop (raw-ref-double data-vector-ref/simple-array-double-float) - (:translate %raw-ref-double) - (:arg-types simple-array-unsigned-byte-32 positive-fixnum)) -;;; -(define-vop (raw-set-double data-vector-set/simple-array-double-float) - (:translate %raw-set-double) - (:arg-types simple-array-unsigned-byte-32 positive-fixnum double-float)) - - -;;; These vops are useful for accessing the bits of a vector irrespective of -;;; what type of vector it is. -;;; - -(define-vop (raw-bits word-index-ref) - (:note "raw-bits VOP") - (:translate %raw-bits) - (:results (value :scs (unsigned-reg))) - (:result-types unsigned-num) - (:variant 0 vm:other-pointer-type)) - -(define-vop (set-raw-bits word-index-set) - (:note "setf raw-bits VOP") - (:translate %set-raw-bits) - (:args (object :scs (descriptor-reg)) - (index :scs (any-reg zero immediate)) - (value :scs (unsigned-reg))) - (:arg-types * tagged-num unsigned-num) - (:results (result :scs (unsigned-reg))) - (:result-types unsigned-num) - (:variant 0 vm:other-pointer-type)) - - ;;;; Misc. Array VOPs. @@ -599,3 +556,70 @@ (inst fmovs-odd result-imag value-imag))))) ) ; end progn complex-float + + +;;; These VOPs are used for implementing float slots in structures (whose raw +;;; data is an unsigned-32 vector. +;;; +(define-vop (raw-ref-single data-vector-ref/simple-array-single-float) + (:translate %raw-ref-single) + (:arg-types simple-array-unsigned-byte-32 positive-fixnum)) +;;; +(define-vop (raw-set-single data-vector-set/simple-array-single-float) + (:translate %raw-set-single) + (:arg-types simple-array-unsigned-byte-32 positive-fixnum single-float)) +;;; +(define-vop (raw-ref-double data-vector-ref/simple-array-double-float) + (:translate %raw-ref-double) + (:arg-types simple-array-unsigned-byte-32 positive-fixnum)) +;;; +(define-vop (raw-set-double data-vector-set/simple-array-double-float) + (:translate %raw-set-double) + (:arg-types simple-array-unsigned-byte-32 positive-fixnum double-float)) + +#+complex-float +(progn +(define-vop (raw-ref-complex-single + data-vector-ref/simple-array-complex-single-float) + (:translate %raw-ref-complex-single) + (:arg-types simple-array-unsigned-byte-32 positive-fixnum)) +;;; +(define-vop (raw-set-complex-single + data-vector-set/simple-array-complex-single-float) + (:translate %raw-set-complex-single) + (:arg-types simple-array-unsigned-byte-32 positive-fixnum + complex-single-float)) +;;; +(define-vop (raw-ref-complex-double + data-vector-ref/simple-array-complex-double-float) + (:translate %raw-ref-complex-double) + (:arg-types simple-array-unsigned-byte-32 positive-fixnum)) +;;; +(define-vop (raw-set-complex-double + data-vector-set/simple-array-complex-double-float) + (:translate %raw-set-complex-double) + (:arg-types simple-array-unsigned-byte-32 positive-fixnum + complex-double-float)) +) ; end progn complex-float + +;;; These vops are useful for accessing the bits of a vector irrespective of +;;; what type of vector it is. +;;; + +(define-vop (raw-bits word-index-ref) + (:note "raw-bits VOP") + (:translate %raw-bits) + (:results (value :scs (unsigned-reg))) + (:result-types unsigned-num) + (:variant 0 vm:other-pointer-type)) + +(define-vop (set-raw-bits word-index-set) + (:note "setf raw-bits VOP") + (:translate %set-raw-bits) + (:args (object :scs (descriptor-reg)) + (index :scs (any-reg zero immediate)) + (value :scs (unsigned-reg))) + (:arg-types * tagged-num unsigned-num) + (:results (result :scs (unsigned-reg))) + (:result-types unsigned-num) + (:variant 0 vm:other-pointer-type)) diff --git a/compiler/x86/array.lisp b/compiler/x86/array.lisp index eb62338e52fd080e6a6bba91f9ab4179af03d6d1..565786145c59167465804e544e7fefdc0fa92e3c 100644 --- a/compiler/x86/array.lisp +++ b/compiler/x86/array.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/array.lisp,v 1.11 1998/02/19 19:34:41 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/array.lisp,v 1.12 1998/03/03 17:35:25 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -782,57 +782,11 @@ (unless (location= value-imag result-imag) (inst fstd result-imag)) (inst fxch value-imag)))) -) ; complex-float - -;;; These VOPs are used for implementing float slots in structures (whose raw -;;; data is an unsigned-32 vector. -;;; -(define-vop (raw-ref-single data-vector-ref/simple-array-single-float) - (:translate %raw-ref-single) - (:arg-types simple-array-unsigned-byte-32 positive-fixnum)) -(define-vop (raw-ref-single-c data-vector-ref-c/simple-array-single-float) - (:translate %raw-ref-single) - (:arg-types simple-array-unsigned-byte-32 (:constant (signed-byte 30)))) -;;; -(define-vop (raw-set-single data-vector-set/simple-array-single-float) - (:translate %raw-set-single) - (:arg-types simple-array-unsigned-byte-32 positive-fixnum single-float)) -(define-vop (raw-set-single-c data-vector-set-c/simple-array-single-float) - (:translate %raw-set-single) - (:arg-types simple-array-unsigned-byte-32 (:constant (signed-byte 30)) - single-float)) -;;; -(define-vop (raw-ref-double data-vector-ref/simple-array-double-float) - (:translate %raw-ref-double) - (:arg-types simple-array-unsigned-byte-32 positive-fixnum)) -(define-vop (raw-ref-double-c data-vector-ref-c/simple-array-double-float) - (:translate %raw-ref-double) - (:arg-types simple-array-unsigned-byte-32 (:constant (signed-byte 30)))) -;;; -(define-vop (raw-set-double data-vector-set/simple-array-double-float) - (:translate %raw-set-double) - (:arg-types simple-array-unsigned-byte-32 positive-fixnum double-float)) -(define-vop (raw-set-double-c data-vector-set-c/simple-array-double-float) - (:translate %raw-set-double) - (:arg-types simple-array-unsigned-byte-32 (:constant (signed-byte 30)) - double-float)) -;;; These vops are useful for accessing the bits of a vector irrespective of -;;; what type of vector it is. -;;; - -(define-full-reffer raw-bits * 0 other-pointer-type (unsigned-reg) unsigned-num - %raw-bits) -(define-full-setter set-raw-bits * 0 other-pointer-type (unsigned-reg) - unsigned-num %set-raw-bits) +) ; complex-float -;;;; Misc. Array VOPs. - -(define-vop (get-vector-subtype get-header-data)) -(define-vop (set-vector-subtype set-header-data)) - ;;;; ;;;; dtc expanded and fixed the following: @@ -1213,3 +1167,98 @@ (move result eax))) ) ; end signed-array + + +;;; These VOPs are used for implementing float slots in structures (whose raw +;;; data is an unsigned-32 vector. +;;; +(define-vop (raw-ref-single data-vector-ref/simple-array-single-float) + (:translate %raw-ref-single) + (:arg-types simple-array-unsigned-byte-32 positive-fixnum)) +(define-vop (raw-ref-single-c data-vector-ref-c/simple-array-single-float) + (:translate %raw-ref-single) + (:arg-types simple-array-unsigned-byte-32 (:constant (signed-byte 30)))) +;;; +(define-vop (raw-set-single data-vector-set/simple-array-single-float) + (:translate %raw-set-single) + (:arg-types simple-array-unsigned-byte-32 positive-fixnum single-float)) +(define-vop (raw-set-single-c data-vector-set-c/simple-array-single-float) + (:translate %raw-set-single) + (:arg-types simple-array-unsigned-byte-32 (:constant (signed-byte 30)) + single-float)) +;;; +(define-vop (raw-ref-double data-vector-ref/simple-array-double-float) + (:translate %raw-ref-double) + (:arg-types simple-array-unsigned-byte-32 positive-fixnum)) +(define-vop (raw-ref-double-c data-vector-ref-c/simple-array-double-float) + (:translate %raw-ref-double) + (:arg-types simple-array-unsigned-byte-32 (:constant (signed-byte 30)))) +;;; +(define-vop (raw-set-double data-vector-set/simple-array-double-float) + (:translate %raw-set-double) + (:arg-types simple-array-unsigned-byte-32 positive-fixnum double-float)) +(define-vop (raw-set-double-c data-vector-set-c/simple-array-double-float) + (:translate %raw-set-double) + (:arg-types simple-array-unsigned-byte-32 (:constant (signed-byte 30)) + double-float)) + +;;;; Complex-float raw structure slot accessors. +#+complex-float +(progn + +(define-vop (raw-ref-complex-single + data-vector-ref/simple-array-complex-single-float) + (:translate %raw-ref-complex-single) + (:arg-types simple-array-unsigned-byte-32 positive-fixnum)) +(define-vop (raw-ref-complex-single-c + data-vector-ref-c/simple-array-complex-single-float) + (:translate %raw-ref-complex-single) + (:arg-types simple-array-unsigned-byte-32 (:constant (signed-byte 30)))) +;;; +(define-vop (raw-set-complex-single + data-vector-set/simple-array-complex-single-float) + (:translate %raw-set-complex-single) + (:arg-types simple-array-unsigned-byte-32 positive-fixnum complex-single-float)) +(define-vop (raw-set-complex-single-c + data-vector-set-c/simple-array-complex-single-float) + (:translate %raw-set-complex-single) + (:arg-types simple-array-unsigned-byte-32 (:constant (signed-byte 30)) + complex-single-float)) +;;; +(define-vop (raw-ref-complex-double + data-vector-ref/simple-array-complex-double-float) + (:translate %raw-ref-complex-double) + (:arg-types simple-array-unsigned-byte-32 positive-fixnum)) +(define-vop (raw-ref-complex-double-c + data-vector-ref-c/simple-array-complex-double-float) + (:translate %raw-ref-complex-double) + (:arg-types simple-array-unsigned-byte-32 (:constant (signed-byte 30)))) +;;; +(define-vop (raw-set-complex-double + data-vector-set/simple-array-complex-double-float) + (:translate %raw-set-complex-double) + (:arg-types simple-array-unsigned-byte-32 positive-fixnum + complex-double-float)) +(define-vop (raw-set-complex-double-c + data-vector-set-c/simple-array-complex-double-float) + (:translate %raw-set-complex-double) + (:arg-types simple-array-unsigned-byte-32 (:constant (signed-byte 30)) + complex-double-float)) + +) ; end progn complex-float + + +;;; These vops are useful for accessing the bits of a vector irrespective of +;;; what type of vector it is. +;;; +(define-full-reffer raw-bits * 0 other-pointer-type (unsigned-reg) + unsigned-num %raw-bits) +(define-full-setter set-raw-bits * 0 other-pointer-type (unsigned-reg) + unsigned-num %set-raw-bits) + + +;;;; Misc. Array VOPs. + +(define-vop (get-vector-subtype get-header-data)) +(define-vop (set-vector-subtype set-header-data)) +