Changeset 13097


Ignore:
Timestamp:
Oct 23, 2009, 7:13:49 PM (10 years ago)
Author:
rme
Message:

Trunk changes through r13096.

Location:
release/1.4/source
Files:
8 edited
1 copied

Legend:

Unmodified
Added
Removed
  • release/1.4/source/level-1/l1-boot-2.lisp

    r13075 r13097  
    314314      (bin-load-provide "COVER" "cover")
    315315      (bin-load-provide "LEAKS" "leaks")
     316      (bin-load-provide "CORE-FILES" "core-files")
    316317      (bin-load-provide "MCL-COMPAT" "mcl-compat")
    317318      (require "LOOP")
  • release/1.4/source/level-1/l1-lisp-threads.lisp

    r13075 r13097  
    988988  (let* ((found nil))
    989989    (with-lock-grabbed (*termination-population-lock*)
    990       ;; Have to defer GCing, e.g., defer responding to a GC
    991       ;; suspend request here (that also defers interrupts)
    992       ;; We absolutely, positively can't take an exception
    993       ;; in here, so don't even bother to typecheck on
    994       ;; car/cdr etc.
    995       (with-deferred-gc
    996           (do ((spine (population-data *termination-population*) (cdr spine))
    997                (prev nil spine))
    998               ((null spine))
    999             (declare (optimize (speed 3) (safety 0)))
    1000             (let* ((head (car spine))
    1001                    (tail (cdr spine))
    1002                    (o (car head))
    1003                    (f (cdr head)))
     990      ;; We don't really need to be very paranoid here.  Nothing can
     991      ;; be added to the termination queue while we hold the lock,
     992      ;; and the GC can't splice anything out of the list while
     993      ;; we hold a strong reference to that list.
     994      (let* ((population *termination-population*)
     995             (queue (population.data population)))
     996        (do* ((prev nil spine)
     997              (spine queue (cdr spine)))
     998             ((null spine))
     999          (let* ((entry (car spine)))
     1000            (destructuring-bind (o . f) entry
    10041001              (when (and (eq o object)
    10051002                         (or (null function-p)
    10061003                             (eq function f)))
    10071004                (if prev
    1008                   (setf (cdr prev) tail)
    1009                   (setf (population-data *termination-population*) tail))
     1005                  (setf (cdr prev) (cdr spine))
     1006                  (setf (population.data population) (cdr spine)))
    10101007                (setq found t)
    10111008                (return)))))
    1012       found)))
     1009      found))))
    10131010
    10141011
  • release/1.4/source/level-1/l1-readloop.lisp

    r13075 r13097  
    267267            (return)))
    268268        (let* ((vars (lexenv.variables env)))
     269          (dolist (vdecl (lexenv.vdecls env))
     270            (if (and (eq (car vdecl) sym)
     271                     (eq (cadr vdecl) 'special))
     272              (return-from %symbol-macroexpand-1 (values sym nil))))
    269273          (when (consp vars)
    270274            (let* ((info (dolist (var vars)
  • release/1.4/source/level-1/l1-streams.lisp

    r13075 r13097  
    54305430               (values (process-wait-with-timeout "input-wait" milliseconds #'data-available-on-pipe-p fd) 0)
    54315431               (values nil 0))))
    5432     ;(:character-special (windows-tty-input-available-p fd milliseconds))
     5432    (:file (let* ((curpos (fd-tell fd))
     5433                  (eofpos (%stack-block ((peofpos 8))
     5434                            (#_GetFileSizeEx (%int-to-ptr fd) peofpos)
     5435                            (%%get-unsigned-longlong peofpos 0))))
     5436             (values (< curpos eofpos) 0)))
     5437    ;;(:character-special (windows-tty-input-available-p fd milliseconds))
     5438
    54335439    (t (values nil 0)))
    54345440  #-windows-target
  • release/1.4/source/lib/compile-ccl.lisp

    r13075 r13097  
    208208    cover
    209209    leaks
     210    core-files
    210211    asdf
    211212    defsystem
  • release/1.4/source/lib/macros.lisp

    r13075 r13097  
    179179  `(%stack-block (,spec) ,@forms))
    180180
     181(eval-when (:compile-toplevel :load-toplevel :execute)
     182(defun extract-bound-decls-for-dolist-var (var decls env)
     183  (if (null decls)
     184    (values nil nil)
     185      (collect ((var-decls)
     186                (other-decls))
     187        (dolist (declform decls
     188                 (let* ((vdecls (var-decls))
     189                        (others (other-decls)))
     190                   (values (if vdecls `((declare ,@vdecls)))
     191                           (if others `((declare ,@others))))))
     192          ;; (assert (eq (car declform) 'declare))
     193          (dolist (decl (cdr declform))
     194            (if (atom decl)
     195              (other-decls decl)
     196              (let* ((spec (car decl)))
     197                (if (specifier-type-if-known spec env)
     198                  (setq spec 'type
     199                        decl `(type ,@decl)))
     200                (case spec
     201                  (type
     202                   (destructuring-bind (typespec &rest vars) (cdr decl)
     203                     (cond ((member var vars :test #'eq)
     204                            (setq vars (delete var vars))
     205                            (var-decls `(type ,typespec ,var))
     206                            (when vars
     207                              (other-decls `(type ,typespec ,@vars))))
     208                           (t (other-decls decl)))))
     209                   ((special ingore ignorable ccl::ignore-if-unused)
     210                    (let* ((vars (cdr decl)))
     211                      (cond ((member var vars :test #'eq)
     212                             (setq vars (delete var vars))
     213                             (var-decls `(,spec ,var))
     214                             (when vars
     215                               (other-decls `(,spec ,@vars))))
     216                            (t (other-decls decl)))))
     217                   (t (other-decls decl))))))))))
     218)
     219
     220
     221
    181222(defmacro dolist ((varsym list &optional ret) &body body &environment env)
    182223  (if (not (symbolp varsym)) (signal-program-error $XNotSym varsym))
    183   (let* ((toplab (gensym))
    184          (tstlab (gensym))
    185          (lstsym (gensym)))
    186224    (multiple-value-bind (forms decls) (parse-body body env nil)
    187       `(block nil
    188          (let* ((,lstsym ,list))
    189            (tagbody
    190               (go ,tstlab)
    191               ,toplab
    192               (let ((,varsym (car ,lstsym)))
    193                 ,@decls
    194                 (tagbody
    195                    ,@forms)
    196                 (setq ,lstsym (cdr (the list ,lstsym))))
    197               ,tstlab
    198               (if ,lstsym (go ,toplab))))
    199          ,@(if ret `((let ((,varsym nil))
    200                        (declare (ignore-if-unused ,varsym)
    201                                 ,@(loop for decl in decls
    202                                         append (remove 'special (cdr decl) :test #'neq :key #'car)))
    203                        ,ret)))))))
     225      (multiple-value-bind (var-decls other-decls)
     226          (extract-bound-decls-for-dolist-var varsym decls env)
     227        (let* ((lstsym (gensym)))
     228        `(do* ((,lstsym ,list (cdr (the list ,lstsym))))
     229              ((null ,lstsym)
     230               ,@(if ret `((let* ((,varsym ()))
     231                             (declare (ignorable ,varsym))
     232                             ,ret))))
     233          ,@other-decls
     234          (let* ((,varsym (car ,lstsym)))
     235            ,@var-decls
     236            (tagbody ,@forms)))))))
    204237
    205238(defmacro dovector ((varsym vector &optional ret) &body body &environment env)
  • release/1.4/source/lib/systems.lisp

    r13075 r13097  
    208208    (cover            "ccl:bin;cover"            ("ccl:library;cover.lisp"))
    209209    (leaks            "ccl:bin;leaks"            ("ccl:library;leaks.lisp"))
     210    (core-files       "ccl:bin;core-files"       ("ccl:library;core-files.lisp"))
    210211 
    211212    (prepare-mcl-environment "ccl:bin;prepare-mcl-environment" ("ccl:lib;prepare-mcl-environment.lisp"))
  • release/1.4/source/lisp-kernel/lisp-debug.c

    r13075 r13097  
    160160readc()
    161161{
     162  unsigned tries = 1000;
    162163  int c;
    163   while (1) {
     164
     165  while (tries) {
    164166    c = getchar();
    165167    switch(c) {
     
    171173      if (ferror(stdin)) {
    172174        if ((errno == EINTR) || (errno == EIO)) {
     175          clearerr(stdin);
     176          tries--;
    173177          continue;
    174178        }
     
    179183    }
    180184  }
     185  return EOF;
    181186}
    182187
Note: See TracChangeset for help on using the changeset viewer.