Menu
▾
▴
[Sbcl-commits] CVS: sbcl/src/compiler/x86 alloc.lisp,1.12.2.1,1.12.2.2 call.lisp,1.26,1.26.6.1 macros.lisp,1.20,1.20.6.1
|
From: Alexey D. <ade...@us...> - 2004-09-09 06:19:09
|
Update of /cvsroot/sbcl/sbcl/src/compiler/x86 In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv5841/src/compiler/x86 Modified Files: Tag: sbcl-0-8-13-dx alloc.lisp call.lisp macros.lisp Log Message: 0.8.13-dx.2: * Differ UVL and DX LVARs in IR1 component printout. * %LISTIFY-REST-ARGS treats DX in the same way as LIST. * Replace (SETF (FUN-INFO-STACK-ALLOCATE-RESULT ...)) with DEFOPTIMIZER. * DEFOPTIMIZER interns FUN-INFO-* into SB[!-]C. * Physenv analysis does not insert %DYNAMIC-EXTENT-END when not needed. * Pull Christophe[?] out of hell: replace *DYNAMIC-EXTENT* hack with MAYBE-PSEUDO-ATOMIC macro. * Changed representation of LVAR-DYNAMIC-EXTENT: now it is a CLEANUP or NULL. * LET-variable substitution does not break stack allocation. * DX propagation in SUBSTITUTE-LVAR-USES. Index: alloc.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/compiler/x86/alloc.lisp,v retrieving revision 1.12.2.1 retrieving revision 1.12.2.2 diff -u -d -r1.12.2.1 -r1.12.2.2 --- alloc.lisp 8 Aug 2004 05:44:15 -0000 1.12.2.1 +++ alloc.lisp 9 Sep 2004 06:18:59 -0000 1.12.2.2 @@ -12,6 +12,10 @@ (in-package "SB!VM") ;;;; LIST and LIST* +(defoptimizer (list stack-allocate-result) ((&rest args)) + (not (null args))) +(defoptimizer (list* stack-allocate-result) ((&rest args)) + (not (null (rest args)))) (define-vop (list-or-list*) (:args (things :more t)) Index: call.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/compiler/x86/call.lisp,v retrieving revision 1.26 retrieving revision 1.26.6.1 diff -u -d -r1.26 -r1.26.6.1 --- call.lisp 30 Mar 2004 16:58:28 -0000 1.26 +++ call.lisp 9 Sep 2004 06:18:59 -0000 1.26.6.1 @@ -1260,13 +1260,15 @@ ;;; Turn more arg (context, count) into a list. +(defoptimizer (%listify-rest-args stack-allocate-result) ((&rest args)) + t) + (define-vop (listify-rest-args) (:translate %listify-rest-args) (:policy :safe) (:args (context :scs (descriptor-reg) :target src) (count :scs (any-reg) :target ecx)) - (:info *dynamic-extent*) - (:arg-types * tagged-num (:constant t)) + (:arg-types * tagged-num) (:temporary (:sc unsigned-reg :offset esi-offset :from (:argument 0)) src) (:temporary (:sc unsigned-reg :offset ecx-offset :from (:argument 1)) ecx) (:temporary (:sc unsigned-reg :offset eax-offset) eax) @@ -1276,15 +1278,16 @@ (:generator 20 (let ((enter (gen-label)) (loop (gen-label)) - (done (gen-label))) + (done (gen-label)) + (stack-allocate-p (node-stack-allocate-p node))) (move src context) (move ecx count) ;; Check to see whether there are no args, and just return NIL if so. (inst mov result nil-value) (inst jecxz done) (inst lea dst (make-ea :dword :index ecx :scale 2)) - (pseudo-atomic - (allocation dst dst node *dynamic-extent*) + (maybe-pseudo-atomic stack-allocate-p + (allocation dst dst node stack-allocate-p) (inst lea dst (make-ea :byte :base dst :disp list-pointer-lowtag)) ;; Convert the count into a raw value, so that we can use the ;; LOOP instruction. Index: macros.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/compiler/x86/macros.lisp,v retrieving revision 1.20 retrieving revision 1.20.6.1 diff -u -d -r1.20 -r1.20.6.1 --- macros.lisp 30 Mar 2004 16:58:28 -0000 1.20 +++ macros.lisp 9 Sep 2004 06:18:59 -0000 1.20.6.1 @@ -321,79 +321,78 @@ ;;; does not matter whether a signal occurs during construction of a ;;; dynamic-extent object, as the half-finished construction of the ;;; object will not cause any difficulty. We can therefore elide -(defvar *dynamic-extent* nil) +(defmacro maybe-pseudo-atomic (really-p &body forms) + `(if ,really-p + (progn ,@forms) + (pseudo-atomic ,@forms))) #!+sb-thread (defmacro pseudo-atomic (&rest forms) (with-unique-names (label) - `(if *dynamic-extent* ; I will burn in hell - (progn ,@forms) - (let ((,label (gen-label))) - (inst fs-segment-prefix) - (inst mov (make-ea :byte - :disp (* 4 thread-pseudo-atomic-interrupted-slot)) 0) - (inst fs-segment-prefix) - (inst mov (make-ea :byte :disp (* 4 thread-pseudo-atomic-atomic-slot)) 1) - ,@forms - (inst fs-segment-prefix) - (inst mov (make-ea :byte :disp (* 4 thread-pseudo-atomic-atomic-slot)) 0) - (inst fs-segment-prefix) - (inst cmp (make-ea :byte - :disp (* 4 thread-pseudo-atomic-interrupted-slot)) 0) - (inst jmp :eq ,label) - ;; if PAI was set, interrupts were disabled at the same - ;; time using the process signal mask. - (inst break pending-interrupt-trap) - (emit-label ,label))))) + `(let ((,label (gen-label))) + (inst fs-segment-prefix) + (inst mov (make-ea :byte + :disp (* 4 thread-pseudo-atomic-interrupted-slot)) 0) + (inst fs-segment-prefix) + (inst mov (make-ea :byte :disp (* 4 thread-pseudo-atomic-atomic-slot)) 1) + ,@forms + (inst fs-segment-prefix) + (inst mov (make-ea :byte :disp (* 4 thread-pseudo-atomic-atomic-slot)) 0) + (inst fs-segment-prefix) + (inst cmp (make-ea :byte + :disp (* 4 thread-pseudo-atomic-interrupted-slot)) 0) + (inst jmp :eq ,label) + ;; if PAI was set, interrupts were disabled at the same + ;; time using the process signal mask. + (inst break pending-interrupt-trap) + (emit-label ,label)))) #!-sb-thread (defmacro pseudo-atomic (&rest forms) (with-unique-names (label) - `(if *dynamic-extent* - (progn ,@forms) - (let ((,label (gen-label))) - ;; FIXME: The MAKE-EA noise should become a MACROLET macro - ;; or something. (perhaps SVLB, for static variable low - ;; byte) - (inst mov (make-ea :byte :disp (+ nil-value - (static-symbol-offset - '*pseudo-atomic-interrupted*) - (ash symbol-value-slot word-shift) - ;; FIXME: Use mask, not minus, to - ;; take out type bits. - (- other-pointer-lowtag))) - 0) - (inst mov (make-ea :byte :disp (+ nil-value - (static-symbol-offset - '*pseudo-atomic-atomic*) - (ash symbol-value-slot word-shift) - (- other-pointer-lowtag))) - (fixnumize 1)) - ,@forms - (inst mov (make-ea :byte :disp (+ nil-value - (static-symbol-offset - '*pseudo-atomic-atomic*) - (ash symbol-value-slot word-shift) - (- other-pointer-lowtag))) - 0) - ;; KLUDGE: Is there any requirement for interrupts to be - ;; handled in order? It seems as though an interrupt coming - ;; in at this point will be executed before any pending - ;; interrupts. Or do incoming interrupts check to see - ;; whether any interrupts are pending? I wish I could find - ;; the documentation for pseudo-atomics.. -- WHN 19991130 - (inst cmp (make-ea :byte - :disp (+ nil-value - (static-symbol-offset - '*pseudo-atomic-interrupted*) - (ash symbol-value-slot word-shift) - (- other-pointer-lowtag))) - 0) - (inst jmp :eq ,label) - ;; if PAI was set, interrupts were disabled at the same - ;; time using the process signal mask. - (inst break pending-interrupt-trap) - (emit-label ,label))))) + `(let ((,label (gen-label))) + ;; FIXME: The MAKE-EA noise should become a MACROLET macro + ;; or something. (perhaps SVLB, for static variable low + ;; byte) + (inst mov (make-ea :byte :disp (+ nil-value + (static-symbol-offset + '*pseudo-atomic-interrupted*) + (ash symbol-value-slot word-shift) + ;; FIXME: Use mask, not minus, to + ;; take out type bits. + (- other-pointer-lowtag))) + 0) + (inst mov (make-ea :byte :disp (+ nil-value + (static-symbol-offset + '*pseudo-atomic-atomic*) + (ash symbol-value-slot word-shift) + (- other-pointer-lowtag))) + (fixnumize 1)) + ,@forms + (inst mov (make-ea :byte :disp (+ nil-value + (static-symbol-offset + '*pseudo-atomic-atomic*) + (ash symbol-value-slot word-shift) + (- other-pointer-lowtag))) + 0) + ;; KLUDGE: Is there any requirement for interrupts to be + ;; handled in order? It seems as though an interrupt coming + ;; in at this point will be executed before any pending + ;; interrupts. Or do incoming interrupts check to see + ;; whether any interrupts are pending? I wish I could find + ;; the documentation for pseudo-atomics.. -- WHN 19991130 + (inst cmp (make-ea :byte + :disp (+ nil-value + (static-symbol-offset + '*pseudo-atomic-interrupted*) + (ash symbol-value-slot word-shift) + (- other-pointer-lowtag))) + 0) + (inst jmp :eq ,label) + ;; if PAI was set, interrupts were disabled at the same + ;; time using the process signal mask. + (inst break pending-interrupt-trap) + (emit-label ,label)))) ;;;; indexed references |