summary |
shortlog |
log |
commit | commitdiff |
tree
raw |
patch |
inline | side by side (from parent 1:
310d5f8)
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
-;;; 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
;;;
;;; 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
#:component-property
#:component-depends-on
+
+ #:operation-on-warnings
+ #:operation-on-failure
;#:*component-parent-pathname*
#:*central-registry* ; variables
;#:*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
#:operation-error #:compile-failed #:compile-warned #:compile-error
#:system-definition-error
-(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
(colon (or (position #\: v) -1))
(dot (position #\. v)))
(and v colon dot
(parse-integer v :start (1+ dot)
:junk-allowed t)))))
(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
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; utility stuff
(< (car in-memory) (file-write-date on-disk))))
(let ((*package* (make-package (gensym (package-name #.*package*))
:use '(:cl :asdf))))
(< (car in-memory) (file-write-date on-disk))))
(let ((*package* (make-package (gensym (package-name #.*package*))
:use '(:cl :asdf))))
(formatter "~&~@<; ~@;loading system definition from ~A into ~A~@:>~%")
;; FIXME: This wants to be (ENOUGH-NAMESTRING
;; ON-DISK), but CMUCL barfs on that.
(formatter "~&~@<; ~@;loading system definition from ~A into ~A~@:>~%")
;; FIXME: This wants to be (ENOUGH-NAMESTRING
;; ON-DISK), but CMUCL barfs on that.
(if error-p (error 'missing-component :requires name))))))
(defun register-system (name system)
(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)))
(setf (gethash (coerce-name name) *defined-systems*)
(cons (get-universal-time) system)))
nil)
(defmethod explain ((operation operation) (component component))
nil)
(defmethod explain ((operation operation) (component component))
- (format *trace-output* "~&;;; ~A on ~A~%"
+ (format *verbose-out* "~&;;; ~A on ~A~%"
operation component))
;;; compile-op
operation component))
;;; compile-op
(defun operate (operation-class system &rest args)
(let* ((op (apply #'make-instance operation-class
:original-initargs args args))
(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 ()
(system (if (typep system 'component) system (find-system system)))
(steps (traverse op system)))
(with-compilation-unit ()
(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
(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)))
(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)
#+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)
#+(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*))
- (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"
#+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)
(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)
:wait t)))
#-(or openmcl clisp lispworks allegro scl cmu sbcl)
#+(and sbcl sbcl-hooks-require)
(progn
(defun module-provide-asdf (name)
#+(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/"
(pushnew
'(merge-pathnames "systems/"
The use of DEFINE-CALL macro in interface.lisp should be obvious from
the existing examples, if less so from the macroexpansion
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
+
+
sendfile sendmsg sendto setcontext setdomainname setgroups sethostid
sethostname setitimer setpgrp setpriority setrlimit setsid setsockopt
settimeofday sgetmask shmat shmctl shmdt shmget shmop shutdown
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
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
;;; 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".)
;;; 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".)