/[cmucl]/src/code/lispinit.lisp
ViewVC logotype

Diff of /src/code/lispinit.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.24 by wlott, Fri Nov 29 22:58:52 1991 UTC revision 1.25 by wlott, Sun Dec 15 10:21:38 1991 UTC
# Line 35  Line 35 
35            coerece-to-exposecopy-event coerce-to-focuschange-event server            coerece-to-exposecopy-event coerce-to-focuschange-event server
36            *task-self* *task-data* *task-notify* with-interrupts            *task-self* *task-data* *task-notify* with-interrupts
37            with-enabled-interrupts enable-interrupt ignore-interrupt            with-enabled-interrupts enable-interrupt ignore-interrupt
38            default-interrupt))            default-interrupt scrub-control-stack))
39    
40  (in-package "EXTENSIONS")  (in-package "EXTENSIONS")
41  (export '(quit *prompt* save-lisp gc-on gc-off *clx-server-displays*))  (export '(quit *prompt* save-lisp gc-on gc-off *clx-server-displays*))
# Line 606  Line 606 
606    nil)    nil)
607    
608    
609    ;;;; SCRUB-CONTROL-STACK
610    
611    
612    (defconstant words-per-scrub-unit 512)
613    
614    (defun scrub-control-stack ()
615      "Zero the unused portion of the control stack so that old objects are not
616       kept alive because of uninitialized stack variables."
617      (declare (optimize (speed 3) (safety 0))
618               (values (unsigned-byte 20)))
619      (labels
620          ((scrub (ptr offset count)
621             (declare (type system-area-pointer ptr)
622                      (type (unsigned-byte 16) offset)
623                      (type (unsigned-byte 20) count)
624                      (values (unsigned-byte 20)))
625             (cond ((= offset words-per-scrub-unit)
626                    (look (sap+ ptr (* words-per-scrub-unit vm:word-bytes))
627                          0
628                          count))
629                   (t
630                    (setf (sap-ref-32 ptr offset) 0)
631                    (scrub ptr (1+ offset) count))))
632           (look (ptr offset count)
633             (declare (type system-area-pointer ptr)
634                      (type (unsigned-byte 16) offset)
635                      (type (unsigned-byte 20) count)
636                      (values (unsigned-byte 20)))
637             (cond ((= offset words-per-scrub-unit)
638                    count)
639                   ((zerop (sap-ref-32 ptr offset))
640                    (look ptr (1+ offset) count))
641                   (t
642                    (scrub ptr offset (1+ count))))))
643        (let* ((csp (sap-int (c::control-stack-pointer-sap)))
644               (initial-offset
645                (logand csp (1- (* words-per-scrub-unit vm:word-bytes)))))
646          (declare (type (unsigned-byte 32) csp))
647          (scrub (int-sap (- csp initial-offset))
648                 (floor initial-offset vm:word-bytes)
649                 0))))
650    
651    
652    
653  ;;;; TOP-LEVEL loop.  ;;;; TOP-LEVEL loop.
654    
655  (defvar / nil  (defvar / nil
# Line 658  Line 702 
702           (magic-eof-cookie (cons :eof nil))           (magic-eof-cookie (cons :eof nil))
703           (number-of-eofs 0))           (number-of-eofs 0))
704      (loop      (loop
705       (with-simple-restart (abort "Return to Top-Level.")        (with-simple-restart (abort "Return to Top-Level.")
706         (catch 'top-level-catcher          (catch 'top-level-catcher
707           (mach:unix-sigsetmask 0)            (mach:unix-sigsetmask 0)
708           (let ((*in-top-level-catcher* t))            (let ((*in-top-level-catcher* t))
709             (loop              (loop
710               (fresh-line)                (scrub-control-stack)
711               (princ (if (functionp *prompt*)                (fresh-line)
712                          (funcall *prompt*)                (princ (if (functionp *prompt*)
713                          *prompt*))                           (funcall *prompt*)
714               (force-output)                           *prompt*))
715               (let ((form (read *standard-input* nil magic-eof-cookie)))                (force-output)
716                 (cond ((not (eq form magic-eof-cookie))                (let ((form (read *standard-input* nil magic-eof-cookie)))
717                        (let ((results                  (cond ((not (eq form magic-eof-cookie))
718                               (multiple-value-list (interactive-eval form))))                         (let ((results
719                          (dolist (result results)                                (multiple-value-list (interactive-eval form))))
720                            (fresh-line)                           (dolist (result results)
721                            (prin1 result)))                             (fresh-line)
722                        (setf number-of-eofs 0))                             (prin1 result)))
723                       ((eql (incf number-of-eofs) 1)                         (setf number-of-eofs 0))
724                        (let ((stream (make-synonym-stream '*terminal-io*)))                        ((eql (incf number-of-eofs) 1)
725                          (setf *standard-input* stream)                         (let ((stream (make-synonym-stream '*terminal-io*)))
726                          (setf *standard-output* stream)                           (setf *standard-input* stream)
727                          (format t "~&Received EOF on *standard-input*, ~                           (setf *standard-output* stream)
728                                    switching to *terminal-io*.~%")))                           (format t "~&Received EOF on *standard-input*, ~
729                       ((> number-of-eofs eofs-before-quit)                                      switching to *terminal-io*.~%")))
730                        (format t "~&Received more than ~D EOFs; Aborting.~%"                        ((> number-of-eofs eofs-before-quit)
731                                eofs-before-quit)                         (format t "~&Received more than ~D EOFs; Aborting.~%"
732                        (quit))                                 eofs-before-quit)
733                       (t                         (quit))
734                        (format t "~&Received EOF.~%")))))))))))                        (t
735                           (format t "~&Received EOF.~%")))))))))))
736    
737    
738    

Legend:
Removed from v.1.24  
changed lines
  Added in v.1.25

  ViewVC Help
Powered by ViewVC 1.1.5