From: Nathan F. <nf...@us...> - 2006-05-21 02:50:57
|
Update of /cvsroot/sbcl/sbcl/src/compiler/x86 In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv9499/src/compiler/x86 Modified Files: type-vops.lisp Log Message: 0.9.12.28: Micro-optimize type testing on x86 by doing a direct comparison with memory in the common case, which is slightly smaller. Index: type-vops.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/compiler/x86/type-vops.lisp,v retrieving revision 1.18 retrieving revision 1.19 diff -u -d -r1.18 -r1.19 --- type-vops.lisp 14 Jul 2005 19:13:48 -0000 1.18 +++ type-vops.lisp 21 May 2006 02:50:48 -0000 1.19 @@ -85,65 +85,77 @@ (values :ne :a :b drop-through target) (values :e :na :nb target drop-through)) (%test-lowtag value when-false t lowtag al-loaded) - (inst mov al-tn (make-ea :byte :base value :disp (- lowtag))) - (do ((remaining headers (cdr remaining))) - ((null remaining)) - (let ((header (car remaining)) - (last (null (cdr remaining)))) - (cond - ((atom header) - (cond - ((and (not last) (null (cddr remaining)) - (atom (cadr remaining)) - (= (logcount (logxor header (cadr remaining))) 1)) - ;; BASE-STRING, (VECTOR NIL), BIT-VECTOR, (VECTOR T) - (inst and al-tn (ldb (byte 8 0) (logeqv header (cadr remaining)))) - (inst cmp al-tn (ldb (byte 8 0) (logand header (cadr remaining)))) - (inst jmp equal target) - (return)) - (t - (inst cmp al-tn header) - (if last + (cond + ((and (null (cdr headers)) + (numberp (car headers))) + ;; Optimize the common case: referencing the value from memory + ;; is slightly smaller than loading it and then doing the + ;; comparison. Doing this for other cases (e.g. range of + ;; [BIGNUM-WIDETAG..FOO-WIDETAG]) is also possible, but such + ;; opportunities don't come up very often and the code would + ;; get pretty hairy... + (inst cmp (make-ea :byte :base value :disp (- lowtag)) (car headers)) + (inst jmp equal target)) + (t + (inst mov al-tn (make-ea :byte :base value :disp (- lowtag))) + (do ((remaining headers (cdr remaining))) + ((null remaining)) + (let ((header (car remaining)) + (last (null (cdr remaining)))) + (cond + ((atom header) + (cond + ((and (not last) (null (cddr remaining)) + (atom (cadr remaining)) + (= (logcount (logxor header (cadr remaining))) 1)) + ;; BASE-STRING, (VECTOR NIL), BIT-VECTOR, (VECTOR T) + (inst and al-tn (ldb (byte 8 0) (logeqv header (cadr remaining)))) + (inst cmp al-tn (ldb (byte 8 0) (logand header (cadr remaining)))) (inst jmp equal target) - (inst jmp :e when-true))))) - (t - (let ((start (car header)) - (end (cdr header))) - (cond - ;; LAST = don't need al-tn later - ((and last (not (= start bignum-widetag)) - (= (+ start 4) end) (= (logcount (logxor start end)) 1)) - ;; SIMPLE-STRING - (inst and al-tn (ldb (byte 8 0) (logeqv start end))) - (inst cmp al-tn (ldb (byte 8 0) (logand start end))) - (inst jmp equal target)) - ((and (not last) (null (cddr remaining)) - (= (+ start 4) end) (= (logcount (logxor start end)) 1) - (listp (cadr remaining)) - (= (+ (caadr remaining) 4) (cdadr remaining)) - (= (logcount (logxor (caadr remaining) (cdadr remaining))) 1) - (= (logcount (logxor (caadr remaining) start)) 1)) - ;; STRING - (inst and al-tn (ldb (byte 8 0) (logeqv start (cdadr remaining)))) - (inst cmp al-tn (ldb (byte 8 0) (logand start (cdadr remaining)))) - (inst jmp equal target) - ;; we've shortcircuited the DO, so we must return. - ;; It's OK to do so, because (NULL (CDDR REMAINING)) - ;; was true. - (return)) - (t - (unless (= start bignum-widetag) - (inst cmp al-tn start) - (if (= end complex-array-widetag) - (progn - (aver last) - (inst jmp greater-or-equal target)) - (inst jmp :b when-false))) ; was :l - (unless (= end complex-array-widetag) - (inst cmp al-tn end) - (if last - (inst jmp less-or-equal target) - (inst jmp :be when-true)))))))))) ; was :le + (return)) + (t + (inst cmp al-tn header) + (if last + (inst jmp equal target) + (inst jmp :e when-true))))) + (t + (let ((start (car header)) + (end (cdr header))) + (cond + ;; LAST = don't need al-tn later + ((and last (not (= start bignum-widetag)) + (= (+ start 4) end) (= (logcount (logxor start end)) 1)) + ;; SIMPLE-STRING + (inst and al-tn (ldb (byte 8 0) (logeqv start end))) + (inst cmp al-tn (ldb (byte 8 0) (logand start end))) + (inst jmp equal target)) + ((and (not last) (null (cddr remaining)) + (= (+ start 4) end) (= (logcount (logxor start end)) 1) + (listp (cadr remaining)) + (= (+ (caadr remaining) 4) (cdadr remaining)) + (= (logcount (logxor (caadr remaining) (cdadr remaining))) 1) + (= (logcount (logxor (caadr remaining) start)) 1)) + ;; STRING + (inst and al-tn (ldb (byte 8 0) (logeqv start (cdadr remaining)))) + (inst cmp al-tn (ldb (byte 8 0) (logand start (cdadr remaining)))) + (inst jmp equal target) + ;; we've shortcircuited the DO, so we must return. + ;; It's OK to do so, because (NULL (CDDR REMAINING)) + ;; was true. + (return)) + (t + (unless (= start bignum-widetag) + (inst cmp al-tn start) + (if (= end complex-array-widetag) + (progn + (aver last) + (inst jmp greater-or-equal target)) + (inst jmp :b when-false))) ; was :l + (unless (= end complex-array-widetag) + (inst cmp al-tn end) + (if last + (inst jmp less-or-equal target) + (inst jmp :be when-true)))))))))))) ; was :le (emit-label drop-through)))) ;;;; type checking and testing |