From e420c35c88b438df825fa92b36685982d7bfe967 Mon Sep 17 00:00:00 2001
From: dtc <dtc>
Date: Mon, 17 Jan 2000 16:46:10 +0000
Subject: [PATCH] Replace scrub-control-stack with an inlined VOP on the x86
 port. The VOP takes care to decrease the stack pointer as the stack is
 scrubbed, which allows a grow-down control stack to be used on Linux.

---
 code/lispinit.lisp       | 48 ++++++++--------------------------------
 compiler/x86/system.lisp | 44 +++++++++++++++++++++++++++++++++---
 2 files changed, 50 insertions(+), 42 deletions(-)

diff --git a/code/lispinit.lisp b/code/lispinit.lisp
index 584752f44..10a07c90c 100644
--- a/code/lispinit.lisp
+++ b/code/lispinit.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/code/lispinit.lisp,v 1.58 1999/12/04 16:02:35 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/lispinit.lisp,v 1.59 2000/01/17 16:45:56 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -499,47 +499,17 @@
       (scrub (int-sap (- csp initial-offset))
 	     (* (floor initial-offset vm:word-bytes) vm:word-bytes)
 	     0))))
-
-#+x86 ;; Stack grows downwards
+
+;;; Scrub-control-stack.
+;;;
+;;; On the x86 port the stack grows downwards, and to support grow on
+;;; demand stacks the stack must be decreased as it is scrubbed.
+;;;
+#+x86
 (defun scrub-control-stack ()
   "Zero the unused portion of the control stack so that old objects are not
    kept alive because of uninitialized stack variables."
-  (declare (optimize (speed 3) (safety 0))
-	   (values (unsigned-byte 20)))
-  (labels
-      ((scrub (ptr offset count)
-	 (declare (type system-area-pointer ptr)
-		  (type (unsigned-byte 16) offset)
-		  (type (unsigned-byte 20) count)
-		  (values (unsigned-byte 20)))
-	 (let ((loc (int-sap (- (sap-int ptr) (+ offset vm:word-bytes)))))
-	   (cond ((= offset bytes-per-scrub-unit)
-		  (look (int-sap (- (sap-int ptr) bytes-per-scrub-unit))
-			0 count))
-		 (t ;; need to fix bug in %set-stack-ref
-		  (setf (sap-ref-32 loc 0) 0)
-		  (scrub ptr (+ offset vm:word-bytes) count)))))
-       (look (ptr offset count)
-	 (declare (type system-area-pointer ptr)
-		  (type (unsigned-byte 16) offset)
-		  (type (unsigned-byte 20) count)
-		  (values (unsigned-byte 20)))
-	 (let ((loc (int-sap (- (sap-int ptr) offset))))
-	   (cond ((= offset bytes-per-scrub-unit)
-		  count)
-		 ((zerop (kernel::get-lisp-obj-address (stack-ref loc 0)))
-;		 ((zerop (stack-ref loc 0))
-		  (look ptr (+ offset vm:word-bytes) count))
-		 (t
-		  (scrub ptr offset (+ count vm:word-bytes)))))))
-    (let* ((csp (sap-int (c::control-stack-pointer-sap)))
-	   (initial-offset (logand csp (1- bytes-per-scrub-unit))))
-      (declare (type (unsigned-byte 32) csp))
-      (scrub (int-sap (+ csp initial-offset))
-	     (* (floor initial-offset vm:word-bytes) vm:word-bytes)
-	     0))))
-
-
+  (scrub-control-stack))
 
 
 ;;;; TOP-LEVEL loop.
diff --git a/compiler/x86/system.lisp b/compiler/x86/system.lisp
index 0eaf2690f..4d3cc1601 100644
--- a/compiler/x86/system.lisp
+++ b/compiler/x86/system.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
- "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/system.lisp,v 1.9 1998/02/19 19:35:07 dtc Exp $")
+ "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/x86/system.lisp,v 1.10 2000/01/17 16:46:10 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -16,7 +16,7 @@
 ;;; Written by William Lott.
 ;;;
 ;;; Debugged by Paul F. Werkowski Spring/Summer 1995.
-;;; Enhancements/debugging by Douglas T. Crosher 1996, 1997, 1998.
+;;; Enhancements/debugging by Douglas T. Crosher 1996,1997,1998,1999.
 ;;;
 
 (in-package :x86)
@@ -311,6 +311,45 @@
 		       :disp (- (* (+ vector-data-offset index) word-bytes)
 				other-pointer-type)))))
 
+
+
+(defknown sys:scrub-control-stack () (values))
+
+;;; Scrub the control stack.
+;;;
+;;; On the x86 port the stack grows downwards, and to support grow on
+;;; demand stacks the stack must be decreased as it is scrubbed.
+;;;
+(define-vop (scrub-control-stack)
+  (:policy :fast-safe)
+  (:translate sys:scrub-control-stack)
+  (:args)
+  (:results)
+  (:temporary (:sc unsigned-reg) count)
+  (:temporary (:sc any-reg) stack-save zero)
+  (:generator 25
+    (inst mov stack-save esp-tn)
+    (inst mov zero 0)
+    (inst push zero)
+    ;; Scrub the stack.
+    SCRUB
+    (inst add esp-tn 4)
+    (inst mov count 2048)
+    SCRUB-LOOP
+    (inst dec count)
+    (inst push zero)
+    (inst jmp :nz SCRUB-LOOP)
+    ;; Look for a clear stack unit.
+    (inst mov count 2048)
+    LOOK-LOOP
+    (inst sub esp-tn 4)
+    (inst cmp (make-ea :dword :base esp-tn) zero)
+    (inst jmp :ne SCRUB)
+    (inst dec count)
+    (inst jmp :nz LOOK-LOOP)
+    ;; Done, restore the stack pointer.
+    (inst mov esp-tn stack-save)))
+
 
 ;;;; Primitive multi-thread support.
 
@@ -520,4 +559,3 @@
     ;; Pop the frame pointer, and resume at the return address.
     (inst pop ebp-tn)
     (inst ret)))
-
-- 
GitLab