Changeset 1627 for trunk/ccl/level0/l0pred.lisp
 Timestamp:
 Jun 3, 2005, 2:03:18 PM (14 years ago)
 File:

 1 edited
Legend:
 Unmodified
 Added
 Removed

trunk/ccl/level0/l0pred.lisp
r1596 r1627 415 415 simplesignedbytevector ; 25 416 416 simplebasestring ; 26 417 *unused*; 27417 bogus ; 27 418 418 simpleunsignedwordvector ; 28 419 419 simplesignedwordvector ; 29 … … 476 476 type))))))))))) 477 477 478 #+ppc64target 479 (defparameter *immheadertypes* 480 #(bogus 481 bogus 482 codevector 483 bogus 484 bogus 485 bogus 486 xcodevector 487 macptr 488 bogus 489 bogus 490 bignum 491 deadmacptr 492 bogus 493 bogus 494 doublefloat 495 bogus 496 bogus 497 bogus 498 bogus 499 bogus 500 bogus 501 bogus 502 bogus 503 bogus 504 bogus 505 bogus 506 bogus 507 bogus 508 bogus 509 bogus 510 bogus 511 bogus 512 bogus 513 bogus 514 bogus 515 bogus 516 simplesignedbytevector 517 simplesignedwordvector 518 simplesignedlongvector 519 simplesigneddoublewordvector 520 simpleunsignedbytevector 521 simpleunsignedwordvector 522 simpleunsignedlongvector 523 simpleunsigneddoublewordvector 524 bogus 525 bogus 526 simpleshortfloatvector 527 bogus 528 bogus 529 bogus 530 bogus 531 simpledoublefloatvector 532 simplebasestring 533 bogus 534 bogus 535 bogus 536 bogus 537 bogus 538 bogus 539 bogus 540 bogus 541 simplebitvector 542 bogus 543 bogus)) 544 545 #+ppc64target 546 (defparameter *nodeheadertypes* 547 #(function 548 catchframe 549 slotvector 550 bogus 551 symbol 552 lispthread 553 standardinstance 554 bogus 555 bogus 556 lock 557 structure 558 bogus 559 bogus 560 hashvector 561 internalstructure 562 bogus 563 bogus 564 pool 565 valuecell 566 bogus 567 bogus 568 population 569 xfunction 570 bogus 571 bogus 572 package 573 ratio 574 bogus 575 bogus 576 svar 577 complex 578 bogus 579 bogus 580 arrayheader 581 vectorheader 582 simplevector 583 bogus 584 bogus 585 bogus 586 bogus 587 bogus 588 bogus 589 bogus 590 bogus 591 bogus 592 bogus 593 bogus 594 bogus 595 bogus 596 bogus 597 bogus 598 bogus 599 bogus 600 bogus 601 bogus 602 bogus 603 bogus 604 bogus 605 bogus 606 bogus 607 bogus 608 bogus 609 bogus 610 bogus 611 ) 612 ) 613 614 #+ppc64target 615 (defun %typeof (thing) 616 (let* ((typecode (typecode thing))) 617 (declare (fixnum typecode)) 618 (cond ((= typecode ppc64::tagfixnum) 'fixnum) 619 ((= typecode ppc64::fulltagcons) 'cons) 620 ((= typecode ppc64::subtagcharacter) 'character) 621 ((= typecode ppc64::subtagsinglefloat) 'shortfloat) 622 (t (let* ((lowtag (logand typecode ppc64::lowtagmask))) 623 (declare (fixnum lowtag)) 624 (cond ((= lowtag ppc64::lowtagimmheader) 625 (%svref *immheadertypes* (ash typecode 2))) 626 ((= lowtag ppc64::lowtagnodeheader) 627 (let* ((type (%svref *nodeheadertypes* 628 (ash typecode 2)))) 629 (cond ((eq type 'function) 630 (let ((bits (lfunbits thing))) 631 (declare (fixnum bits)) 632 (if (logbitp $lfbitstrampolinebit bits) 633 (if (logbitp $lfbitsevaluatedbit bits) 634 'interpretedlexicalclosure 635 (let ((innerfn (closurefunction thing))) 636 (if (neq innerfn thing) 637 (let ((innerbits (lfunbits innerfn))) 638 (if (logbitp $lfbitsmethodbit innerbits) 639 'compiledlexicalclosure 640 (if (logbitp $lfbitsgfnbit innerbits) 641 'standardgenericfunction ; not precisely  see classof 642 (if (logbitp $lfbitscmbit innerbits) 643 'combinedmethod 644 'compiledlexicalclosure)))) 645 'compiledlexicalclosure))) 646 (if (logbitp $lfbitsevaluatedbit bits) 647 (if (logbitp $lfbitsmethodbit bits) 648 'interpretedmethodfunction 649 'interpretedfunction) 650 (if (logbitp $lfbitsmethodbit bits) 651 'methodfunction 652 'compiledfunction))))) 653 ((eq type 'lock) 654 (or (uvref thing ppc64::lock.kindcell) 655 type)) 656 (t type)))) 657 (t 'immediate))))))) 658 478 659 479 660 ;;; real machine specific huh
Note: See TracChangeset
for help on using the changeset viewer.