0.8.0.30
authorDaniel Barlow <dan@telent.net>
Tue, 3 Jun 2003 22:34:53 +0000 (22:34 +0000)
committerDaniel Barlow <dan@telent.net>
Tue, 3 Jun 2003 22:34:53 +0000 (22:34 +0000)
Update ASDF from upstream:
... export OPERATION-ON-{WARNINGS,FAILURE}
... add verbosity control to make loading optionally much
            more quiet (operate 'load-op :verbose nil)
        ... muffle STYLE-WARNINGS from loaded code in REQUIRE hook.
            Perhaps slightly contentious, but I think while it's fair
            to present these to developers, they just clutter the place
    up as far as end-users are concerned

Some TODO notes in SB-POSIX

contrib/asdf/asdf.lisp
contrib/sb-posix/README
contrib/sb-posix/TODO
version.lisp-expr

index a2e61e1..c8772b5 100644 (file)
@@ -1,4 +1,4 @@
-;;; This is asdf: Another System Definition Facility.  1.72
+;;; This is asdf: Another System Definition Facility.  1.75
 ;;;
 ;;; Feedback, bug reports, and patches are all welcome: please mail to
 ;;; <cclan-list@lists.sf.net>.  But note first that the canonical
           #:component-property
           
           #:component-depends-on
+
+          #:operation-on-warnings
+          #:operation-on-failure
           
           ;#:*component-parent-pathname* 
           #:*central-registry*         ; variables
+          #:*compile-file-warnings-behaviour*
+          #:*compile-file-failure-behaviour*
           
           #:operation-error #:compile-failed #:compile-warned #:compile-error
           #:system-definition-error 
@@ -89,7 +94,7 @@
 
 (in-package #:asdf)
 
-(defvar *asdf-revision* (let* ((v "1.72")
+(defvar *asdf-revision* (let* ((v "1.75")
                               (colon (or (position #\: v) -1))
                               (dot (position #\. v)))
                          (and v colon dot 
                                     (parse-integer v :start (1+ dot)
                                                    :junk-allowed t)))))
 
-(defvar  *compile-file-warnings-behaviour* :warn)
-(defvar  *compile-file-failure-behaviour* #+sbcl :error #-sbcl :warn)
+(defvar *compile-file-warnings-behaviour* :warn)
+(defvar *compile-file-failure-behaviour* #+sbcl :error #-sbcl :warn)
+
+(defvar *verbose-out* *trace-output*)
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; utility stuff
@@ -347,7 +354,7 @@ and NIL NAME and TYPE components"
                   (< (car in-memory) (file-write-date on-disk))))
       (let ((*package* (make-package (gensym (package-name #.*package*))
                                     :use '(:cl :asdf))))
-       (format t
+       (format *verbose-out*
                (formatter "~&~@<; ~@;loading system definition from ~A into ~A~@:>~%")
                ;; FIXME: This wants to be (ENOUGH-NAMESTRING
                ;; ON-DISK), but CMUCL barfs on that.
@@ -361,7 +368,8 @@ and NIL NAME and TYPE components"
          (if error-p (error 'missing-component :requires name))))))
 
 (defun register-system (name system)
-  (format t (formatter "~&~@<; ~@;registering ~A as ~A~@:>~%") system name)
+  (format *verbose-out*
+         (formatter "~&~@<; ~@;registering ~A as ~A~@:>~%") system name)
   (setf (gethash (coerce-name  name) *defined-systems*)
        (cons (get-universal-time) system)))
 
@@ -664,7 +672,7 @@ system."))
   nil)
 
 (defmethod explain ((operation operation) (component component))
-  (format *trace-output* "~&;;; ~A on ~A~%"
+  (format *verbose-out* "~&;;; ~A on ~A~%"
          operation component))
 
 ;;; compile-op
@@ -778,6 +786,10 @@ system."))
 (defun operate (operation-class system &rest args)
   (let* ((op (apply #'make-instance operation-class
                    :original-initargs args args))
+        (*verbose-out*
+         (if (getf args :verbose t)
+             *verbose-out*
+             (make-broadcast-stream)))
         (system (if (typep system 'component) system (find-system system)))
         (steps (traverse op system)))
     (with-compilation-unit ()
@@ -975,40 +987,40 @@ Returns the new tree (which probably shares structure with the old one)"
 (defun run-shell-command (control-string &rest args)
   "Interpolate ARGS into CONTROL-STRING as if by FORMAT, and
 synchronously execute the result using a Bourne-compatible shell, with
-output to *trace-output*.  Returns the shell's exit code."
+output to *verbose-out*.  Returns the shell's exit code."
   (let ((command (apply #'format nil control-string args)))
-    (format *trace-output* "; $ ~A~%" command)
+    (format *verbose-out* "; $ ~A~%" command)
     #+sbcl
     (sb-impl::process-exit-code
      (sb-ext:run-program  
       "/bin/sh"
       (list  "-c" command)
-      :input nil :output *trace-output*))
+      :input nil :output *verbose-out*))
     
     #+(or cmu scl)
     (ext:process-exit-code
      (ext:run-program  
       "/bin/sh"
       (list  "-c" command)
-      :input nil :output *trace-output*))
+      :input nil :output *verbose-out*))
 
     #+allegro
-    (excl:run-shell-command command :input nil :output *trace-output*)
+    (excl:run-shell-command command :input nil :output *verbose-out*)
     
     #+lispworks
     (system:call-system-showing-output
      command
      :shell-type "/bin/sh"
-     :output-stream *trace-output*)
+     :output-stream *verbose-out*)
     
-    #+clisp                            ;XXX not exactly *trace-output*, I know
+    #+clisp                            ;XXX not exactly *verbose-out*, I know
     (ext:run-shell-command  command :output :terminal :wait t)
 
     #+openmcl
     (nth-value 1
               (ccl:external-process-status
                (ccl:run-program "/bin/sh" (list "-c" command)
-                                :input nil :output *trace-output*
+                                :input nil :output *verbose-out*
                                 :wait t)))
 
     #-(or openmcl clisp lispworks allegro scl cmu sbcl)
@@ -1034,10 +1046,12 @@ output to *trace-output*.  Returns the shell's exit code."
 #+(and sbcl sbcl-hooks-require)
 (progn
   (defun module-provide-asdf (name)
-    (let ((system (asdf:find-system name nil)))
-      (when system
-       (asdf:operate 'asdf:load-op name)
-       t)))
+    (handler-bind ((style-warning #'muffle-warning))
+      (let* ((*verbose-out* (make-broadcast-stream))
+            (system (asdf:find-system name nil)))
+       (when system
+         (asdf:operate 'asdf:load-op name)
+         t))))
 
   (pushnew
    '(merge-pathnames "systems/"
index 0bb884a..d77b7ed 100644 (file)
@@ -212,3 +212,15 @@ See designator.lisp, add a define-designator form
 The use of DEFINE-CALL macro in interface.lisp should be obvious from
 the existing examples, if less so from the macroexpansion
 
+
+
+
+
+GC issues
+
+buffers that refer to C stuff are probably not movable by GC anyway
+
+a buffer that refers to a Lisp object may have trouble if the Lisp
+object is moved
+
+
index 6bcc5ec..4f5cde1 100644 (file)
@@ -25,7 +25,7 @@ sched_setscheduler sched_yield select semctl semget semop send
 sendfile sendmsg sendto setcontext setdomainname setgroups sethostid
 sethostname setitimer setpgrp setpriority setrlimit setsid setsockopt
 settimeofday sgetmask shmat shmctl shmdt shmget shmop shutdown
-sigaction sigaltstack sigblock siggetmask sigmask signal sigpause
+ sigaction sigaltstack sigblock siggetmask sigmask signal sigpause
 sigpending sigprocmask sigreturn sigsetmask sigsuspend sigvec socket
 socketcall socketpair ssetmask stat statfs stime stty swapoff swapon
 symlink sync syscalls sysctl sysfs sysinfo syslog time times truncate
index 8ffe15d..adb8c4d 100644 (file)
@@ -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".)
-"0.8.0.29"
+"0.8.0.30"