Changeset 8705

Mar 11, 2008, 12:17:46 AM (12 years ago)

Ensure that blocking I/O syscalls (fd-read, fd-write) ignore
EINTR. (If syscalls aren't restartable, then interrupted
syscalls can return EINTR. If we're trying to interrupt
something via PROCESS-INTERRUPT, we want the syscall to
exit the kernel after the handler runs, so that lisp code
can notice the pending interrupt.)

Try to make sure that the compille-time processing for DEFMETHOD
notes the method's lambda list as if &ALLOW-OTHER-KEYS was
specified whenever &KEY was. (It may not be that wise to
base our notion of a function's arglist on the latest method
we've seen; if this doesn't work for all cases where this branch
matters, we might just note the DEFGENERIC arglist at compile-time
and ignore the arglists of individual DEFMETHODs.)

Add an obscure argument to DIRECTORY, default it to T. DIRECTORY
will ignore files whose names start with ".#" (which are often
broken links that Emacs uses as lockfiles). This means that people
who have real files whose names start with ".#" won't be able to
see them unless they override this option. Or they could give
them less brain-dead names ...

Don't set the SA_RESTART open when installing signal handlers.
(This change was made in the trunk, but hadn't been backported
to the working-0711 branch.) The effect of the change is that
system calls (accept, read, write) that previously were
automatically restarted whenever they're interrupted now return
an "I was interrupted" error (#$EINTR). Returning from the OS
kernel (rather than restarting the syscall) means that pending
interrupts (sent via PROCESS-INTERRUPT) get handled on exit
from the syscall. (If we return from the lisp handler, we have
the option of restarting the syscall.)

None of this is hard to bootstrap, but the changes that make
syscalls interruptible require running under a recompiled
kernel, and handling the case where a "write" syscall is interrupted
requires changes to the lisp code. Do a full rebuild a time or two
and things should be fine.

4 edited


  • branches/working-0711/ccl/level-0/l0-io.lisp

    r7624 r8705  
    162162;;; write nbytes bytes from buffer buf to file-descriptor fd.
    163163(defun fd-write (fd buf nbytes)
    164   (syscall syscalls::write fd buf nbytes))
     164  (ignoring-eintr
     165   (syscall syscalls::write fd buf nbytes)))
    166167(defun fd-read (fd buf nbytes)
    167   (loop
    168     (let* ((n  (syscall syscalls::read fd buf nbytes)))
    169       (unless (eql n (- #$EINTR)) (return n)))))
     168  (ignoring-eintr (syscall syscalls::read fd buf nbytes)))
  • branches/working-0711/ccl/lib/macros.lisp

    r8680 r8705  
    16801680(defsetf type-predicate set-type-predicate)
     1682(defun adjust-defmethod-lambda-list (ll)
     1683  ;; If the lambda list contains &key, ensure that it also contains
     1684  ;; &allow-other-keys
     1685  (if (or (not (memq '&key ll))
     1686          (memq '&allow-other-keys ll))
     1687    ll
     1688    (if (memq '&aux ll)
     1689      (let* ((ll (copy-list ll))
     1690             (aux (memq '&aux ll)))
     1691        (setf (car aux) '&allow-other-keys
     1692              (cdr aux) (cons '&aux (cdr aux)))
     1693        ll)
     1694      (append ll '(&allow-other-keys)))))
    16821696(defmacro defmethod (name &rest args &environment env)
    16831697  (multiple-value-bind (function-form specializers-form qualifiers lambda-list documentation specializers)
    1684                        (parse-defmethod name args env)   
     1698      (parse-defmethod name args env)
    16851699    `(progn
    1686        (eval-when (:compile-toplevel)
    1687          (note-function-info ',name '(lambda ,lambda-list ()) ,env))
    1688        (compiler-let ((*nx-method-warning-name*
    1689                        (list ',name
    1690                              ,@(mapcar #'(lambda (x) `',x) qualifiers)
    1691                              ',specializers)))
    1692         (ensure-method ',name ,specializers-form
    1693                         :function ,function-form
    1694                         :qualifiers ',qualifiers
    1695                         :lambda-list ',lambda-list
    1696                         ,@(if documentation `(:documentation ,documentation)))))))
     1700      (eval-when (:compile-toplevel)
     1701        (note-function-info ',name '(lambda ,(adjust-defmethod-lambda-list lambda-list)) ,env))
     1702      (compiler-let ((*nx-method-warning-name*
     1703                      (list ',name
     1704                            ,@(mapcar #'(lambda (x) `',x) qualifiers)
     1705                            ',specializers)))
     1706        (ensure-method ',name ,specializers-form
     1707                       :function ,function-form
     1708                       :qualifiers ',qualifiers
     1709                       :lambda-list ',lambda-list
     1710                       ,@(if documentation `(:documentation ,documentation)))))))
  • branches/working-0711/ccl/lib/pathnames.lisp

    r7737 r8705  
    310310                            (all t)           ;; include Unix dot files (other than dot and dot dot)
    311311                            (directory-pathnames t) ;; return directories as directory-pathname-p's.
     312                            (include-emacs-lockfiles nil) ;; inculde .#foo
    312313                            test              ;; Only return pathnames matching test
    313314                            (follow-links t)) ;; return truename's of matching files.
    322323                     :directory-pathnames directory-pathnames
    323324                     :test test
     325                     :include-emacs-lockfiles include-emacs-lockfiles
    324326                     :follow-links follow-links))
    325327         (path (full-pathname (merge-pathnames path) :no-error nil))
    380382        (follow-links (getf keys :follow-links))
    381383        (all (getf keys :all))
     384        (include-emacs-lockfiles (getf keys :include-emacs-lockfiles))
    382385        (result ())
    383386        sub dir-list ans)
    392395        (while (setq sub (%read-dir dirent))
    393396          (when (and (or all (neq (%schar sub 0) #\.))
     397                     (or include-emacs-lockfiles
     398                         (and (>= (length sub) 2)
     399                              (not (string= sub ".#" :end1 2))))
    394400                     (not (string= sub "."))
    395401                     (not (string= sub ".."))
  • branches/working-0711/ccl/lisp-kernel/x86-exceptions.c

    r8008 r8705  
    13641364  sa.sa_flags =
     1365#if 1
     1366    0
    13651368    SA_RESTART
    13661370#ifdef USE_SIGALTSTACK
    13671371    | SA_ONSTACK
Note: See TracChangeset for help on using the changeset viewer.