/[cmucl]/src/code/defstruct.lisp
ViewVC logotype

Diff of /src/code/defstruct.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.59 by dtc, Sun Mar 1 21:46:00 1998 UTC revision 1.60 by dtc, Tue Mar 3 17:35:19 1998 UTC
# Line 15  Line 15 
15  (in-package "LISP")  (in-package "LISP")
16  (export '(defstruct copy-structure structure-object))  (export '(defstruct copy-structure structure-object))
17  (in-package "KERNEL")  (in-package "KERNEL")
18  (export '(  (export '(default-structure-print make-structure-load-form
           default-structure-print make-structure-load-form  
19            %compiler-defstruct %%compiler-defstruct            %compiler-defstruct %%compiler-defstruct
20            %compiler-only-defstruct            %compiler-only-defstruct
21            %make-instance            %make-instance
# Line 70  Line 69 
69    (declare (type index index))    (declare (type index index))
70    (%raw-set-double vec index val))    (%raw-set-double vec index val))
71    
72    #+complex-float
73    (progn
74    
75    (defun %raw-ref-complex-single (vec index)
76      (declare (type index index))
77      (%raw-ref-complex-single vec index))
78    
79    (defun %raw-ref-complex-double (vec index)
80      (declare (type index index))
81      (%raw-ref-complex-double vec index))
82    
83    (defun %raw-set-complex-single (vec index val)
84      (declare (type index index))
85      (%raw-set-complex-single vec index val))
86    
87    (defun %raw-set-complex-double (vec index val)
88      (declare (type index index))
89      (%raw-set-complex-double vec index val))
90    
91    ) ; end progn complex-float
92    
93  (defun %instance-layout (instance)  (defun %instance-layout (instance)
94    (%instance-layout instance))    (%instance-layout instance))
95    
# Line 125  Line 145 
145  (defsetf %instance-ref %instance-set)  (defsetf %instance-ref %instance-set)
146  (defsetf %raw-ref-single %raw-set-single)  (defsetf %raw-ref-single %raw-set-single)
147  (defsetf %raw-ref-double %raw-set-double)  (defsetf %raw-ref-double %raw-set-double)
148    #+complex-float
149    (defsetf %raw-ref-complex-single %raw-set-complex-single)
150    #+complex-float
151    (defsetf %raw-ref-complex-double %raw-set-complex-double)
152  (defsetf %instance-layout %set-instance-layout)  (defsetf %instance-layout %set-instance-layout)
153  (defsetf %funcallable-instance-info %set-funcallable-instance-info)  (defsetf %funcallable-instance-info %set-funcallable-instance-info)
154    
# Line 238  Line 262 
262    (type t)                      ; declared type specifier    (type t)                      ; declared type specifier
263    ;;    ;;
264    ;; If a raw slot, what it holds.  T means not raw.    ;; If a raw slot, what it holds.  T means not raw.
265    (raw-type t :type (member t single-float double-float unsigned-byte))    (raw-type t :type (member t single-float double-float
266                                #+complex-float complex-single-float
267                                #+complex-float complex-double-float
268                                unsigned-byte))
269    (read-only nil :type (member t nil)))    (read-only nil :type (member t nil)))
270    
271  (defun print-defstruct-description (structure stream depth)  (defun print-defstruct-description (structure stream depth)
# Line 565  Line 592 
592                 (values 'single-float 1))                 (values 'single-float 1))
593                ((subtypep type 'double-float)                ((subtypep type 'double-float)
594                 (values 'double-float 2))                 (values 'double-float 2))
595                  #+complex-float
596                  ((subtypep type '(complex single-float))
597                   (values 'complex-single-float 2))
598                  #+complex-float
599                  ((subtypep type '(complex double-float))
600                   (values 'complex-double-float 4))
601                (t (values nil nil)))                (t (values nil nil)))
602    
603        (cond ((not raw-type)        (cond ((not raw-type)
# Line 929  Line 962 
962       (ecase rtype       (ecase rtype
963         (single-float '%raw-ref-single)         (single-float '%raw-ref-single)
964         (double-float '%raw-ref-double)         (double-float '%raw-ref-double)
965           #+complex-float
966           (complex-single-float '%raw-ref-complex-single)
967           #+complex-float
968           (complex-double-float '%raw-ref-complex-double)
969         (unsigned-byte 'aref)         (unsigned-byte 'aref)
970         ((t)         ((t)
971          (if (eq (dd-type defstruct) 'funcallable-structure)          (if (eq (dd-type defstruct) 'funcallable-structure)
972              '%funcallable-instance-info              '%funcallable-instance-info
973              '%instance-ref)))              '%instance-ref)))
974       (if (eq rtype 'double-float)       (case rtype
975           (ash (dsd-index slot) -1)         (double-float
976           (dsd-index slot))          (ash (dsd-index slot) -1))
977           #+complex-float
978           (complex-double-float
979            (ash (dsd-index slot) -2))
980           #+complex-float
981           (complex-single-float
982            (ash (dsd-index slot) -1))
983           (t
984            (dsd-index slot)))
985       (cond       (cond
986        ((eq rtype 't) object)        ((eq rtype 't) object)
987        (data)        (data)

Legend:
Removed from v.1.59  
changed lines
  Added in v.1.60

  ViewVC Help
Powered by ViewVC 1.1.5