Changeset 1326 for trunk/ccl/level0/l0pred.lisp
 Timestamp:
 May 10, 2005, 6:36:37 AM (14 years ago)
 File:

 1 edited
Legend:
 Unmodified
 Added
 Removed

trunk/ccl/level0/l0pred.lisp
r964 r1326 245 245 (defun hairyequal (x y) 246 246 (declare (optimize (speed 3))) 247 ; X and Y are not EQL, and are both of tag ppc32::fulltagmisc.247 ;; X and Y are not EQL, and are both of tag target::fulltagmisc. 248 248 (let* ((xtype (typecode x)) 249 249 (ytype (typecode y))) 250 250 (declare (fixnum xtype ytype)) 251 (if (and (>= xtype ppc32::subtagvectorH)252 (>= ytype ppc32::subtagvectorH))253 (let* ((xsimple (if (= xtype ppc32::subtagvectorH)254 (ldb ppc32::arrayH.flagscellsubtagbyte255 (the fixnum (%svref x ppc32::arrayH.flagscell)))251 (if (and (>= xtype target::subtagvectorH) 252 (>= ytype target::subtagvectorH)) 253 (let* ((xsimple (if (= xtype target::subtagvectorH) 254 (ldb target::arrayH.flagscellsubtagbyte 255 (the fixnum (%svref x target::arrayH.flagscell))) 256 256 xtype)) 257 (ysimple (if (= ytype ppc32::subtagvectorH)258 (ldb ppc32::arrayH.flagscellsubtagbyte259 (the fixnum (%svref y ppc32::arrayH.flagscell)))257 (ysimple (if (= ytype target::subtagvectorH) 258 (ldb target::arrayH.flagscellsubtagbyte 259 (the fixnum (%svref y target::arrayH.flagscell))) 260 260 ytype))) 261 261 (declare (fixnum xsimple ysimple)) 262 (if (= xsimple ppc32::subtagsimplebasestring)263 (if (= ysimple ppc32::subtagsimplebasestring)262 (if (= xsimple target::subtagsimplebasestring) 263 (if (= ysimple target::subtagsimplebasestring) 264 264 (locally 265 265 (declare (optimize (speed 3) (safety 0))) 266 (let* ((xlen (if (= xtype ppc32::subtagvectorH)267 (%svref x ppc32::vectorH.logsizecell)266 (let* ((xlen (if (= xtype target::subtagvectorH) 267 (%svref x target::vectorH.logsizecell) 268 268 (uvsize x))) 269 269 (xpos 0) 270 (ylen (if (= ytype ppc32::subtagvectorH)271 (%svref y ppc32::vectorH.logsizecell)270 (ylen (if (= ytype target::subtagvectorH) 271 (%svref y target::vectorH.logsizecell) 272 272 (uvsize y))) 273 273 (ypos 0)) 274 274 (declare (fixnum xlen xpos ylen ypos)) 275 (when (= xtype ppc32::subtagvectorH)275 (when (= xtype target::subtagvectorH) 276 276 (multiplevaluesetq (x xpos) (arraydataandoffset x))) 277 (when (= ytype ppc32::subtagvectorH)277 (when (= ytype target::subtagvectorH) 278 278 (multiplevaluesetq (y ypos) (arraydataandoffset y))) 279 279 (%simplestring= x y xpos ypos (the fixnum (+ xpos xlen)) (the fixnum (+ ypos ylen)))))) 280 280 ;;Bitvector case or fail. 281 (and (= xsimple ppc32::subtagbitvector)282 (= ysimple ppc32::subtagbitvector)281 (and (= xsimple target::subtagbitvector) 282 (= ysimple target::subtagbitvector) 283 283 (locally 284 284 (declare (optimize (speed 3) (safety 0))) 285 (let* ((xlen (if (= xtype ppc32::subtagvectorH)286 (%svref x ppc32::vectorH.logsizecell)285 (let* ((xlen (if (= xtype target::subtagvectorH) 286 (%svref x target::vectorH.logsizecell) 287 287 (uvsize x))) 288 288 (xpos 0) 289 (ylen (if (= ytype ppc32::subtagvectorH)290 (%svref y ppc32::vectorH.logsizecell)289 (ylen (if (= ytype target::subtagvectorH) 290 (%svref y target::vectorH.logsizecell) 291 291 (uvsize y))) 292 292 (ypos 0)) 293 293 (declare (fixnum xlen xpos ylen ypos)) 294 294 (when (= xlen ylen) 295 (when (= xtype ppc32::subtagvectorH)295 (when (= xtype target::subtagvectorH) 296 296 (multiplevaluesetq (x xpos) (arraydataandoffset x))) 297 (when (= ytype ppc32::subtagvectorH)297 (when (= ytype target::subtagvectorH) 298 298 (multiplevaluesetq (y ypos) (arraydataandoffset y))) 299 299 (do* ((i 0 (1+ i))) … … 305 305 (incf ypos)))))))) 306 306 (if (= xtype ytype) 307 (if (= xtype ppc32::subtagistruct)307 (if (= xtype target::subtagistruct) 308 308 (and (let* ((structname (%svref x 0))) 309 309 (and (eq structname (%svref y 0)) … … 365 365 creoleobject ; 6 366 366 ;; 820 are unused 367 xcodevec or; 7367 xcodevector ; 7 368 368 bogus ; 8 369 369 bogus ; 9 … … 464 464 (defun structurep (form) 465 465 "True if the given object is a named structure, Nil otherwise." 466 (= (the fixnum (typecode form)) ppc32::subtagstruct))466 (= (the fixnum (typecode form)) target::subtagstruct)) 467 467 468 468 (defun istructp (form) 469 (= (the fixnum (typecode form)) ppc32::subtagistruct))469 (= (the fixnum (typecode form)) target::subtagistruct)) 470 470 471 471 (defun structuretypep (thing type) 472 (if (= (the fixnum (typecode thing)) ppc32::subtagstruct)472 (if (= (the fixnum (typecode thing)) target::subtagstruct) 473 473 (if (memq type (%svref thing 0)) 474 474 t))) … … 476 476 477 477 (defun istructtypep (thing type) 478 (if (= (the fixnum (typecode thing)) ppc32::subtagistruct)478 (if (= (the fixnum (typecode thing)) target::subtagistruct) 479 479 (eq (%svref thing 0) type))) 480 480 … … 482 482 "Return true if OBJECT is a SYMBOL, and NIL otherwise." 483 483 (if thing 484 (= (the fixnum (typecode thing)) ppc32::subtagsymbol)484 (= (the fixnum (typecode thing)) target::subtagsymbol) 485 485 t)) 486 486 487 487 (defun packagep (thing) 488 (= (the fixnum (typecode thing)) ppc32::subtagpackage))488 (= (the fixnum (typecode thing)) target::subtagpackage)) 489 489 490 490 ; 1 if by land, 2 if by sea. 491 491 (defun sequencetype (x) 492 (unless (>= (the fixnum (typecode x)) ppc32::minvectorsubtag)492 (unless (>= (the fixnum (typecode x)) target::minvectorsubtag) 493 493 (or (listp x) 494 494 (reportbadarg x 'sequence)))) 495 495 496 496 (defun uvectorp (x) 497 (= (the fixnum ( lisptag x)) ppc32::tagmisc))497 (= (the fixnum (fulltag x)) target::fulltagmisc)) 498 498 499 499 (setf (typepredicate 'uvector) 'uvectorp)
Note: See TracChangeset
for help on using the changeset viewer.