diff --git a/compiler/disassem.lisp b/compiler/disassem.lisp index 8b948e992e4bda0219c815bcaf311854d58fc39e..7f196ac496e5a04a7c091b8c4d28af044f01365c 100644 --- a/compiler/disassem.lisp +++ b/compiler/disassem.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/disassem.lisp,v 1.45 2004/11/10 18:38:59 emarsden Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/disassem.lisp,v 1.46 2005/02/07 17:27:16 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -2085,9 +2085,9 @@ ;;; ---------------------------------------------------------------- (defun lra-hook (chunk stream dstate) + (declare (ignore stream)) (declare (type dchunk chunk) (ignore chunk) - (type (or null stream) stream) (type disassem-state dstate)) (when (and (aligned-p (+ (seg-virtual-location (dstate-segment dstate)) (dstate-cur-offs dstate)) @@ -2899,6 +2899,7 @@ (type (or null di:debug-function) debug-function) (type (or null source-form-cache) sfcache)) (let ((last-block-pc -1) + #+nil (segment-base (- (seg-virtual-location segment) (sys:sap-int diff --git a/compiler/sparc/insts.lisp b/compiler/sparc/insts.lisp index bc1944b81620642d57262b790752b8dcf019d904..0d280dd3ee385cebc6f2b8016253f30f7a2ace70 100644 --- a/compiler/sparc/insts.lisp +++ b/compiler/sparc/insts.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/sparc/insts.lisp,v 1.50 2004/09/13 00:41:54 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/sparc/insts.lisp,v 1.51 2005/02/07 17:27:17 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -317,32 +317,30 @@ about function addresses and register values.") dstate))))))) (defun handle-or-inst (rs1 immed-val rd dstate immed-p) - (let* ((sethi (assoc rs1 *note-sethi-inst*))) - (cond - ((= rs1 alloc-offset) - ;; OR %ALLOC, n. This must be some allocation or - ;; pseudo-atomic stuff - (cond ((and immed-p - (= immed-val pseudo-atomic-value) - (= rd alloc-offset) - (not *pseudo-atomic-set*)) - ;; "OR 4, %ALLOC" sets the flag - (disassem:note "Set pseudo-atomic flag" dstate) - (setf *pseudo-atomic-set* t))))))) + (cond + ((= rs1 alloc-offset) + ;; OR %ALLOC, n. This must be some allocation or + ;; pseudo-atomic stuff + (cond ((and immed-p + (= immed-val pseudo-atomic-value) + (= rd alloc-offset) + (not *pseudo-atomic-set*)) + ;; "OR 4, %ALLOC" sets the flag + (disassem:note "Set pseudo-atomic flag" dstate) + (setf *pseudo-atomic-set* t)))))) (defun handle-andn-inst (rs1 immed-val rd dstate immed-p) - (let* ((sethi (assoc rs1 *note-sethi-inst*))) - (cond - ((= rs1 alloc-offset) - ;; ANDN %ALLOC, n. Resetting pseudo-atomic - (cond ((and immed-p - (= immed-val pseudo-atomic-value) - (= rd alloc-offset) - *pseudo-atomic-set*) - ;; "ANDN 4, %ALLOC" resets the flag - ;;(format t "Got reset~%") - (disassem:note "Reset pseudo-atomic flag" dstate) - (setf *pseudo-atomic-set* nil))))))) + (cond + ((= rs1 alloc-offset) + ;; ANDN %ALLOC, n. Resetting pseudo-atomic + (cond ((and immed-p + (= immed-val pseudo-atomic-value) + (= rd alloc-offset) + *pseudo-atomic-set*) + ;; "ANDN 4, %ALLOC" resets the flag + ;;(format t "Got reset~%") + (disassem:note "Reset pseudo-atomic flag" dstate) + (setf *pseudo-atomic-set* nil)))))) (defun handle-jmpl-inst (rs1 immed-val rd dstate) (declare (ignore rd)) diff --git a/compiler/srctran.lisp b/compiler/srctran.lisp index 09afeccba01e67f134aedbb0a7d3045e77b89a15..b4a2bc18abc1d6592581c3767c9c414e6b934487 100644 --- a/compiler/srctran.lisp +++ b/compiler/srctran.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/srctran.lisp,v 1.154 2005/01/06 17:32:07 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/srctran.lisp,v 1.155 2005/02/07 17:27:16 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -2582,23 +2582,30 @@ (lognot-derive-type-aux (logior-derive-type-aux x y same-leaf))) #'lognor)) + +;; We should do something better for these. (logandc1 x x) is 0, for +;; example. (defoptimizer (logandc1 derive-type) ((x y)) (two-arg-derive-type x y (lambda (x y same-leaf) + (declare (ignore same-leaf)) (logand-derive-type-aux (lognot-derive-type-aux x) y nil)) #'logandc1)) (defoptimizer (logandc2 derive-type) ((x y)) (two-arg-derive-type x y (lambda (x y same-leaf) + (declare (ignore same-leaf)) (logand-derive-type-aux x (lognot-derive-type-aux y) nil)) #'logandc2)) (defoptimizer (logorc1 derive-type) ((x y)) (two-arg-derive-type x y (lambda (x y same-leaf) + (declare (ignore same-leaf)) (logior-derive-type-aux (lognot-derive-type-aux x) y nil)) #'logorc1)) (defoptimizer (logorc2 derive-type) ((x y)) (two-arg-derive-type x y (lambda (x y same-leaf) + (declare (ignore same-leaf)) (logior-derive-type-aux x (lognot-derive-type-aux y) nil)) #'logorc2)) diff --git a/compiler/typetran.lisp b/compiler/typetran.lisp index 2badef9e2ee5b916ffd3cfa793e56b7dfa35bc06..96324cd6ef0dc0562f6e0d9b9ae2d812de6148bb 100644 --- a/compiler/typetran.lisp +++ b/compiler/typetran.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/typetran.lisp,v 1.44 2003/07/03 18:44:03 gerd Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/typetran.lisp,v 1.45 2005/02/07 17:27:16 rtoy Rel $") ;;; ;;; ********************************************************************** ;;; @@ -274,7 +274,6 @@ ;;; (defun source-transform-union-typep (object type) (let* ((types (union-type-types type)) - (list-type (specifier-type 'list)) (cons-type (specifier-type 'cons)) (mtype (find-if #'member-type-p types)) (members (when mtype (member-type-members mtype))))