Skip to content
Snippets Groups Projects
Commit e420c35c authored by dtc's avatar dtc
Browse files

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.
parent 2c7724e8
No related branches found
No related tags found
No related merge requests found
......@@ -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.
......
......@@ -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)))
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment