/[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.60 by dtc, Tue Mar 3 17:35:19 1998 UTC revision 1.61 by dtc, Sat Mar 21 08:11:53 1998 UTC
# Line 61  Line 61 
61    (declare (type index index))    (declare (type index index))
62    (%raw-ref-double vec index))    (%raw-ref-double vec index))
63    
64    #+long-float
65    (defun %raw-ref-long (vec index)
66      (declare (type index index))
67      (%raw-ref-long vec index))
68    
69  (defun %raw-set-single (vec index val)  (defun %raw-set-single (vec index val)
70    (declare (type index index))    (declare (type index index))
71    (%raw-set-single vec index val))    (%raw-set-single vec index val))
# Line 69  Line 74 
74    (declare (type index index))    (declare (type index index))
75    (%raw-set-double vec index val))    (%raw-set-double vec index val))
76    
77    #+long-float
78    (defun %raw-set-long (vec index val)
79      (declare (type index index))
80      (%raw-set-long vec index val))
81    
82  #+complex-float  #+complex-float
83  (progn  (progn
84    
# Line 80  Line 90 
90    (declare (type index index))    (declare (type index index))
91    (%raw-ref-complex-double vec index))    (%raw-ref-complex-double vec index))
92    
93    #+long-float
94    (defun %raw-ref-complex-long (vec index)
95      (declare (type index index))
96      (%raw-ref-complex-long vec index))
97    
98  (defun %raw-set-complex-single (vec index val)  (defun %raw-set-complex-single (vec index val)
99    (declare (type index index))    (declare (type index index))
100    (%raw-set-complex-single vec index val))    (%raw-set-complex-single vec index val))
# Line 88  Line 103 
103    (declare (type index index))    (declare (type index index))
104    (%raw-set-complex-double vec index val))    (%raw-set-complex-double vec index val))
105    
106    #+long-float
107    (defun %raw-set-complex-long (vec index val)
108      (declare (type index index))
109      (%raw-set-complex-long vec index val))
110    
111  ) ; end progn complex-float  ) ; end progn complex-float
112    
113  (defun %instance-layout (instance)  (defun %instance-layout (instance)
# Line 145  Line 165 
165  (defsetf %instance-ref %instance-set)  (defsetf %instance-ref %instance-set)
166  (defsetf %raw-ref-single %raw-set-single)  (defsetf %raw-ref-single %raw-set-single)
167  (defsetf %raw-ref-double %raw-set-double)  (defsetf %raw-ref-double %raw-set-double)
168    #+long-float
169    (defsetf %raw-ref-long %raw-set-long)
170  #+complex-float  #+complex-float
171  (defsetf %raw-ref-complex-single %raw-set-complex-single)  (defsetf %raw-ref-complex-single %raw-set-complex-single)
172  #+complex-float  #+complex-float
173  (defsetf %raw-ref-complex-double %raw-set-complex-double)  (defsetf %raw-ref-complex-double %raw-set-complex-double)
174    #+(and complex-float long-float)
175    (defsetf %raw-ref-complex-long %raw-set-complex-long)
176  (defsetf %instance-layout %set-instance-layout)  (defsetf %instance-layout %set-instance-layout)
177  (defsetf %funcallable-instance-info %set-funcallable-instance-info)  (defsetf %funcallable-instance-info %set-funcallable-instance-info)
178    
# Line 262  Line 286 
286    (type t)                      ; declared type specifier    (type t)                      ; declared type specifier
287    ;;    ;;
288    ;; If a raw slot, what it holds.  T means not raw.    ;; If a raw slot, what it holds.  T means not raw.
289    (raw-type t :type (member t single-float double-float    (raw-type t :type (member t single-float double-float #+long-float long-float
290                              #+complex-float complex-single-float                              #+complex-float complex-single-float
291                              #+complex-float complex-double-float                              #+complex-float complex-double-float
292                                #+(and complex-float long-float) complex-long-float
293                              unsigned-byte))                              unsigned-byte))
294    (read-only nil :type (member t nil)))    (read-only nil :type (member t nil)))
295    
# Line 592  Line 617 
617                 (values 'single-float 1))                 (values 'single-float 1))
618                ((subtypep type 'double-float)                ((subtypep type 'double-float)
619                 (values 'double-float 2))                 (values 'double-float 2))
620                  #+long-float
621                  ((subtypep type 'long-float)
622                   (values 'long-float #+x86 3 #+sparc 4))
623                #+complex-float                #+complex-float
624                ((subtypep type '(complex single-float))                ((subtypep type '(complex single-float))
625                 (values 'complex-single-float 2))                 (values 'complex-single-float 2))
626                #+complex-float                #+complex-float
627                ((subtypep type '(complex double-float))                ((subtypep type '(complex double-float))
628                 (values 'complex-double-float 4))                 (values 'complex-double-float 4))
629                  #+(and long-float complex-float)
630                  ((subtypep type '(complex long-float))
631                   (values 'complex-long-float #+x86 6 #+sparc 8))
632                (t (values nil nil)))                (t (values nil nil)))
633    
634        (cond ((not raw-type)        (cond ((not raw-type)
# Line 962  Line 993 
993       (ecase rtype       (ecase rtype
994         (single-float '%raw-ref-single)         (single-float '%raw-ref-single)
995         (double-float '%raw-ref-double)         (double-float '%raw-ref-double)
996           #+long-float
997           (long-float '%raw-ref-long)
998         #+complex-float         #+complex-float
999         (complex-single-float '%raw-ref-complex-single)         (complex-single-float '%raw-ref-complex-single)
1000         #+complex-float         #+complex-float
1001         (complex-double-float '%raw-ref-complex-double)         (complex-double-float '%raw-ref-complex-double)
1002           #+(and complex-float long-float)
1003           (complex-long-float '%raw-ref-complex-long)
1004         (unsigned-byte 'aref)         (unsigned-byte 'aref)
1005         ((t)         ((t)
1006          (if (eq (dd-type defstruct) 'funcallable-structure)          (if (eq (dd-type defstruct) 'funcallable-structure)
1007              '%funcallable-instance-info              '%funcallable-instance-info
1008              '%instance-ref)))              '%instance-ref)))
1009       (case rtype       (case rtype
1010           #+(and complex-float long-float)
1011           (complex-long-float
1012            (truncate (dsd-index slot) #+x86 6 #+sparc 8))
1013           #+long-float
1014           (long-float
1015            (truncate (dsd-index slot) #+x86 3 #+sparc 4))
1016         (double-float         (double-float
1017          (ash (dsd-index slot) -1))          (ash (dsd-index slot) -1))
1018         #+complex-float         #+complex-float

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

  ViewVC Help
Powered by ViewVC 1.1.5