From a6c61ba848e9ed11118b6fb579fe237d0b1cf9c6 Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola Date: Sun, 6 May 2007 17:56:27 +0000 Subject: [PATCH] 1.0.5.35: stack alignment on x86/Darwin, once more * Stack alignment cannot be changed after arguments have been pushed on stack: ALLOCATE-NUMBER-STACK-SPACE is the place to do this, and nowhere else. * Use the RESET-STACK-POINTER logic on all x86 platforms for simplicity. * Factor out the alignment logic to ALIGN-STACK-POINTER. * Clear DF unconditionally when calling out, which means that Solaris doesn't need to switch it back and forth. (Darwin, Solaris, and Win32 all need DF cleared for call-out.) --- package-data-list.lisp-expr | 4 +- src/compiler/aliencomp.lisp | 66 +++++++++++++++++-------------- src/compiler/x86/c-call.lisp | 31 +++------------ src/compiler/x86/call.lisp | 10 +---- src/compiler/x86/macros.lisp | 6 +++ src/compiler/x86/nlx.lisp | 2 - src/compiler/x86/show.lisp | 28 +++++++------ src/compiler/x86/values.lisp | 5 +-- src/runtime/x86-assem.S | 15 +++---- tests/foreign-stack-alignment.impure.lisp | 3 +- version.lisp-expr | 2 +- 11 files changed, 79 insertions(+), 93 deletions(-) diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr index 94bd9568b..c4fb513cf 100644 --- a/package-data-list.lisp-expr +++ b/package-data-list.lisp-expr @@ -220,6 +220,7 @@ of SBCL which maintained the CMU-CL-style split into two packages.)" #!+x86 "SET-FPU-WORD-FOR-C" #!+x86 "SET-FPU-WORD-FOR-LISP" + "ALIGN-STACK-POINTER" "ALLOC-ALIEN-STACK-SPACE" "ALLOC-NUMBER-STACK-SPACE" "ALLOCATE-CODE-OBJECT" "ALLOCATE-FRAME" "ALLOCATE-DYNAMIC-CODE-OBJECT" "ALLOCATE-FULL-CALL-FRAME" @@ -248,7 +249,8 @@ of SBCL which maintained the CMU-CL-style split into two packages.)" "COMPONENT-INFO" "COMPONENT-LIVE-TN" "COMPUTE-FUN" "COMPUTE-OLD-NFP" "COPY-MORE-ARG" "CURRENT-BINDING-POINTER" "CURRENT-NFP-TN" - "CURRENT-STACK-POINTER" "DEALLOC-ALIEN-STACK-SPACE" + "CURRENT-STACK-POINTER" + "DEALLOC-ALIEN-STACK-SPACE" "DEALLOC-NUMBER-STACK-SPACE" "DEBUG-CATCH-TAG" "DEF-IR1-TRANSLATOR" diff --git a/src/compiler/aliencomp.lisp b/src/compiler/aliencomp.lisp index 3299c2108..7cd63584c 100644 --- a/src/compiler/aliencomp.lisp +++ b/src/compiler/aliencomp.lisp @@ -348,14 +348,16 @@ (/noshow (local-alien-info-force-to-memory-p info)) (/noshow alien-type (unparse-alien-type alien-type) (alien-type-bits alien-type)) (if (local-alien-info-force-to-memory-p info) - #!+(or x86 x86-64) `(truly-the system-area-pointer - (%primitive alloc-alien-stack-space - ,(ceiling (alien-type-bits alien-type) - sb!vm:n-byte-bits))) - #!-(or x86 x86-64) `(truly-the system-area-pointer - (%primitive alloc-number-stack-space - ,(ceiling (alien-type-bits alien-type) - sb!vm:n-byte-bits))) + #!+(or x86 x86-64) + `(truly-the system-area-pointer + (%primitive alloc-alien-stack-space + ,(ceiling (alien-type-bits alien-type) + sb!vm:n-byte-bits))) + #!-(or x86 x86-64) + `(truly-the system-area-pointer + (%primitive alloc-number-stack-space + ,(ceiling (alien-type-bits alien-type) + sb!vm:n-byte-bits))) (let* ((alien-rep-type-spec (compute-alien-rep-type alien-type)) (alien-rep-type (specifier-type alien-rep-type-spec))) (cond ((csubtypep (specifier-type 'system-area-pointer) @@ -700,11 +702,14 @@ (error "Something is broken."))) (lvar (node-lvar call)) (args args) - #!+(or (and x86 darwin) win32) (stack-pointer (make-stack-pointer-tn))) + #!+x86 + (stack-pointer (make-stack-pointer-tn))) (multiple-value-bind (nsp stack-frame-size arg-tns result-tns) (make-call-out-tns type) - #!+x86 (vop set-fpu-word-for-c call block) - #!+(or (and x86 darwin) win32) (vop current-stack-pointer call block stack-pointer) + #!+x86 + (progn + (vop set-fpu-word-for-c call block) + (vop current-stack-pointer call block stack-pointer)) (vop alloc-number-stack-space call block stack-frame-size nsp) (dolist (tn arg-tns) ;; On PPC, TN might be a list. This is used to indicate @@ -722,22 +727,22 @@ (unless (= (length move-arg-vops) 1) (error "no unique move-arg-vop for moves in SC ~S" (sc-name sc))) #!+(or x86 x86-64) (emit-move-arg-template call - block - (first move-arg-vops) - (lvar-tn call block arg) - nsp - first-tn) + block + (first move-arg-vops) + (lvar-tn call block arg) + nsp + first-tn) #!-(or x86 x86-64) (progn - (emit-move call - block - (lvar-tn call block arg) - temp-tn) - (emit-move-arg-template call - block - (first move-arg-vops) - temp-tn - nsp - first-tn)) + (emit-move call + block + (lvar-tn call block arg) + temp-tn) + (emit-move-arg-template call + block + (first move-arg-vops) + temp-tn + nsp + first-tn)) #!+(and ppc darwin) (when (listp tn) ;; This means that we have a float arg that we need to @@ -759,7 +764,10 @@ ((lvar-tn call block function) (reference-tn-list arg-tns nil)) ((reference-tn-list result-tns t)))) - #!-(or (and darwin x86) win32) (vop dealloc-number-stack-space call block stack-frame-size) - #!+(or (and darwin x86) win32) (vop reset-stack-pointer call block stack-pointer) - #!+x86 (vop set-fpu-word-for-lisp call block) + #!-x86 + (vop dealloc-number-stack-space call block stack-frame-size) + #!+x86 + (progn + (vop reset-stack-pointer call block stack-pointer) + (vop set-fpu-word-for-lisp call block)) (move-lvar-result call block result-tns lvar)))) diff --git a/src/compiler/x86/c-call.lisp b/src/compiler/x86/c-call.lisp index b23a605d0..f6de0debf 100644 --- a/src/compiler/x86/c-call.lisp +++ b/src/compiler/x86/c-call.lisp @@ -214,8 +214,6 @@ :from :eval :to :result) ecx) (:temporary (:sc unsigned-reg :offset edx-offset :from :eval :to :result) edx) - #!+darwin - (:temporary (:sc unsigned-reg :offset esi-offset) prev-esp) (:node-var node) (:vop-var vop) (:save-p t) @@ -233,23 +231,14 @@ (dotimes (i 8) (inst fstp fr0-tn)) - #!+win32 + ;; Clear out DF: Darwin, Windows, and Solaris at least require + ;; this, and it should not hurt others either. (inst cld) - #!+darwin - ;; Align stack for C. - (progn - (move prev-esp esp-tn) - (inst and esp-tn -16)) - (inst call function) - ;; To give the debugger a clue. XX not really internal-error? + ;; To give the debugger a clue. FIXME: not really internal-error? (note-this-location vop :internal-error) - #!+darwin - ;; Restore - (move esp-tn prev-esp) - ;; Restore the NPX for lisp; ensure no regs are empty (dotimes (i 7) (inst fldz)) @@ -257,8 +246,8 @@ (if (and results (location= (tn-ref-tn results) fr0-tn)) ;; The return result is in fr0. - (inst fxch fr7-tn) ; move the result back to fr0 - (inst fldz)) ; insure no regs are empty + (inst fxch fr7-tn) ; move the result back to fr0 + (inst fldz)) ; insure no regs are empty )))) ;;; While SBCL uses the FPU in 53-bit mode, most C libraries assume that @@ -295,17 +284,9 @@ (unless (zerop amount) (let ((delta (logandc2 (+ amount 3) 3))) (inst sub esp-tn delta))) - ;; C stack should probably be 16 byte aligned on Darwin - #!+darwin (inst and esp-tn -16) + (align-stack-pointer esp-tn) (move result esp-tn))) -(define-vop (dealloc-number-stack-space) - (:info amount) - (:generator 0 - (unless (zerop amount) - (let ((delta (logandc2 (+ amount 3) 3))) - (inst add esp-tn delta))))) - (define-vop (alloc-alien-stack-space) (:info amount) #!+sb-thread (:temporary (:sc unsigned-reg) temp) diff --git a/src/compiler/x86/call.lisp b/src/compiler/x86/call.lisp index 6bd5775cc..6b8844910 100644 --- a/src/compiler/x86/call.lisp +++ b/src/compiler/x86/call.lisp @@ -312,8 +312,6 @@ (inst mov eax-tn nil-value) (inst std) (inst mov ecx-tn (- nvals register-arg-count)) - ;; solaris requires DF being zero. - #!+sunos (inst cld) ;; Jump into the default loop. (inst jmp default-stack-vals) @@ -348,8 +346,6 @@ (inst std) (inst rep) (inst movs :dword) - ;; solaris requires DF being zero. - #!+sunos (inst cld) ;; Restore ESI. (loadw esi-tn ebx-tn (frame-word-offset 2)) ;; Now we have to default the remaining args. Find out how many. @@ -365,8 +361,6 @@ (emit-label default-stack-vals) (inst rep) (inst stos eax-tn) - ;; solaris requires DF being zero. - #!+sunos (inst cld) ;; Restore EDI, and reset the stack. (emit-label restore-edi) (loadw edi-tn ebx-tn (frame-word-offset 1)) @@ -1383,9 +1377,7 @@ (inst jmp :nz loop) ;; NIL out the last cons. (storew nil-value dst 1 list-pointer-lowtag)) - (emit-label done) - ;; solaris requires DF being zero. - #!+sunos (inst cld)))) + (emit-label done)))) ;;; Return the location and size of the &MORE arg glob created by ;;; COPY-MORE-ARG. SUPPLIED is the total number of arguments supplied diff --git a/src/compiler/x86/macros.lisp b/src/compiler/x86/macros.lisp index 10540ca3c..468efaaf2 100644 --- a/src/compiler/x86/macros.lisp +++ b/src/compiler/x86/macros.lisp @@ -46,6 +46,12 @@ `(unless (location= ,n-dst ,n-src) (inst mov ,n-dst ,n-src)))) +(defmacro align-stack-pointer (tn) + #!-darwin (declare (ignore tn)) + #!+darwin + ;; 16 byte alignment. + `(inst and ,tn #xfffffff0)) + (defmacro make-ea-for-object-slot (ptr slot lowtag &optional (size :dword)) `(make-ea ,size :base ,ptr :disp (- (* ,slot n-word-bytes) ,lowtag))) diff --git a/src/compiler/x86/nlx.lisp b/src/compiler/x86/nlx.lisp index 35760ab03..faf7c6576 100644 --- a/src/compiler/x86/nlx.lisp +++ b/src/compiler/x86/nlx.lisp @@ -239,8 +239,6 @@ (inst movs :dword) DONE - ;; solaris requires DF being zero. - #!+sunos (inst cld) ;; Reset the CSP at last moved arg. (inst lea esp-tn (make-ea :dword :base edi :disp n-word-bytes)))) diff --git a/src/compiler/x86/show.lisp b/src/compiler/x86/show.lisp index 5fb38b9b5..04b63e183 100644 --- a/src/compiler/x86/show.lisp +++ b/src/compiler/x86/show.lisp @@ -22,20 +22,26 @@ :from :eval :to (:result 0)) eax) - #!+darwin (:temporary (:sc unsigned-reg - :offset esi-offset) - prev-stack-pointer) + #!+darwin + (:temporary (:sc unsigned-reg + :offset esi-offset) + prev-stack-pointer) (:results (result :scs (descriptor-reg))) (:save-p t) (:generator 100 - ;; the stack should be 16-byte aligned on Darwin - #!-darwin (inst push object) - #!+darwin (progn (inst mov prev-stack-pointer esp-tn) - (inst sub esp-tn n-word-bytes) - (inst and esp-tn -16) - (storew object esp-tn)) + #!-darwin + (inst push object) + #!+darwin + (progn + ;; the stack should be 16-byte aligned on Darwin + (inst mov prev-stack-pointer esp-tn) + (inst sub esp-tn n-word-bytes) + (align-stack-pointer esp-tn) + (storew object esp-tn)) (inst lea eax (make-fixup "debug_print" :foreign)) (inst call (make-fixup "call_into_c" :foreign)) - #!-darwin (inst add esp-tn n-word-bytes) - #!+darwin (inst mov esp-tn prev-stack-pointer) + #!-darwin + (inst add esp-tn n-word-bytes) + #!+darwin + (inst mov esp-tn prev-stack-pointer) (move result eax))) diff --git a/src/compiler/x86/values.lisp b/src/compiler/x86/values.lisp index e1b9a5f6b..9519b2223 100644 --- a/src/compiler/x86/values.lisp +++ b/src/compiler/x86/values.lisp @@ -39,8 +39,6 @@ (inst cmp esp-tn esi) (inst jmp :be loop) DONE - ;; solaris requires DF being zero. - #!+sunos (inst cld) (inst lea esp-tn (make-ea :dword :base edi :disp n-word-bytes)) (inst sub edi esi) (loop for moved = moved-ptrs then (tn-ref-across moved) @@ -151,6 +149,5 @@ (inst jmp :nz LOOP) DONE - ;; solaris requires DF being zero. - #!+sunos (inst cld))) + )) diff --git a/src/runtime/x86-assem.S b/src/runtime/x86-assem.S index e1eba22f4..d5b3d4b81 100644 --- a/src/runtime/x86-assem.S +++ b/src/runtime/x86-assem.S @@ -122,16 +122,11 @@ GNAME(call_into_c): fstp %st(0) fstp %st(0) -#ifdef LISP_FEATURE_WIN32 - cld -#endif - -#ifdef LISP_FEATURE_DARWIN - andl $0xfffffff0,%esp # align stack to 16-byte boundary before calling C -#endif - call *%eax # normal callout using Lisp stack - - movl %eax,%ecx # remember integer return value + 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 /* Check for a return FP value. */ fxam diff --git a/tests/foreign-stack-alignment.impure.lisp b/tests/foreign-stack-alignment.impure.lisp index 0cd42cc4c..3900f6088 100644 --- a/tests/foreign-stack-alignment.impure.lisp +++ b/tests/foreign-stack-alignment.impure.lisp @@ -35,7 +35,8 @@ #+(and ppc linux) 8 #+x86-64 16 #+mips 8 - #+x86 4 + #+(and x86 (not darwin)) 4 + #+(and x86 darwin) 16 #-(or x86 x86-64 mips (and ppc (or darwin linux))) (error "Unknown platform")) ;;;; Build the offset-tool as regular excutable, and run it with diff --git a/version.lisp-expr b/version.lisp-expr index c5a474de4..e54b6d945 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -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.5.34" +"1.0.5.35" -- 2.11.4.GIT