Changeset 11634
 Timestamp:
 02/06/09 21:00:45 (12 years ago)
 File:

 1 edited
Legend:
 Unmodified
 Added
 Removed

trunk/abcl/src/org/armedbear/lisp/compilerpass2.lisp
r11633 r11634 6741 6741 (defknown p2min/max (t t t) t) 6742 6742 (defun p2min/max (form target representation) 6743 (cond ((= (length form) 3) 6744 (let* ((op (%car form)) 6745 (args (%cdr form)) 6746 (arg1 (%car args)) 6747 (arg2 (%cadr args))) 6748 (when (null target) 6749 (compileformsandmaybeemitclearvalues arg1 nil nil 6750 arg2 nil nil) 6751 (returnfrom p2min/max)) 6752 (when (notinlinep op) 6753 (compilefunctioncall form target representation) 6754 (returnfrom p2min/max)) 6755 (let ((type1 (derivecompilertype arg1)) 6756 (type2 (derivecompilertype arg2))) 6757 (cond ((and (fixnumtypep type1) (fixnumtypep type2)) 6758 (compileform arg1 'stack :int) 6759 (emit 'dup) 6760 (compileform arg2 'stack :int) 6761 (emit 'dup_x1) 6762 (let ((LABEL1 (gensym))) 6763 (emit (if (eq op 'max) 'if_icmpge 'if_icmple) LABEL1) 6764 (emit 'swap) ;; The lower stack value is greaterorequal 6765 (label LABEL1) 6766 (emit 'pop)) ;; Throw away the lower stack value 6767 (convertrepresentation :int representation) 6768 (emitmovefromstack target representation)) 6769 ((and (javalongtypep type1) (javalongtypep type2)) 6770 (compileform arg1 'stack :long) 6771 (emit 'dup2) 6772 (compileform arg2 'stack :long) 6773 (emit 'dup2_x2) 6774 (emit 'lcmp) 6775 (let ((LABEL1 (gensym))) 6776 (emit (if (eq op 'max) 'ifge 'ifle) LABEL1) 6777 (emit 'dup2_x2) ;; pourmans swap2 6778 (emit 'pop2) 6779 (label LABEL1) 6780 (emit 'pop2)) 6781 (convertrepresentation :long representation) 6782 (emitmovefromstack target representation)) 6783 (t 6784 (compileform arg1 'stack nil) 6785 (emit 'dup) 6786 (compileform arg2 'stack nil) 6787 (emit 'dup_x1) 6788 (emitinvokevirtual +lispobjectclass+ 6789 (if (eq op 'max) 6790 "isLessThanOrEqualTo" 6791 "isGreaterThanOrEqualTo") 6792 (lispobjectargtypes 1) "Z") 6793 (let ((LABEL1 (gensym))) 6794 (emit 'ifeq LABEL1) 6795 (emit 'swap) 6796 (label LABEL1) 6797 (emit 'pop)) 6798 (fixboxing representation nil) 6799 (emitmovefromstack target representation)))))) 6800 (t 6801 (compilefunctioncall form target representation)))) 6743 (case (length form) 6744 (1 (error 'programerror "Wrong number of arguments for ~A." (car form))) 6745 (2 (compileform (cadr form) target representation)) 6746 (3 (let* ((op (%car form)) 6747 (args (%cdr form)) 6748 (arg1 (%car args)) 6749 (arg2 (%cadr args))) 6750 (when (null target) 6751 (compileformsandmaybeemitclearvalues arg1 nil nil 6752 arg2 nil nil) 6753 (returnfrom p2min/max)) 6754 (when (notinlinep op) 6755 (compilefunctioncall form target representation) 6756 (returnfrom p2min/max)) 6757 (let ((type1 (derivecompilertype arg1)) 6758 (type2 (derivecompilertype arg2))) 6759 (cond ((and (fixnumtypep type1) (fixnumtypep type2)) 6760 (compileform arg1 'stack :int) 6761 (emit 'dup) 6762 (compileform arg2 'stack :int) 6763 (emit 'dup_x1) 6764 (let ((LABEL1 (gensym))) 6765 (emit (if (eq op 'max) 'if_icmpge 'if_icmple) LABEL1) 6766 (emit 'swap) ;; The lower stack value is greaterorequal 6767 (label LABEL1) 6768 (emit 'pop)) ;; Throw away the lower stack value 6769 (convertrepresentation :int representation) 6770 (emitmovefromstack target representation)) 6771 ((and (javalongtypep type1) (javalongtypep type2)) 6772 (compileform arg1 'stack :long) 6773 (emit 'dup2) 6774 (compileform arg2 'stack :long) 6775 (emit 'dup2_x2) 6776 (emit 'lcmp) 6777 (let ((LABEL1 (gensym))) 6778 (emit (if (eq op 'max) 'ifge 'ifle) LABEL1) 6779 (emit 'dup2_x2) ;; pourmans swap2 6780 (emit 'pop2) 6781 (label LABEL1) 6782 (emit 'pop2)) 6783 (convertrepresentation :long representation) 6784 (emitmovefromstack target representation)) 6785 (t 6786 (compileform arg1 'stack nil) 6787 (emit 'dup) 6788 (compileform arg2 'stack nil) 6789 (emit 'dup_x1) 6790 (emitinvokevirtual +lispobjectclass+ 6791 (if (eq op 'max) 6792 "isLessThanOrEqualTo" 6793 "isGreaterThanOrEqualTo") 6794 (lispobjectargtypes 1) "Z") 6795 (let ((LABEL1 (gensym))) 6796 (emit 'ifeq LABEL1) 6797 (emit 'swap) 6798 (label LABEL1) 6799 (emit 'pop)) 6800 (fixboxing representation nil) 6801 (emitmovefromstack target representation)))))) 6802 (t 6803 (p2min/max `(,(car form) (,(car form) (second form) (third form)) 6804 ,@(nthcdr 3 form)) target representation)))) 6802 6805 6803 6806 (defun p2plus (form target representation)
Note: See TracChangeset
for help on using the changeset viewer.