1.0.15.15: reset DF on x86 and x86-64 after every STD instead of when calling out
authorNikodemus Siivola <nikodemus@random-state.net>
Wed, 5 Mar 2008 15:11:18 +0000 (15:11 +0000)
committerNikodemus Siivola <nikodemus@random-state.net>
Wed, 5 Mar 2008 15:11:18 +0000 (15:11 +0000)
 * Both the old and the new behaviour should be correct re C-ABI, but
   this is much easier to audit. Thanks to Aurelien Jarno for the
   initial patch.

 * This should also fix the build on platforms with GCC 4.3 compiled
   libc signal handling functions, which assume DF to be cleared.

   ** NOTE ** If kernel/libc does not arrange for DF to be cleared
   before calling our handler and restore it afterwards, we can still
   be broken by asynch signals on post 4.3 GCC libcs -- but this Is
   Not Our Fault, We Think.

 * Test-case suggested by Alistair Bridgewater for possible related
   default-unknown-values problems on SunOS.

12 files changed:
src/assembly/x86-64/assem-rtns.lisp
src/assembly/x86/assem-rtns.lisp
src/compiler/x86-64/call.lisp
src/compiler/x86-64/nlx.lisp
src/compiler/x86-64/values.lisp
src/compiler/x86/call.lisp
src/compiler/x86/nlx.lisp
src/compiler/x86/values.lisp
src/runtime/x86-64-assem.S
src/runtime/x86-assem.S
tests/compiler.impure.lisp
version.lisp-expr

index c3f8d3c..9083075 100644 (file)
@@ -54,6 +54,7 @@
   (inst lea edi (make-ea :qword :base ebx :disp (- n-word-bytes)))
   (inst rep)
   (inst movs :qword)
+  (inst cld)
 
   ;; Restore the count.
   (inst mov ecx edx)
   (inst sub esi (fixnumize 1))
   (inst rep)
   (inst movs :qword)
+  (inst cld)
 
   ;; Load the register arguments carefully.
   (loadw edx rbp-tn -1)
   (inst push ebx)
 
   ;; And jump into the function.
-    (inst jmp
-          (make-ea :byte :base eax
-                   :disp (- (* closure-fun-slot n-word-bytes)
-                            fun-pointer-lowtag)))
+  (inst jmp
+        (make-ea :byte :base eax
+                 :disp (- (* closure-fun-slot n-word-bytes)
+                          fun-pointer-lowtag)))
 
   ;; All the arguments fit in registers, so load them.
   REGISTER-ARGS
index 9465ceb..489316e 100644 (file)
@@ -54,9 +54,7 @@
   (inst lea edi (make-ea :dword :base ebx :disp (- n-word-bytes)))
   (inst rep)
   (inst movs :dword)
-
-  ;; solaris requires DF being zero.
-  #!+sunos (inst cld)
+  (inst cld)
 
   ;; Restore the count.
   (inst mov ecx edx)
   (inst sub esi (fixnumize 1))
   (inst rep)
   (inst movs :dword)
-
-  ;; solaris requires DF being zero.
-  #!+sunos (inst cld)
+  (inst cld)
 
   ;; Load the register arguments carefully.
   (loadw edx ebp-tn -1)
index 4242c99..8e1da4d 100644 (file)
       ;; Restore EDI, and reset the stack.
       (emit-label restore-edi)
       (loadw rdi-tn rbx-tn (- (1+ 1)))
-      (inst mov rsp-tn rbx-tn))))
+      (inst mov rsp-tn rbx-tn)
+      (inst cld))))
   (values))
 \f
 ;;;; unknown values receiving
        (inst sub rcx 1)
        (inst jmp :nz loop)
        ;; NIL out the last cons.
-       (storew nil-value dst 1 list-pointer-lowtag))
+       (storew nil-value dst 1 list-pointer-lowtag)
+       (inst cld))
       (emit-label done))))
 
 ;;; Return the location and size of the &MORE arg glob created by
index 96cf3f8..5425b3b 100644 (file)
     (inst std)
     (inst rep)
     (inst movs :qword)
-
+    (inst cld)
     DONE
     ;; Reset the CSP at last moved arg.
     (inst lea rsp-tn (make-ea :qword :base rdi :disp n-word-bytes))))
index 92f7027..c135c83 100644 (file)
@@ -38,6 +38,7 @@
     (inst movs :qword)
     (inst cmp rsp-tn rsi)
     (inst jmp :be LOOP)
+    (inst cld)
     DONE
     (inst lea rsp-tn (make-ea :qword :base rdi :disp n-word-bytes))
     (inst sub rdi rsi)
index 6b88449..982a3c1 100644 (file)
       ;; Restore EDI, and reset the stack.
       (emit-label restore-edi)
       (loadw edi-tn ebx-tn (frame-word-offset 1))
-      (inst mov esp-tn ebx-tn))))
+      (inst mov esp-tn ebx-tn)
+      (inst cld))))
   (values))
 \f
 ;;;; unknown values receiving
        (inst sub ecx 1)
        (inst jmp :nz loop)
        ;; NIL out the last cons.
-       (storew nil-value dst 1 list-pointer-lowtag))
+       (storew nil-value dst 1 list-pointer-lowtag)
+       (inst cld))
       (emit-label done))))
 
 ;;; Return the location and size of the &MORE arg glob created by
index 5a1314c..1447f4c 100644 (file)
     (inst std)
     (inst rep)
     (inst movs :dword)
-
+    (inst cld)
     DONE
     ;; Reset the CSP at last moved arg.
     (inst lea esp-tn (make-ea :dword :base edi :disp n-word-bytes))))
index 9519b22..f6b4df8 100644 (file)
@@ -38,6 +38,7 @@
     (inst movs :dword)
     (inst cmp esp-tn esi)
     (inst jmp :be loop)
+    (inst cld)
     DONE
     (inst lea esp-tn (make-ea :dword :base edi :disp n-word-bytes))
     (inst sub edi esi)
index 42d21da..02cbf26 100644 (file)
        .globl  GNAME(call_into_c)
        TYPE(GNAME(call_into_c))
 GNAME(call_into_c):
-        /* ABI requires that the direction flag be clear on function
-         * entry and exit. */
-        cld
        push    %rbp            # Save old frame pointer.
        mov     %rsp,%rbp       # Establish new frame.
 
@@ -241,10 +238,6 @@ LsingleValue:
        pop     %r12
        pop     %rbx
 
-        /* ABI requires that the direction flag be clear on function
-         * entry and exit. */
-        cld
-        
 /* FIXME Restore the NPX state. */
 
        /* return value is already in rax where lisp expects it */
index 1afa6ee..e90f972 100644 (file)
@@ -122,9 +122,6 @@ GNAME(call_into_c):
        fstp    %st(0)
        fstp    %st(0)
 
-       cld                       # clear out DF: Darwin, Solaris and Win32 at
-                                 # least need this, and it should not hurt others
-
        call    *%eax             # normal callout using Lisp stack
        movl    %eax,%ecx         # remember integer return value
 
@@ -443,14 +440,12 @@ GNAME(do_pending_interrupt):
         andl    $0xfffffff0,%esp;  /* Align stack            */ \
         pushl   $0;                /* Padding                */ \
         pushl   size;              /* Argument to alloc      */ \
-        cld;                       /* Clear DF               */ \
         call    GNAME(alloc);                                   \
         movl    %ebp,%esp;         /* Restore ESP from EBP   */ \
         popl    %ebp;              /* Restore EBP            */
 #else
 #define ALLOC(size)                                             \
         pushl   size;              /* Argument to alloc      */ \
-        cld;                       /* Clear DF               */ \
         call    GNAME(alloc);                                   \
         addl    $4,%esp;           /* Pop argument           */
 #endif
@@ -872,7 +867,6 @@ GNAME(fast_bzero_base):
         xor %eax, %eax            /* Zero EAX */
         shr $2, %ecx              /* Amount of 4-byte blocks to copy */
         jz  Lend_base
-        cld                       /* Set direction of STOSL to increment */
 
         rep
         stosl                     /* Store EAX to *EDI, ECX times, incrementing
index fa098af..cb6ec00 100644 (file)
   (sb-ext:code-deletion-note (e)
     (error e)))
 
+;;; unknown values return convention getting disproportionate
+;;; amounts of values.
+(declaim (notinline one-value two-values))
+(defun one-value (x)
+  (not x))
+(defun two-values (x y)
+  (values y x))
+(defun wants-many-values (x y)
+  (multiple-value-bind (a b c d e f)
+      (one-value y)
+    (assert (and (eql (not y) a)
+                 (not (or b c d e f)))))
+  (multiple-value-bind (a b c d e f)
+      (two-values y x)
+    (assert (and (eql a x) (eql b y)
+                 (not (or c d e f)))))
+  (multiple-value-bind (a b c d e f g h i)
+      (one-value y)
+    (assert (and (eql (not y) a)
+                 (not (or b c d e f g h i)))))
+  (multiple-value-bind (a b c d e f g h i)
+      (two-values y x)
+    (assert (and (eql a x) (eql b y)
+                 (not (or c d e f g h i)))))
+  (multiple-value-bind (a b c d e f g h i j k l m n o p q r s)
+      (one-value y)
+    (assert (and (eql (not y) a)
+                 (not (or b c d e f g h i j k l m n o p q r s)))))
+  (multiple-value-bind (a b c d e f g h i j k l m n o p q r s)
+      (two-values y x)
+    (assert (and (eql a x) (eql b y)
+                 (not (or c d e f g h i j k l m n o p q r s))))))
+(wants-many-values 1 42)
+
 ;;; success
index fa11b4d..370f8a0 100644 (file)
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.15.14"
+"1.0.15.15"