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

Diff of /src/code/pred.lisp

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

revision 1.60 by rtoy, Fri Jun 30 18:41:22 2006 UTC revision 1.61 by rtoy, Mon Nov 2 02:51:57 2009 UTC
# Line 127  Line 127 
127                      primitive-predicates))))                      primitive-predicates))))
128    (frob))    (frob))
129    
130    ;;; FIXME: The next four functions are for bootstrapping double-double
131    ;;; for AMD64.  This works around the recursive known function problem
132    ;;; when compiling the predicate functions for double-double.  This
133    ;;; should be eventually removed when double-double float support for
134    ;;; the compiler is working.
135    (defun double-double-float-p (x)
136      (let* ((addr (kernel:get-lisp-obj-address x))
137             (ptr (logandc2 addr #x7)))
138        (when (= 1 (logand addr 1))
139          (= 26 (ldb (byte 8 0)
140                     (sys:sap-ref-32 (sys:int-sap ptr) 0))))))
141    
142    (defun complex-double-double-float-p (x)
143      (let* ((addr (kernel:get-lisp-obj-address x))
144             (ptr (logandc2 addr #x7)))
145        (when (= 1 (logand addr 1))
146          (= 42 (ldb (byte 8 0)
147                     (sys:sap-ref-32 (sys:int-sap ptr) 0))))))
148    
149    (defun simple-array-double-double-float-p (x)
150      (let* ((addr (kernel:get-lisp-obj-address x))
151             (ptr (logandc2 addr #x7)))
152        (when (= 1 (logand addr 1))
153          (= 106 (ldb (byte 8 0)
154                      (sys:sap-ref-32 (sys:int-sap ptr) 0))))))
155    
156    (defun simple-array-complex-double-double-float-p (x)
157      (let* ((addr (kernel:get-lisp-obj-address x))
158             (ptr (logandc2 addr #x7)))
159        (when (= 1 (logand addr 1))
160          (= 118 (ldb (byte 8 0)
161                      (sys:sap-ref-32 (sys:int-sap ptr) 0))))))
162    
163    
164  ;;;; TYPE-OF -- public.  ;;;; TYPE-OF -- public.
165  ;;;  ;;;

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

  ViewVC Help
Powered by ViewVC 1.1.5