From 35871544d182adf1895cf6d99d3f995ac2b425e0 Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola Date: Wed, 18 Apr 2007 15:26:02 +0000 Subject: [PATCH] 1.0.4.102: SB-SYS and stream cleanups * Factor out looping on SERVE-ALL-EVENTS to FINISH-FD-STREAM-OUTPUT. * Make IO-TIMEOUT a subclass of TIMEOUT. * Remove spurious SB!SYS: prefixes from src/code/stream.lisp and fd-stream.lisp. * Delete stale symbols ALLOCATE-SYSTEM-MEMORY-AT, C-PROCEDURE, POINTER, POINTER>, POINTER<, SERVER, SERVER-MESSAGE, and WITH-ENABLED-INTERRUPTS from SB-SYS. (Also delete commented out implementation of W-E-I in target-signal.lisp.) --- package-data-list.lisp-expr | 9 +++------ src/code/condition.lisp | 20 ++++++++++---------- src/code/fd-stream.lisp | 33 +++++++++++++++++---------------- src/code/stream.lisp | 2 +- src/code/target-signal.lisp | 28 ---------------------------- version.lisp-expr | 2 +- 6 files changed, 32 insertions(+), 62 deletions(-) diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr index e5c4c78..82500c8 100644 --- a/package-data-list.lisp-expr +++ b/package-data-list.lisp-expr @@ -1949,7 +1949,6 @@ SB-KERNEL) have been undone, but probably more remain." "BEEP" "BITS" "BYTES" "BREAKPOINT-ERROR" - "C-PROCEDURE" "CLOSE-SHARED-OBJECTS" "COMPILER-VERSION" "DEALLOCATE-SYSTEM-MEMORY" @@ -1983,7 +1982,6 @@ SB-KERNEL) have been undone, but probably more remain." "MEMMOVE" "NATURALIZE-BOOLEAN" "NATURALIZE-INTEGER" "OS-COLD-INIT-OR-REINIT" "OS-CONTEXT-T" "OUTPUT-RAW-BYTES" - "POINTER" "POINTER<" "POINTER>" "READ-N-BYTES" "REALLOCATE-SYSTEM-MEMORY" "RECORD-SIZE" "REMOVE-FD-HANDLER" "REOPEN-SHARED-OBJECTS" @@ -1998,7 +1996,7 @@ SB-KERNEL) have been undone, but probably more remain." "SAP-REF-SAP" "SAP-REF-SINGLE" "SAP<" "SAP<=" "SAP=" "SAP>" "SAP>=" "SCRUB-CONTROL-STACK" "SERVE-ALL-EVENTS" - "SERVE-EVENT" "SERVER" "SERVER-MESSAGE" + "SERVE-EVENT" "SIGNED-SAP-REF-16" "SIGNED-SAP-REF-32" "SIGNED-SAP-REF-64" "SIGNED-SAP-REF-WORD" "SIGNED-SAP-REF-8" ;; FIXME: STRUCTURE!OBJECT stuff probably belongs in SB!KERNEL. @@ -2010,11 +2008,10 @@ SB-KERNEL) have been undone, but probably more remain." "SYSTEM-INTERNAL-RUN-TIME" "UNDEFINED-FOREIGN-SYMBOLS-P" "UPDATE-LINKAGE-TABLE" "VECTOR-SAP" - "WAIT-UNTIL-FD-USABLE" "WITH-ENABLED-INTERRUPTS" + "WAIT-UNTIL-FD-USABLE" "WITH-FD-HANDLER" "WITH-INTERRUPTS" "WITH-PINNED-OBJECTS" "WITHOUT-GCING" - "WITHOUT-INTERRUPTS" "WORDS" - "ALLOCATE-SYSTEM-MEMORY-AT")) + "WITHOUT-INTERRUPTS" "WORDS")) #s(sb-cold:package-data :name "SB!UNIX" diff --git a/src/code/condition.lisp b/src/code/condition.lisp index 098ec4e..2534c4a 100644 --- a/src/code/condition.lisp +++ b/src/code/condition.lisp @@ -1109,16 +1109,6 @@ SB-EXT:PACKAGE-LOCKED-ERROR-SYMBOL.")) '(:ansi-cl :section (15 1 2 1)) '(:ansi-cl :section (15 1 2 2))))) -(define-condition io-timeout (stream-error) - ((direction :reader io-timeout-direction :initarg :direction)) - (:report - (lambda (condition stream) - (declare (type stream stream)) - (format stream - "I/O timeout ~(~A~)ing ~S" - (io-timeout-direction condition) - (stream-error-stream condition))))) - (define-condition namestring-parse-error (parse-error) ((complaint :reader namestring-parse-error-complaint :initarg :complaint) (args :reader namestring-parse-error-args :initarg :args :initform nil) @@ -1159,6 +1149,16 @@ SB-EXT:PACKAGE-LOCKED-ERROR-SYMBOL.")) (define-condition timeout (serious-condition) ()) +(define-condition io-timeout (stream-error timeout) + ((direction :reader io-timeout-direction :initarg :direction)) + (:report + (lambda (condition stream) + (declare (type stream stream)) + (format stream + "I/O timeout ~(~A~)ing ~S" + (io-timeout-direction condition) + (stream-error-stream condition))))) + (define-condition declaration-type-conflict-error (reference-condition simple-error) () diff --git a/src/code/fd-stream.lisp b/src/code/fd-stream.lisp index 1162446..649e530 100644 --- a/src/code/fd-stream.lisp +++ b/src/code/fd-stream.lisp @@ -221,7 +221,7 @@ end) (fd-stream-output-later stream)))))) (unless (fd-stream-output-later stream) - (sb!sys:remove-fd-handler (fd-stream-handler stream)) + (remove-fd-handler (fd-stream-handler stream)) (setf (fd-stream-handler stream) nil))) ;;; Arange to output the string when we can write on the file descriptor. @@ -230,7 +230,7 @@ (setf (fd-stream-output-later stream) (list (list base start end reuse-sap))) (setf (fd-stream-handler stream) - (sb!sys:add-fd-handler (fd-stream-fd stream) + (add-fd-handler (fd-stream-fd stream) :output (lambda (fd) (declare (ignore fd)) @@ -739,17 +739,17 @@ ;;(not (sb!win32:fd-listen fd)), as was originally here. See ;;comment in `sysread-may-block-p'. (when (sysread-may-block-p stream) - (unless (sb!sys:wait-until-fd-usable + (unless (wait-until-fd-usable fd :input (fd-stream-timeout stream)) (error 'io-timeout :stream stream :direction :read))) (multiple-value-bind (count errno) (sb!unix:unix-read fd - (sb!sys:int-sap (+ (sb!sys:sap-int ibuf-sap) tail)) + (int-sap (+ (sap-int ibuf-sap) tail)) (- buflen tail)) (cond ((null count) (if #!-win32 (eql errno sb!unix:ewouldblock) #!+win32 t #!-win32 (progn - (unless (sb!sys:wait-until-fd-usable + (unless (wait-until-fd-usable fd :input (fd-stream-timeout stream)) (error 'io-timeout :stream stream :direction :read)) (refill-buffer/fd stream)) @@ -1211,7 +1211,7 @@ (declare (optimize (speed 3) (safety 0))) (let* ((length (length string)) (buffer (make-array (* (1+ length) ,size) :element-type '(unsigned-byte 8))) - (sap (sb!sys:vector-sap buffer)) + (sap (vector-sap buffer)) (tail 0) (stream ,name)) (declare (type index length tail) @@ -1454,7 +1454,7 @@ (the index ,out-size-expr))))) (tail 0) (buffer (make-array buffer-length :element-type '(unsigned-byte 8))) - (sap (sb!sys:vector-sap buffer)) + (sap (vector-sap buffer)) stream) (declare (type index length buffer-length tail) (type system-area-pointer sap) @@ -1815,7 +1815,7 @@ (:close (cond (arg1 ; We got us an abort on our hands. (when (fd-stream-handler fd-stream) - (sb!sys:remove-fd-handler (fd-stream-handler fd-stream)) + (remove-fd-handler (fd-stream-handler fd-stream)) (setf (fd-stream-handler fd-stream) nil)) ;; We can't do anything unless we know what file were ;; dealing with, and we don't want to do anything @@ -1904,9 +1904,7 @@ (flush-output-buffer fd-stream)) (:finish-output (flush-output-buffer fd-stream) - (do () - ((null (fd-stream-output-later fd-stream))) - (sb!sys:serve-all-events))) + (finish-fd-stream-output fd-stream)) (:element-type (fd-stream-element-type fd-stream)) (:external-format @@ -1946,11 +1944,16 @@ (:file-position (fd-stream-file-position fd-stream arg1)))) +(defun finish-fd-stream-output (stream) + (do () + ((null (fd-stream-output-later stream))) + (serve-all-events))) + (defun fd-stream-file-position (stream &optional newpos) (declare (type fd-stream stream) (type (or (alien sb!unix:off-t) (member nil :start :end)) newpos)) (if (null newpos) - (sb!sys:without-interrupts + (without-interrupts ;; First, find the position of the UNIX file descriptor in the file. (multiple-value-bind (posn errno) (sb!unix:unix-lseek (fd-stream-fd stream) 0 sb!unix:l_incr) @@ -1979,7 +1982,7 @@ ((eq errno sb!unix:espipe) nil) (t - (sb!sys:with-interrupts + (with-interrupts (simple-stream-perror "failure in Unix lseek() on ~S" stream errno)))))) @@ -1989,9 +1992,7 @@ ;; move the file pointer before writing this stuff, it will be ;; written in the wrong location. (flush-output-buffer stream) - (do () - ((null (fd-stream-output-later stream))) - (sb!sys:serve-all-events)) + (finish-fd-stream-output stream) ;; Clear out any pending input to force the next read to go to ;; the disk. (setf (fd-stream-unread stream) nil) diff --git a/src/code/stream.lisp b/src/code/stream.lisp index 48d3d73..adec888 100644 --- a/src/code/stream.lisp +++ b/src/code/stream.lisp @@ -1134,7 +1134,7 @@ (truly-the index (+ index copy))) ;; FIXME: why are we VECTOR-SAP'ing things here? what's the point? ;; and are there SB-UNICODE issues here as well? --njf, 2005-03-24 - (sb!sys:without-gcing + (without-gcing (system-area-ub8-copy (vector-sap string) index (if (typep buffer 'system-area-pointer) diff --git a/src/code/target-signal.lisp b/src/code/target-signal.lisp index 7125c73..e7e827b 100644 --- a/src/code/target-signal.lisp +++ b/src/code/target-signal.lisp @@ -184,31 +184,3 @@ ;;; Magically converted by the compiler into a break instruction. (defun receive-pending-interrupt () (receive-pending-interrupt)) - -;;; stale code which I'm insufficiently motivated to test -- WHN 19990714 -#| -;;;; WITH-ENABLED-INTERRUPTS - -(defmacro with-enabled-interrupts (interrupt-list &body body) - #!+sb-doc - "With-enabled-interrupts ({(interrupt function)}*) {form}* - Establish function as a handler for the Unix signal interrupt which - should be a number between 1 and 31 inclusive." - (let ((il (gensym)) - (it (gensym))) - `(let ((,il NIL)) - (unwind-protect - (progn - ,@(do* ((item interrupt-list (cdr item)) - (intr (caar item) (caar item)) - (ifcn (cadar item) (cadar item)) - (forms NIL)) - ((null item) (nreverse forms)) - (when (symbolp intr) - (setq intr (symbol-value intr))) - (push `(push `(,,intr ,(enable-interrupt ,intr ,ifcn)) ,il) - forms)) - ,@body) - (dolist (,it (nreverse ,il)) - (enable-interrupt (car ,it) (cadr ,it))))))) -|# diff --git a/version.lisp-expr b/version.lisp-expr index 72fe078..ffb6733 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.4.101" +"1.0.4.102" -- 1.7.10.4