Changeset 3838 for trunk/ccl/level0/l0pred.lisp
 Timestamp:
 Mar 18, 2006, 6:25:16 AM (14 years ago)
 File:

 1 edited
Legend:
 Unmodified
 Added
 Removed

trunk/ccl/level0/l0pred.lisp
r3567 r3838 697 697 698 698 699 699 700 #+x8664target 700 (evalwhen (:compiletoplevel) 701 (warn "Need %typeof support for x8664.")) 702 703 701 (progn 702 (defparameter *nodeheader0types* 703 #(functionvector 704 symbolvector 705 catchframe 706 hashvector 707 pool 708 population 709 package 710 slotvector 711 lispthread ;8 712 vectorheader 713 bogus 714 bogus 715 bogus 716 bogus 717 bogus 718 bogus 719 )) 720 721 (defparameter *nodeheader1types* 722 #(ratio 723 complex 724 instance 725 struct 726 istruct 727 valuecell 728 xfunction 729 lock ;7 730 arrayheader 731 simplevector 732 bogus 733 bogus 734 bogus 735 bogus 736 bogus 737 bogus 738 )) 739 740 (defparameter *immheader0types* 741 #(bogus 742 bogus 743 bogus 744 bogus 745 bogus 746 bogus 747 bogus 748 bogus 749 bogus 750 bogus 751 simplesignedwordvector 752 simpleunsignedwordvector 753 simplebasestring 754 simplesignedbytevector 755 simpleunsignedbytevector 756 bitvector)) 757 758 (defparameter *immheader1types* 759 #(bignum 760 doublefloat 761 xcodevector 762 bogus 763 bogus 764 bogus 765 bogus 766 bogus 767 bogus 768 bogus 769 bogus 770 bogus 771 bogus 772 simplesignedlongvector 773 simpleunsignedlongvector 774 singlefloatvector)) 775 776 (defparameter *immheader2types* 777 #(macptr 778 deadmacptr 779 bogus 780 bogus 781 bogus 782 bogus 783 bogus 784 bogus 785 bogus 786 bogus 787 bogus 788 bogus 789 bogus 790 simplesigneddoublewordvector 791 simpleunsigneddoublewordvector 792 doublefloatvector)) 793 794 795 (defparameter *x8664fulltagtypes* ()) 796 (setq *x8664fulltagtypes* 797 (let* ((fixnums #16(fixnum)) 798 (tra #16(taggedreturnaddress))) 799 (vector fixnums 800 #(singlefloat immediate immediate immediate 801 immediate immediate immediate immediate 802 immediate immediate immediate immediate 803 immediate immediate immediate immediate) 804 #(basechar immediate immediate immediate 805 immediate immediate immediate immediate 806 immediate immediate immediate immediate 807 immediate immediate immediate immediate) 808 #16(list) 809 tra 810 *nodeheader0types* 811 *nodeheader1types* 812 *immheader0types* 813 fixnums 814 *immheader1types* 815 *immheader2types* 816 #16(null) 817 tra 818 #16(bogus) 819 #16(symbol)))) 820 821 (defun %typeof (thing) 822 (let* ((fulltag (fulltag thing)) 823 (high4 (ash (the fixnum (%lisplowbyteref thing)) ( x8664::ntagbits)))) 824 (declare (fixnum fulltag high4)) 825 (if (= fulltag x8664::fulltagfunction) 826 (let ((bits (lfunbits thing))) 827 (declare (fixnum bits)) 828 (if (logbitp $lfbitstrampolinebit bits) 829 (if (logbitp $lfbitsevaluatedbit bits) 830 'interpretedlexicalclosure 831 (let ((innerfn (closurefunction thing))) 832 (if (neq innerfn thing) 833 (let ((innerbits (lfunbits innerfn))) 834 (if (logbitp $lfbitsmethodbit innerbits) 835 'compiledlexicalclosure 836 (if (logbitp $lfbitsgfnbit innerbits) 837 'standardgenericfunction ; not precisely  see classof 838 (if (logbitp $lfbitscmbit innerbits) 839 'combinedmethod 840 'compiledlexicalclosure)))) 841 'compiledlexicalclosure))) 842 (if (logbitp $lfbitsevaluatedbit bits) 843 (if (logbitp $lfbitsmethodbit bits) 844 'interpretedmethodfunction 845 'interpretedfunction) 846 (if (logbitp $lfbitsmethodbit bits) 847 'methodfunction 848 'compiledfunction)))) 849 (%svref (%svref *x8664fulltagtypes* fulltag) high4)))) 850 851 );#+x8664target 852 704 853 705 854 ;;; real machine specific huh
Note: See TracChangeset
for help on using the changeset viewer.