Changeset 1596 for trunk/ccl/level0/l0pred.lisp
 Timestamp:
 May 27, 2005, 8:19:20 PM (14 years ago)
 File:

 1 edited
Legend:
 Unmodified
 Added
 Removed

trunk/ccl/level0/l0pred.lisp
r1558 r1596 70 70 ;;; The functions have to exist SOMEWHERE ... 71 71 (defun fixnump (x) 72 (= (the fixnum (lisptag x)) ppc32::tagfixnum))72 (= (the fixnum (lisptag x)) target::tagfixnum)) 73 73 74 74 (defun bignump (x) 75 (= (the fixnum (typecode x)) ppc32::subtagbignum))75 (= (the fixnum (typecode x)) target::subtagbignum)) 76 76 77 77 (defun integerp (x) … … 79 79 (let* ((typecode (typecode x))) 80 80 (declare (fixnum typecode)) 81 (or (= typecode ppc32::tagfixnum)82 (= typecode ppc32::subtagbignum))))81 (or (= typecode target::tagfixnum) 82 (= typecode target::subtagbignum)))) 83 83 84 84 (defun ratiop (x) 85 (= (the fixnum (typecode x)) ppc32::subtagratio))85 (= (the fixnum (typecode x)) target::subtagratio)) 86 86 87 87 … … 91 91 (let* ((typecode (typecode x))) 92 92 (declare (fixnum typecode)) 93 #+ppc32target 93 94 (and (>= typecode ppc32::minnumericsubtag) 94 (<= typecode ppc32::maxrationalsubtag))))) 95 96 95 (<= typecode ppc32::maxrationalsubtag)) 96 #+ppc64target 97 (cond ((= typecode ppc64::subtagbignum) t) 98 ((= typecode ppc64::subtagratio) t))))) 97 99 98 100 (defun shortfloatp (x) 99 (= (the fixnum (typecode x)) ppc32::subtagsinglefloat))101 (= (the fixnum (typecode x)) target::subtagsinglefloat)) 100 102 101 103 102 104 (defun doublefloatp (x) 103 (= (the fixnum (typecode x)) ppc32::subtagdoublefloat))105 (= (the fixnum (typecode x)) target::subtagdoublefloat)) 104 106 105 107 (defun floatp (x) … … 107 109 (let* ((typecode (typecode x))) 108 110 (declare (fixnum typecode)) 109 ( and (>= typecode ppc32::minfloatsubtag)110 (<= typecode ppc32::maxfloatsubtag))))111 (or (= typecode target::subtagsinglefloat) 112 (= typecode target::subtagdoublefloat)))) 111 113 112 114 (defun realp (x) … … 114 116 (let* ((typecode (typecode x))) 115 117 (declare (fixnum typecode)) 118 #+ppc32target 116 119 (or (= typecode ppc32::tagfixnum) 117 120 (and (>= typecode ppc32::minnumericsubtag) 118 (<= typecode ppc32::maxrealsubtag))))) 121 (<= typecode ppc32::maxrealsubtag))) 122 #+ppc64target 123 (cond ((= typecode ppc64::tagfixnum) t) 124 ((= typecode ppc64::subtagsinglefloat) t) 125 ((= typecode ppc64::subtagbignum) t) 126 ((= typecode ppc64::subtagdoublefloat) t) 127 ((= typecode ppc64::subtagratio) t)))) 119 128 120 129 (defun complexp (x) 121 130 "Return true if OBJECT is a COMPLEX, and NIL otherwise." 122 (= (the fixnum (typecode x)) ppc32::subtagcomplex))131 (= (the fixnum (typecode x)) target::subtagcomplex)) 123 132 124 133 (defun numberp (x) … … 126 135 (let* ((typecode (typecode x))) 127 136 (declare (fixnum typecode)) 137 #+ppc32target 128 138 (or (= typecode ppc32::tagfixnum) 129 139 (and (>= typecode ppc32::minnumericsubtag) 130 (<= typecode ppc32::maxnumericsubtag))))) 140 (<= typecode ppc32::maxnumericsubtag))) 141 #+ppc64target 142 (cond ((= typecode ppc64::tagfixnum) t) 143 ((= typecode ppc64::subtagsinglefloat) t) 144 ((= typecode ppc64::subtagbignum) t) 145 ((= typecode ppc64::subtagdoublefloat) t) 146 ((= typecode ppc64::subtagratio) t) 147 ((= typecode ppc64::subtagcomplex t))))) 131 148 132 149 (defun arrayp (x) 133 150 "Return true if OBJECT is an ARRAY, and NIL otherwise." 134 (>= (the fixnum (typecode x)) ppc32::minarraysubtag))151 (>= (the fixnum (typecode x)) target::minarraysubtag)) 135 152 136 153 (defun vectorp (x) 137 154 "Return true if OBJECT is a VECTOR, and NIL otherwise." 138 (>= (the fixnum (typecode x)) ppc32::minvectorsubtag))155 (>= (the fixnum (typecode x)) target::minvectorsubtag)) 139 156 140 157 … … 143 160 (let* ((typecode (typecode x))) 144 161 (declare (fixnum typecode)) 145 (if (= typecode ppc32::subtagvectorH)146 (setq typecode (ldb ppc32::arrayH.flagscellsubtagbyte (the fixnum (%svref x ppc32::arrayH.flagscell)))))147 (= typecode ppc32::subtagsimplebasestring)))162 (if (= typecode target::subtagvectorH) 163 (setq typecode (ldb target::arrayH.flagscellsubtagbyte (the fixnum (%svref x target::arrayH.flagscell))))) 164 (= typecode target::subtagsimplebasestring))) 148 165 149 166 150 167 (defun simplebasestringp (x) 151 (= (the fixnum (typecode x)) ppc32::subtagsimplebasestring))168 (= (the fixnum (typecode x)) target::subtagsimplebasestring)) 152 169 153 170 (defun simplestringp (x) 154 171 "Return true if OBJECT is a SIMPLESTRING, and NIL otherwise." 155 (= (the fixnum (typecode x)) ppc32::subtagsimplebasestring))172 (= (the fixnum (typecode x)) target::subtagsimplebasestring)) 156 173 157 174 (defun complexarrayp (x) 158 175 (let* ((typecode (typecode x))) 159 176 (declare (fixnum typecode)) 160 (if (or (= typecode ppc32::subtagarrayH)161 (= typecode ppc32::subtagvectorH))177 (if (or (= typecode target::subtagarrayH) 178 (= typecode target::subtagvectorH)) 162 179 (not (%arrayheadersimplep x))))) 163 180 … … 169 186 (let* ((typecode (typecode thing))) 170 187 (declare (fixnum typecode)) 171 (if (or (= typecode ppc32::subtagarrayH)172 (= typecode ppc32::subtagvectorH))188 (if (or (= typecode target::subtagarrayH) 189 (= typecode target::subtagvectorH)) 173 190 (%arrayheadersimplep thing) 174 (> typecode ppc32::subtagvectorH))))191 (> typecode target::subtagvectorH)))) 175 192 176 193 (defun macptrp (x) 177 (= (the fixnum (typecode x)) ppc32::subtagmacptr))194 (= (the fixnum (typecode x)) target::subtagmacptr)) 178 195 179 196 … … 181 198 ;;; things that it wasn't true of on the 68K. 182 199 (defun gvectorp (x) 183 (= (the fixnum (logand (the fixnum (typecode x)) ppc32::fulltagmask)) ppc32::fulltagnodeheader)) 200 #+ppc32target 201 (= (the fixnum (logand (the fixnum (typecode x)) ppc32::fulltagmask)) ppc32::fulltagnodeheader) 202 #+ppc64target 203 (= (the fixnum (logand (the fixnum (typecode x)) ppc64::lowtagmask)) ppc64::lowtagnodeheader)) 204 184 205 185 206 (setf (typepredicate 'gvector) 'gvectorp) 186 207 187 208 (defun ivectorp (x) 188 (= (the fixnum (logand (the fixnum (typecode x)) ppc32::fulltagmask)) 189 ppc32::fulltagimmheader)) 209 #+ppc32target 210 (= (the fixnum (logand (the fixnum (typecode x)) ppc32::fulltagmask)) 211 ppc32::fulltagimmheader) 212 #+ppc64target 213 (= (the fixnum (logand (the fixnum (typecode x)) ppc64::lowtagmask)) ppc64::lowtagimmheader)) 190 214 191 215 (setf (typepredicate 'ivector) 'ivectorp) … … 200 224 (defun simplevectorp (x) 201 225 "Return true if OBJECT is a SIMPLEVECTOR, and NIL otherwise." 202 (= (the fixnum (typecode x)) ppc32::subtagsimplevector))226 (= (the fixnum (typecode x)) target::subtagsimplevector)) 203 227 204 228 (defun basestringp (thing) 205 229 (let* ((typecode (typecode thing))) 206 230 (declare (fixnum typecode)) 207 (or (= typecode ppc32::subtagsimplebasestring)208 (and (= typecode ppc32::subtagvectorh)231 (or (= typecode target::subtagsimplebasestring) 232 (and (= typecode target::subtagvectorh) 209 233 (= (the fixnum 210 (ldb ppc32::arrayH.flagscellsubtagbyte (the fixnum (%svref thing ppc32::arrayH.flagscell))))211 ppc32::subtagsimplebasestring)))))234 (ldb target::arrayH.flagscellsubtagbyte (the fixnum (%svref thing target::arrayH.flagscell)))) 235 target::subtagsimplebasestring))))) 212 236 213 237 (defun simplebitvectorp (form) 214 238 "Return true if OBJECT is a SIMPLEBITVECTOR, and NIL otherwise." 215 (= (the fixnum (typecode form)) ppc32::subtagbitvector))239 (= (the fixnum (typecode form)) target::subtagbitvector)) 216 240 217 241 (defun bitvectorp (thing) … … 219 243 (let* ((typecode (typecode thing))) 220 244 (declare (fixnum typecode)) 221 (or (= typecode ppc32::subtagbitvector)222 (and (= typecode ppc32::subtagvectorh)245 (or (= typecode target::subtagbitvector) 246 (and (= typecode target::subtagvectorh) 223 247 (= (the fixnum 224 (ldb ppc32::arrayH.flagscellsubtagbyte (the fixnum (%svref thing ppc32::arrayH.flagscell))))225 ppc32::subtagbitvector)))))248 (ldb target::arrayH.flagscellsubtagbyte (the fixnum (%svref thing target::arrayH.flagscell)))) 249 target::subtagbitvector))))) 226 250 227 251 (defun displacedarrayp (array) 228 252 (if (%arrayisheader array) 229 (do* ((disp (%svref array ppc32::arrayH.displacementcell)230 (+ disp (the fixnum (%svref target ppc32::arrayH.displacementcell))))231 (target (%svref array ppc32::arrayH.datavectorcell)232 (%svref target ppc32::arrayH.datavectorcell)))253 (do* ((disp (%svref array target::arrayH.displacementcell) 254 (+ disp (the fixnum (%svref target target::arrayH.displacementcell)))) 255 (target (%svref array target::arrayH.datavectorcell) 256 (%svref target target::arrayH.datavectorcell))) 233 257 ((not (%arrayisheader target)) 234 258 (values target disp))) … … 325 349 (return)))))))))))) 326 350 351 #+ppc32target 327 352 (defparameter *nodeheadertypes* 328 353 #(bogus ; 0 … … 360 385 )) 361 386 387 #+ppc32target 362 388 (defparameter *immheadertypes* 363 389 #(bignum ; 0 … … 399 425 400 426 401 427 #+ppc32target 402 428 (defun %typeof (thing) 403 429 (let* ((typecode (typecode thing)))
Note: See TracChangeset
for help on using the changeset viewer.