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