Changeset 11602
 Timestamp:
 01/29/09 20:23:51 (13 years ago)
 File:

 1 edited
Legend:
 Unmodified
 Added
 Removed

trunk/abcl/src/org/armedbear/lisp/compilerpass2.lisp
r11601 r11602 499 499 (setf prettystring (concatenate 'string prettystring "[]"))) 500 500 prettystring)) 501 502 (defvar typerepresentations '((:int fixnum) 503 (:long (integer #.mostnegativejavalong 504 #.mostpositivejavalong)) 505 (:float singlefloat) 506 (:double doublefloat) 507 (:char basechar character) 508 (:boolean boolean) 509 ) 510 "Lists the widest Lisp types to be stored in each of the Java primitives 511 supported (and used) by the compiler.") 512 513 (defun typerepresentation (thetype) 514 "Converts a type specification or compiler type into a representation." 515 (do* ((types typerepresentations (cdr types))) 516 ((endp types) nil) 517 (do* ((typelist (cdr (car types)) (cdr typelist)) 518 (type (car typelist) (car typelist))) 519 ((endp typelist)) 520 (when (or (subtypep thetype type) 521 (compilersubtypep thetype (makecompilertype type))) 522 (returnfrom typerepresentation (caar types)))))) 501 523 502 524 ;; source type / … … 6832 6854 arg2 nil nil) 6833 6855 (emitmovefromstack target representation)) 6834 ( (and (fixnumtypep type1) (fixnumtypep type2))6835 (fixnumresultplus/minus target representation resulttype 6836 arg1 arg2 'iadd 'ladd)) 6837 ((and (javalongtypep type1)6838 (javalongtypep type2)6839 (javalongtypep resulttype))6840 (cond ((fixnumtypep type1)6841 (compileform arg1 'stack :int)6842 (emit 'i2l))6856 (resultrep 6857 (compileformsandmaybeemitclearvalues 6858 arg1 'stack resultrep 6859 arg2 'stack resultrep) 6860 (emit (case resultrep 6861 (:int 'iadd) 6862 (:long 'ladd) 6863 (:float 'fadd) 6864 (:double 'dadd) 6843 6865 (t 6844 (compileform arg1 'stack :long))) 6845 (cond ((fixnumtypep type2) 6846 (compileform arg2 'stack :int) 6847 (emit 'i2l)) 6848 (t 6849 (compileform arg2 'stack :long))) 6850 (maybeemitclearvalues arg1 arg2) 6851 (emit 'ladd) 6852 (convertrepresentation :long representation) 6866 (sys::format 6867 t "p2plus: Unexpected resultrep ~S for form ~S." 6868 resultrep form) 6869 (assert nil)))) 6870 (convertrepresentation resultrep representation) 6853 6871 (emitmovefromstack target representation)) 6854 6872 ((eql arg2 1) … … 6881 6899 (2 6882 6900 (let* ((arg (%cadr form)) 6883 (type (derivecompilertype arg))) 6884 (cond ((eql (fixnumconstantvalue type) 0) 6885 (case representation 6886 (:int 6887 (emit 'iconst_0)) 6888 (:long 6889 (emit 'lconst_0)) 6890 (t 6891 (emit 'getstatic +lispfixnumclass+ "ZERO" +lispfixnum+))) 6901 (type (derivecompilertype form)) 6902 (typerep (typerepresentation type))) 6903 (cond ((numberp arg) 6904 (compileconstant ( arg) 'stack representation) 6892 6905 (emitmovefromstack target representation)) 6893 ((and (fixnumtypep type) 6894 (integertypelow type) 6895 (> (integertypelow type) mostnegativefixnum)) 6896 (newfixnum (null representation)) 6897 (compileform arg 'stack :int) 6898 (emit 'ineg) 6899 (emitfixnuminit representation) 6900 (emitmovefromstack target representation)) 6901 ((and (javalongtypep type) 6902 (integertypelow type) 6903 (> (integertypelow type) mostnegativejavalong)) 6904 (compileform arg 'stack :long) 6905 (emit 'lneg) 6906 (case representation 6907 (:int 6908 (emit 'l2i)) 6909 (:long) 6906 (typerep 6907 (compileform arg 'stack typerep) 6908 (emit (case typerep 6909 (:int 'ineg) 6910 (:long 'lneg) 6911 (:float 'fneg) 6912 (:double 'dneg) 6910 6913 (t 6911 (convertrepresentation :long nil))) 6914 (sys::format t 6915 "p2minus: unsupported rep (~S) for '~S'~%" 6916 typerep form) 6917 (assert nil)))) 6918 (convertrepresentation typerep representation) 6912 6919 (emitmovefromstack target representation)) 6913 6920 (t … … 6921 6928 (arg1 (first args)) 6922 6929 (arg2 (second args)) 6923 (type1 (derivecompilertype arg1))6924 6930 (type2 (derivecompilertype arg2)) 6925 (resulttype (derivecompilertype form))) 6931 (resulttype (derivecompilertype form)) 6932 (resultrep (typerepresentation resulttype))) 6926 6933 (cond ((and (numberp arg1) (numberp arg2)) 6927 6934 (compileconstant ( arg1 arg2) target representation)) 6928 ((and (fixnumtypep type1) (fixnumtypep type2)) 6929 (fixnumresultplus/minus target representation resulttype 6930 arg1 arg2 'isub 'lsub)) 6931 ((and (javalongtypep type1) (javalongtypep type2) 6932 (javalongtypep resulttype)) 6933 (compileformsandmaybeemitclearvalues arg1 'stack :long 6934 arg2 'stack :long) 6935 (emit 'lsub) 6936 (convertrepresentation :long representation) 6935 (resultrep 6936 (compileformsandmaybeemitclearvalues 6937 arg1 'stack resultrep 6938 arg2 'stack resultrep) 6939 (emit (case resultrep 6940 (:int 'isub) 6941 (:long 'lsub) 6942 (:float 'fsub) 6943 (:double 'dsub) 6944 (t 6945 (sys::%format t "p2minus subinstruction (rep: ~S); form: ~S~%" 6946 resultrep form) 6947 (assert nil)))) 6948 (convertrepresentation resultrep representation) 6937 6949 (emitmovefromstack target representation)) 6938 6950 ((fixnumtypep type2)
Note: See TracChangeset
for help on using the changeset viewer.