cmucl-cvs April 2015

cmucl-cvs@common-lisp.net

3 participants
318 discussions

[cmucl/cmucl][master] Turn off logging that was accidentally enabled in previous commit.
by Raymond Toy 25 Apr '15

25 Apr '15

Raymond Toy pushed to branch master at cmucl / cmucl Commits: ea775196 by Raymond Toy at 2015-04-25T09:18:50Z Turn off logging that was accidentally enabled in previous commit. - - - - - 1 changed file: - bin/make-main-dist.sh Changes: ===================================== bin/make-main-dist.sh ===================================== --- a/bin/make-main-dist.sh +++ b/bin/make-main-dist.sh @@ -126,7 +126,7 @@ do install ${GROUP} ${OWNER} -m 0644 $f $DESTDIR/lib/cmucl/lib/ext-formats/ done -set -x +# set -x # Create the directories for asdf and defsystem for f in asdf defsystem asdf/doc do View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/ea775196480fd9f029c2a701f…

1 0

[cmucl/cmucl][master] Fix issue #1. Handle funcall in compiler macro functions.
by Raymond Toy 25 Apr '15

25 Apr '15

Raymond Toy pushed to branch master at cmucl / cmucl Commits: c961673a by Raymond Toy at 2015-04-25T09:15:02Z Fix issue #1. Handle funcall in compiler macro functions. Also added tests/issues.lisp with a corresponding test. - - - - - 2 changed files: - src/code/defmacro.lisp - + tests/issues.lisp Changes: ===================================== src/code/defmacro.lisp ===================================== --- a/src/code/defmacro.lisp +++ b/src/code/defmacro.lisp @@ -151,7 +151,12 @@ (not (and (listp ,arg-list-name) (eq 'funcall (car ,arg-list-name))))) `(progn - (setf ,arg-list-name (cdr ,arg-list-name))))) + (setf ,arg-list-name + ;; Handle the case (funcall #'foo args) + (if (consp (second ,arg-list-name)) + (list* (second (second ,arg-list-name)) + (cddr ,arg-list-name)) + (cdr ,arg-list-name)))))) (push-let-binding (car rest-of-args) arg-list-name nil)) ((and (cdr rest-of-args) (consp (cadr rest-of-args))) (pop rest-of-args) ===================================== tests/issues.lisp ===================================== --- /dev/null +++ b/tests/issues.lisp @@ -0,0 +1,25 @@ +;;; Tests from gitlab issues + +(defpackage :issues-tests + (:use :cl :lisp-unit)) + +(in-package "ISSUES-TESTS") + +(defun square (x) + (expt x 2)) + +(define-compiler-macro square (&whole form arg) + (declare (ignore arg)) + form) + +(define-test issue.1.a + (:tag :issues) + (assert-equal + '(square x) + (funcall (compiler-macro-function 'square) '(square x) nil))) + +(define-test issue.1.b + (:tag :issues) + (assert-equal + '(square x) + (funcall (compiler-macro-function 'square) '(funcall #'square x) nil))) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/c961673a4b7bdceeff80cd5ca…

1 0

[cmucl/cmucl][rtoy-unix-core] Regenerated.
by Raymond Toy 22 Apr '15

22 Apr '15

Raymond Toy pushed to rtoy-unix-core at cmucl / cmucl Commits: f2601215 by Raymond Toy at 2015-04-21T20:49:44Z Regenerated. - - - - - 1 changed file: - src/i18n/locale/cmucl-unix.pot Changes: ===================================== src/i18n/locale/cmucl-unix.pot ===================================== --- a/src/i18n/locale/cmucl-unix.pot +++ b/src/i18n/locale/cmucl-unix.pot @@ -16,1535 +16,1217 @@ msgstr "" "Content-Transfer-Encoding: 8bit\n" #: src/code/unix.lisp -msgid "Size of control character vector." -msgstr "" - -#: src/code/unix.lisp -msgid "Successful" -msgstr "" - -#: src/code/unix.lisp -msgid "Operation not permitted" -msgstr "" - -#: src/code/unix.lisp -msgid "No such file or directory" -msgstr "" - -#: src/code/unix.lisp -msgid "No such process" -msgstr "" - -#: src/code/unix.lisp -msgid "Interrupted system call" -msgstr "" - -#: src/code/unix.lisp -msgid "I/O error" -msgstr "" - -#: src/code/unix.lisp -msgid "Device not configured" -msgstr "" - -#: src/code/unix.lisp -msgid "Arg list too long" -msgstr "" - -#: src/code/unix.lisp -msgid "Exec format error" -msgstr "" - -#: src/code/unix.lisp -msgid "Bad file descriptor" -msgstr "" - -#: src/code/unix.lisp -msgid "No child process" -msgstr "" - -#: src/code/unix.lisp -msgid "Resource deadlock avoided" -msgstr "" - -#: src/code/unix.lisp -msgid "No more processes" -msgstr "" - -#: src/code/unix.lisp -msgid "Try again" -msgstr "" - -#: src/code/unix.lisp -msgid "Out of memory" -msgstr "" - -#: src/code/unix.lisp -msgid "Permission denied" -msgstr "" - -#: src/code/unix.lisp -msgid "Bad address" -msgstr "" - -#: src/code/unix.lisp -msgid "Block device required" -msgstr "" - -#: src/code/unix.lisp -msgid "Device or resource busy" -msgstr "" - -#: src/code/unix.lisp -msgid "File exists" -msgstr "" - -#: src/code/unix.lisp -msgid "Cross-device link" -msgstr "" - -#: src/code/unix.lisp -msgid "No such device" -msgstr "" - -#: src/code/unix.lisp -msgid "Not a director" -msgstr "" - -#: src/code/unix.lisp -msgid "Is a directory" -msgstr "" - -#: src/code/unix.lisp -msgid "Invalid argument" -msgstr "" - -#: src/code/unix.lisp -msgid "File table overflow" -msgstr "" - -#: src/code/unix.lisp -msgid "Too many open files" -msgstr "" - -#: src/code/unix.lisp -msgid "Inappropriate ioctl for device" -msgstr "" - -#: src/code/unix.lisp -msgid "Text file busy" -msgstr "" - -#: src/code/unix.lisp -msgid "File too large" -msgstr "" - -#: src/code/unix.lisp -msgid "No space left on device" -msgstr "" - -#: src/code/unix.lisp -msgid "Illegal seek" -msgstr "" - -#: src/code/unix.lisp -msgid "Read-only file system" -msgstr "" - -#: src/code/unix.lisp -msgid "Too many links" -msgstr "" - -#: src/code/unix.lisp -msgid "Broken pipe" -msgstr "" - -#: src/code/unix.lisp -msgid "Numerical argument out of domain" -msgstr "" - -#: src/code/unix.lisp -msgid "Result too large" -msgstr "" - -#: src/code/unix.lisp -msgid "Math result not representable" -msgstr "" - -#: src/code/unix.lisp -msgid "Operation would block" -msgstr "" - -#: src/code/unix.lisp -msgid "Resource temporarily unavailable" -msgstr "" - -#: src/code/unix.lisp -msgid "Operation now in progress" -msgstr "" - -#: src/code/unix.lisp -msgid "Operation already in progress" -msgstr "" - -#: src/code/unix.lisp -msgid "Socket operation on non-socket" -msgstr "" - -#: src/code/unix.lisp -msgid "Destination address required" -msgstr "" - -#: src/code/unix.lisp -msgid "Message too long" -msgstr "" - -#: src/code/unix.lisp -msgid "Protocol wrong type for socket" -msgstr "" - -#: src/code/unix.lisp -msgid "Protocol not available" -msgstr "" - -#: src/code/unix.lisp -msgid "Protocol not supported" -msgstr "" - -#: src/code/unix.lisp -msgid "Socket type not supported" -msgstr "" - -#: src/code/unix.lisp -msgid "Operation not supported on socket" -msgstr "" - -#: src/code/unix.lisp -msgid "Protocol family not supported" -msgstr "" - -#: src/code/unix.lisp -msgid "Address family not supported by protocol family" -msgstr "" - -#: src/code/unix.lisp -msgid "Address already in use" -msgstr "" - -#: src/code/unix.lisp -msgid "Can't assign requested address" -msgstr "" - -#: src/code/unix.lisp -msgid "Network is down" -msgstr "" - -#: src/code/unix.lisp -msgid "Network is unreachable" +msgid "Syscall ~A failed: ~A" msgstr "" #: src/code/unix.lisp -msgid "Network dropped connection on reset" +msgid "Test for read permission" msgstr "" #: src/code/unix.lisp -msgid "Software caused connection abort" +msgid "Class not yet defined: ~S" msgstr "" #: src/code/unix.lisp -msgid "Connection reset by peer" +msgid "Test for write permission" msgstr "" #: src/code/unix.lisp -msgid "No buffer space available" +msgid "Test for execute permission" msgstr "" #: src/code/unix.lisp -msgid "Socket is already connected" +msgid "Test for presence of file" msgstr "" #: src/code/unix.lisp -msgid "Socket is not connected" +msgid "" +"Given a file path (a string) and one of four constant modes,\n" +" unix-access returns T if the file is accessible with that\n" +" mode and NIL if not. It also returns an errno value with\n" +" NIL which determines why the file was not accessible.\n" +"\n" +" The access modes are:\n" +" r_ok Read permission.\n" +" w_ok Write permission.\n" +" x_ok Execute permission.\n" +" f_ok Presence of file." msgstr "" #: src/code/unix.lisp -msgid "Can't send after socket shutdown" +msgid "" +"Given a file path string, unix-chdir changes the current working \n" +" directory to the one specified." msgstr "" #: src/code/unix.lisp -msgid "Too many references: can't splice" +msgid "Set user ID on execution" msgstr "" #: src/code/unix.lisp -msgid "Connection timed out" +msgid "Set group ID on execution" msgstr "" #: src/code/unix.lisp -msgid "Connection refused" +msgid "Save text image after execution" msgstr "" #: src/code/unix.lisp -msgid "Too many levels of symbolic links" +msgid "Read by owner" msgstr "" #: src/code/unix.lisp -msgid "File name too long" +msgid "Write by owner" msgstr "" #: src/code/unix.lisp -msgid "Host is down" +msgid "Execute (search directory) by owner" msgstr "" #: src/code/unix.lisp -msgid "No route to host" +msgid "Read by group" msgstr "" #: src/code/unix.lisp -msgid "Directory not empty" +msgid "Write by group" msgstr "" #: src/code/unix.lisp -msgid "Too many processes" +msgid "Execute (search directory) by group" msgstr "" #: src/code/unix.lisp -msgid "Too many users" +msgid "Read by others" msgstr "" #: src/code/unix.lisp -msgid "Disc quota exceeded" +msgid "Write by others" msgstr "" #: src/code/unix.lisp -msgid "namei should continue locally" +msgid "Execute (search directory) by others" msgstr "" #: src/code/unix.lisp -msgid "namei was handled remotely" +msgid "" +"Given a file path string and a constant mode, unix-chmod changes the\n" +" permission mode for that file to the one specified. The new mode\n" +" can be created by logically OR'ing the following:\n" +"\n" +" setuidexec Set user ID on execution.\n" +" setgidexec Set group ID on execution.\n" +" savetext Save text image after execution.\n" +" readown Read by owner.\n" +" writeown Write by owner.\n" +" execown Execute (search directory) by owner.\n" +" readgrp Read by group.\n" +" writegrp Write by group.\n" +" execgrp Execute (search directory) by group.\n" +" readoth Read by others.\n" +" writeoth Write by others.\n" +" execoth Execute (search directory) by others.\n" +" \n" +" Thus #o444 and (logior unix:readown unix:readgrp unix:readoth)\n" +" are equivalent for 'mode. The octal-base is familar to Unix users.\n" +"\n" +" It returns T on successfully completion; NIL and an error number\n" +" otherwise." msgstr "" #: src/code/unix.lisp -msgid "Remote file system error _N" +msgid "" +"Given an integer file descriptor and a mode (the same as those\n" +" used for unix-chmod), unix-fchmod changes the permission mode\n" +" for that file to the one specified. T is returned if the call\n" +" was successful." msgstr "" #: src/code/unix.lisp -msgid "syscall was handled by Vice" +msgid "set the file pointer" msgstr "" #: src/code/unix.lisp -msgid "No message of desired type" +msgid "increment the file pointer" msgstr "" #: src/code/unix.lisp -msgid "Identifier removed" +msgid "extend the file size" msgstr "" #: src/code/unix.lisp -msgid "Channel number out of range" +msgid "" +"Unix-lseek accepts a file descriptor and moves the file pointer ahead\n" +" a certain offset for that file. Whence can be any of the following:\n" +"\n" +" l_set Set the file pointer.\n" +" l_incr Increment the file pointer.\n" +" l_xtnd Extend the file size.\n" +" _N" msgstr "" #: src/code/unix.lisp -msgid "Level 2 not synchronized" +msgid "" +"Unix-mkdir creates a new directory with the specified name and mode.\n" +" (Same as those for unix-chmod.) It returns T upon success, otherwise\n" +" NIL and an error number." msgstr "" #: src/code/unix.lisp -msgid "Level 3 halted" +msgid "" +"Unix-unlink removes the directory entry for the named file.\n" +" NIL and an error code is returned if the call fails." msgstr "" #: src/code/unix.lisp -msgid "Level 3 reset" +msgid "Read-only flag." msgstr "" #: src/code/unix.lisp -msgid "Link number out of range" +msgid "Write-only flag." msgstr "" #: src/code/unix.lisp -msgid "Protocol driver not attached" +msgid "Read-write flag." msgstr "" #: src/code/unix.lisp -msgid "No CSI structure available" +msgid "Non-blocking I/O" msgstr "" #: src/code/unix.lisp -msgid "Level 2 halted" +msgid "Append flag." msgstr "" #: src/code/unix.lisp -msgid "Deadlock situation detected/avoided" +msgid "Create if nonexistant flag." msgstr "" #: src/code/unix.lisp -msgid "No record locks available" +msgid "Truncate flag." msgstr "" #: src/code/unix.lisp -msgid "Error 47" +msgid "Error if already exists." msgstr "" #: src/code/unix.lisp -msgid "Error 48" +msgid "Don't assign controlling tty" msgstr "" #: src/code/unix.lisp -msgid "Bad exchange descriptor" +msgid "Non-blocking mode" msgstr "" #: src/code/unix.lisp -msgid "Bad request descriptor" +msgid "Synchronous writes (on ext2)" msgstr "" #: src/code/unix.lisp -msgid "Message tables full" +msgid "" +"Unix-open opens the file whose pathname is specified by path\n" +" for reading and/or writing as specified by the flags argument.\n" +" The flags argument can be:\n" +"\n" +" o_rdonly Read-only flag.\n" +" o_wronly Write-only flag.\n" +" o_rdwr Read-and-write flag.\n" +" o_append Append flag.\n" +" o_creat Create-if-nonexistant flag.\n" +" o_trunc Truncate-to-size-0 flag.\n" +"\n" +" If the o_creat flag is specified, then the file is created with\n" +" a permission of argument mode if the file doesn't exist. An\n" +" integer file descriptor is returned by unix-open." msgstr "" #: src/code/unix.lisp -msgid "Anode table overflow" +msgid "" +"Unix-close takes an integer file descriptor as an argument and\n" +" closes the file associated with it. T is returned upon successful\n" +" completion, otherwise NIL and an error number." msgstr "" #: src/code/unix.lisp -msgid "Bad request code" +msgid "" +"Unix-creat accepts a file name and a mode (same as those for\n" +" unix-chmod) and creates a file by that name with the specified\n" +" permission mode. It returns a file descriptor on success,\n" +" or NIL and an error number otherwise.\n" +"\n" +" This interface is made obsolete by UNIX-OPEN." msgstr "" #: src/code/unix.lisp -msgid "Invalid slot" +msgid "" +"Unix-dup duplicates an existing file descriptor (given as the\n" +" argument) and return it. If FD is not a valid file descriptor, NIL\n" +" and an error number are returned." msgstr "" #: src/code/unix.lisp -msgid "File locking deadlock" +msgid "Duplicate a file descriptor" msgstr "" #: src/code/unix.lisp -msgid "Bad font file format" +msgid "Get file desc. flags" msgstr "" #: src/code/unix.lisp -msgid "Not a stream device" +msgid "Set file desc. flags" msgstr "" #: src/code/unix.lisp -msgid "No data available" +msgid "Get file flags" msgstr "" #: src/code/unix.lisp -msgid "Timer expired" +msgid "Set file flags" msgstr "" #: src/code/unix.lisp -msgid "Out of stream resources" +msgid "Get owner" msgstr "" #: src/code/unix.lisp -msgid "Machine is not on the network" +msgid "Get lock" msgstr "" #: src/code/unix.lisp -msgid "Package not installed" +msgid "Set owner" msgstr "" #: src/code/unix.lisp -msgid "Object is remote" +msgid "Set lock" msgstr "" #: src/code/unix.lisp -msgid "Link has been severed" +msgid "Set lock, wait for release" msgstr "" #: src/code/unix.lisp -msgid "Advertise error" +msgid "Non-blocking reads" msgstr "" #: src/code/unix.lisp -msgid "Srmount error" +msgid "Append on each write" msgstr "" #: src/code/unix.lisp -msgid "Communication error on send" +msgid "Signal pgrp when data ready" msgstr "" #: src/code/unix.lisp -msgid "Protocol error" +msgid "Create if nonexistant" msgstr "" #: src/code/unix.lisp -msgid "Multihop attempted" +msgid "Truncate to zero length" msgstr "" #: src/code/unix.lisp -msgid "Not a data message" +msgid "Error if already created" msgstr "" #: src/code/unix.lisp -msgid "Value too large for defined data type" +msgid "" +"Unix-fcntl manipulates file descriptors according to the\n" +" argument CMD which can be one of the following:\n" +"\n" +" F-DUPFD Duplicate a file descriptor.\n" +" F-GETFD Get file descriptor flags.\n" +" F-SETFD Set file descriptor flags.\n" +" F-GETFL Get file flags.\n" +" F-SETFL Set file flags.\n" +" F-GETOWN Get owner.\n" +" F-SETOWN Set owner.\n" +"\n" +" The flags that can be specified for F-SETFL are:\n" +"\n" +" FNDELAY Non-blocking reads.\n" +" FAPPEND Append on each write.\n" +" FASYNC Signal pgrp when data ready.\n" +" FCREAT Create if nonexistant.\n" +" FTRUNC Truncate to zero length.\n" +" FEXCL Error if already created.\n" +" " msgstr "" #: src/code/unix.lisp -msgid "Name not unique on network" +msgid "" +"Unix-pipe sets up a unix-piping mechanism consisting of\n" +" an input pipe and an output pipe. Unix-Pipe returns two\n" +" values: if no error occurred the first value is the pipe\n" +" to be read from and the second is can be written to. If\n" +" an error occurred the first value is NIL and the second\n" +" the unix error code." msgstr "" #: src/code/unix.lisp -msgid "File descriptor in bad state" +msgid "" +"Unix-read attempts to read from the file described by fd into\n" +" the buffer buf until it is full. Len is the length of the buffer.\n" +" The number of bytes actually read is returned or NIL and an error\n" +" number if an error occured." msgstr "" #: src/code/unix.lisp -msgid "Remote address changed" +msgid "" +"Unix-readlink invokes the readlink system call on the file name\n" +" specified by the simple string path. It returns up to two values:\n" +" the contents of the symbolic link if the call is successful, or\n" +" NIL and the Unix error number." msgstr "" #: src/code/unix.lisp -msgid "Can not access a needed shared library" +msgid "" +"Unix-rename renames the file with string name1 to the string\n" +" name2. NIL and an error code is returned if an error occured." msgstr "" #: src/code/unix.lisp -msgid "Accessing a corrupted shared library" +msgid "" +"Unix-rmdir attempts to remove the directory name. NIL and\n" +" an error number is returned if an error occured." msgstr "" #: src/code/unix.lisp -msgid ".lib section in a.out corrupted" +msgid "" +"Unix-write attempts to write a character buffer (buf) of length\n" +" len to the file described by the file descriptor fd. NIL and an\n" +" error is returned if the call is unsuccessful." msgstr "" #: src/code/unix.lisp -msgid "Attempting to link in more shared libraries than system limit" +msgid "" +"Unix-ioctl performs a variety of operations on open i/o\n" +" descriptors. See the UNIX Programmer's Manual for more\n" +" information." msgstr "" #: src/code/unix.lisp -msgid "Can not exec a shared library directly" +msgid "Get terminal attributes." msgstr "" #: src/code/unix.lisp -msgid "Error 88" +msgid "Set terminal attributes." msgstr "" #: src/code/unix.lisp -msgid "Operation not applicable" +msgid "Get terminal output speed." msgstr "" #: src/code/unix.lisp msgid "" -"Number of symbolic links encountered during path name traversal exceeds " -"MAXSYMLINKS" -msgstr "" - -#: src/code/unix.lisp -msgid "Error 91" +"Unix-getuid returns the real user-id associated with the\n" +" current process." msgstr "" #: src/code/unix.lisp -msgid "Error 92" +msgid "Unix-getpagesize returns the number of bytes in a system page." msgstr "" #: src/code/unix.lisp -msgid "Option not supported by protocol" +msgid "Unix-gethostname returns the name of the host machine as a string." msgstr "" #: src/code/unix.lisp -msgid "Operation not supported on transport endpoint" +msgid "" +"Unix-gethostid returns a 32-bit integer which provides unique\n" +" identification for the host machine." msgstr "" #: src/code/unix.lisp -msgid "Cannot assign requested address" +msgid "" +"Unix-exit terminates the current process with an optional\n" +" error code. If successful, the call doesn't return. If\n" +" unsuccessful, the call returns NIL and an error number." msgstr "" #: src/code/unix.lisp -msgid "Network dropped connection because of reset" +msgid "Size of control character vector." msgstr "" #: src/code/unix.lisp -msgid "Transport endpoint is already connected" +msgid "" +"Unix-stat retrieves information about the specified\n" +" file returning them in the form of multiple values.\n" +" See the UNIX Programmer's Manual for a description\n" +" of the values returned. If the call fails, then NIL\n" +" and an error number is returned instead." msgstr "" #: src/code/unix.lisp -msgid "Transport endpoint is not connected" +msgid "" +"Unix-lstat is similar to unix-stat except the specified\n" +" file must be a symbolic link." msgstr "" #: src/code/unix.lisp -msgid "Cannot send after socket shutdown" +msgid "" +"Unix-fstat is similar to unix-stat except the file is specified\n" +" by the file descriptor fd." msgstr "" #: src/code/unix.lisp -msgid "Too many references: cannot splice" +msgid "The calling process." msgstr "" #: src/code/unix.lisp -msgid "Stale NFS file handle" +msgid "Terminated child processes." msgstr "" #: src/code/unix.lisp -msgid "Resource deadlock would occur" +msgid "" +"Like call getrusage, but return only the system and user time, and returns\n" +" the seconds and microseconds as separate values." msgstr "" #: src/code/unix.lisp -msgid "Function not implemented" +msgid "" +"Unix-getrusage returns information about the resource usage\n" +" of the process specified by who. Who can be either the\n" +" current process (rusage_self) or all of the terminated\n" +" child processes (rusage_children). NIL and an error number\n" +" is returned if the call fails." msgstr "" #: src/code/unix.lisp -msgid "Too many symbolic links encountered" +msgid "Returns either :file, :directory, :link, :special, or NIL." msgstr "" #: src/code/unix.lisp -msgid "Invalid exchange" +msgid "Returns the pathname with all symbolic links resolved." msgstr "" #: src/code/unix.lisp -msgid "Invalid request descriptor" +msgid "Error reading link ~S: ~S" msgstr "" #: src/code/unix.lisp -msgid "Exchange full" +msgid "Successful" msgstr "" #: src/code/unix.lisp -msgid "No anode" +msgid "Operation not permitted" msgstr "" #: src/code/unix.lisp -msgid "Invalid request code" +msgid "No such file or directory" msgstr "" #: src/code/unix.lisp -msgid "File locking deadlock error" +msgid "No such process" msgstr "" #: src/code/unix.lisp -msgid "Device not a stream" +msgid "Interrupted system call" msgstr "" #: src/code/unix.lisp -msgid "Out of streams resources" +msgid "I/O error" msgstr "" #: src/code/unix.lisp -msgid "RFS specific error" +msgid "Device not configured" msgstr "" #: src/code/unix.lisp -msgid "Attempting to link in too many shared libraries" +msgid "Arg list too long" msgstr "" #: src/code/unix.lisp -msgid "Cannot exec a shared library directly" +msgid "Exec format error" msgstr "" #: src/code/unix.lisp -msgid "Illegal byte sequence" +msgid "Bad file descriptor" msgstr "" #: src/code/unix.lisp -msgid "Interrupted system call should be restarted _N" +msgid "No child process" msgstr "" #: src/code/unix.lisp -msgid "Streams pipe error" +msgid "Resource deadlock avoided" msgstr "" #: src/code/unix.lisp -msgid "Address family not supported by protocol" +msgid "No more processes" msgstr "" #: src/code/unix.lisp -msgid "Cannot send after transport endpoint shutdown" +msgid "Try again" msgstr "" #: src/code/unix.lisp -msgid "Structure needs cleaning" +msgid "Out of memory" msgstr "" #: src/code/unix.lisp -msgid "Not a XENIX named type file" +msgid "Permission denied" msgstr "" #: src/code/unix.lisp -msgid "No XENIX semaphores available" +msgid "Bad address" msgstr "" #: src/code/unix.lisp -msgid "Is a named type file" +msgid "Block device required" msgstr "" #: src/code/unix.lisp -msgid "Remote I/O error" +msgid "Device or resource busy" msgstr "" #: src/code/unix.lisp -msgid "Quota exceeded" +msgid "File exists" msgstr "" #: src/code/unix.lisp -msgid "" -"Returns a string describing the error number which was returned by a\n" -" UNIX system call." +msgid "Cross-device link" msgstr "" #: src/code/unix.lisp -msgid "Unknown error [~d]" +msgid "No such device" msgstr "" #: src/code/unix.lisp -msgid "Class not yet defined: ~S" +msgid "Not a director" msgstr "" #: src/code/unix.lisp -msgid "Syscall ~A failed: ~A" +msgid "Is a directory" msgstr "" #: src/code/unix.lisp -msgid "" -"Set the user ID of the calling process to UID.\n" -" If the calling process is the super-user, set the real\n" -" and effective user IDs, and the saved set-user-ID to UID;\n" -" if not, the effective user ID is set to UID." +msgid "Invalid argument" msgstr "" #: src/code/unix.lisp -msgid "" -"Set the group ID of the calling process to GID.\n" -" If the calling process is the super-user, set the real\n" -" and effective group IDs, and the saved set-group-ID to GID;\n" -" if not, the effective group ID is set to GID." +msgid "File table overflow" msgstr "" #: src/code/unix.lisp -msgid "Test for read permission" +msgid "Too many open files" msgstr "" #: src/code/unix.lisp -msgid "Test for write permission" +msgid "Inappropriate ioctl for device" msgstr "" #: src/code/unix.lisp -msgid "Test for execute permission" +msgid "Text file busy" msgstr "" #: src/code/unix.lisp -msgid "Test for presence of file" +msgid "File too large" msgstr "" #: src/code/unix.lisp -msgid "" -"Given a file path (a string) and one of four constant modes,\n" -" unix-access returns T if the file is accessible with that\n" -" mode and NIL if not. It also returns an errno value with\n" -" NIL which determines why the file was not accessible.\n" -"\n" -" The access modes are:\n" -" r_ok Read permission.\n" -" w_ok Write permission.\n" -" x_ok Execute permission.\n" -" f_ok Presence of file." +msgid "No space left on device" msgstr "" #: src/code/unix.lisp -msgid "" -"Given a file path string, unix-chdir changes the current working \n" -" directory to the one specified." +msgid "Illegal seek" msgstr "" #: src/code/unix.lisp -msgid "Set user ID on execution" +msgid "Read-only file system" msgstr "" #: src/code/unix.lisp -msgid "Set group ID on execution" +msgid "Too many links" msgstr "" #: src/code/unix.lisp -msgid "Save text image after execution" +msgid "Broken pipe" msgstr "" #: src/code/unix.lisp -msgid "Read by owner" +msgid "Numerical argument out of domain" msgstr "" #: src/code/unix.lisp -msgid "Write by owner" +msgid "Result too large" msgstr "" #: src/code/unix.lisp -msgid "Execute (search directory) by owner" +msgid "Math result not representable" msgstr "" #: src/code/unix.lisp -msgid "Read by group" +msgid "Operation would block" msgstr "" #: src/code/unix.lisp -msgid "Write by group" +msgid "Resource temporarily unavailable" msgstr "" #: src/code/unix.lisp -msgid "Execute (search directory) by group" +msgid "Operation now in progress" msgstr "" #: src/code/unix.lisp -msgid "Read by others" +msgid "Operation already in progress" msgstr "" #: src/code/unix.lisp -msgid "Write by others" +msgid "Socket operation on non-socket" msgstr "" #: src/code/unix.lisp -msgid "Execute (search directory) by others" +msgid "Destination address required" msgstr "" #: src/code/unix.lisp -msgid "" -"Given a file path string and a constant mode, unix-chmod changes the\n" -" permission mode for that file to the one specified. The new mode\n" -" can be created by logically OR'ing the following:\n" -"\n" -" setuidexec Set user ID on execution.\n" -" setgidexec Set group ID on execution.\n" -" savetext Save text image after execution.\n" -" readown Read by owner.\n" -" writeown Write by owner.\n" -" execown Execute (search directory) by owner.\n" -" readgrp Read by group.\n" -" writegrp Write by group.\n" -" execgrp Execute (search directory) by group.\n" -" readoth Read by others.\n" -" writeoth Write by others.\n" -" execoth Execute (search directory) by others.\n" -" \n" -" Thus #o444 and (logior unix:readown unix:readgrp unix:readoth)\n" -" are equivalent for 'mode. The octal-base is familar to Unix users.\n" -"\n" -" It returns T on successfully completion; NIL and an error number\n" -" otherwise." +msgid "Message too long" msgstr "" #: src/code/unix.lisp -msgid "" -"Given an integer file descriptor and a mode (the same as those\n" -" used for unix-chmod), unix-fchmod changes the permission mode\n" -" for that file to the one specified. T is returned if the call\n" -" was successful." +msgid "Protocol wrong type for socket" msgstr "" #: src/code/unix.lisp -msgid "" -"Given a file path, an integer user-id, and an integer group-id,\n" -" unix-chown changes the owner of the file and the group of the\n" -" file to those specified. Either the owner or the group may be\n" -" left unchanged by specifying them as -1. Note: Permission will\n" -" fail if the caller is not the superuser." +msgid "Protocol not available" msgstr "" #: src/code/unix.lisp -msgid "" -"Unix-fchown is like unix-chown, except that it accepts an integer\n" -" file descriptor instead of a file path name." +msgid "Protocol not supported" msgstr "" #: src/code/unix.lisp -msgid "" -"Unix-getdtablesize returns the maximum size of the file descriptor\n" -" table. (i.e. the maximum number of descriptors that can exist at\n" -" one time.)" +msgid "Socket type not supported" msgstr "" #: src/code/unix.lisp -msgid "" -"Unix-close takes an integer file descriptor as an argument and\n" -" closes the file associated with it. T is returned upon successful\n" -" completion, otherwise NIL and an error number." +msgid "Operation not supported on socket" msgstr "" #: src/code/unix.lisp -msgid "" -"Unix-creat accepts a file name and a mode (same as those for\n" -" unix-chmod) and creates a file by that name with the specified\n" -" permission mode. It returns a file descriptor on success,\n" -" or NIL and an error number otherwise.\n" -"\n" -" This interface is made obsolete by UNIX-OPEN." +msgid "Protocol family not supported" msgstr "" #: src/code/unix.lisp -msgid "" -"Unix-dup duplicates an existing file descriptor (given as the\n" -" argument) and return it. If FD is not a valid file descriptor, NIL\n" -" and an error number are returned." +msgid "Address family not supported by protocol family" msgstr "" #: src/code/unix.lisp -msgid "" -"Unix-dup2 duplicates an existing file descriptor just as unix-dup\n" -" does only the new value of the duplicate descriptor may be requested\n" -" through the second argument. If a file already exists with the\n" -" requested descriptor number, it will be closed and the number\n" -" assigned to the duplicate." +msgid "Address already in use" msgstr "" #: src/code/unix.lisp -msgid "Duplicate a file descriptor" +msgid "Can't assign requested address" msgstr "" #: src/code/unix.lisp -msgid "Get file desc. flags" +msgid "Network is down" msgstr "" #: src/code/unix.lisp -msgid "Set file desc. flags" +msgid "Network is unreachable" msgstr "" #: src/code/unix.lisp -msgid "Get file flags" +msgid "Network dropped connection on reset" msgstr "" #: src/code/unix.lisp -msgid "Set file flags" +msgid "Software caused connection abort" msgstr "" #: src/code/unix.lisp -msgid "Get owner" +msgid "Connection reset by peer" msgstr "" #: src/code/unix.lisp -msgid "Get lock" +msgid "No buffer space available" msgstr "" #: src/code/unix.lisp -msgid "Set owner" +msgid "Socket is already connected" msgstr "" #: src/code/unix.lisp -msgid "Set lock" +msgid "Socket is not connected" msgstr "" #: src/code/unix.lisp -msgid "Set lock, wait for release" +msgid "Can't send after socket shutdown" msgstr "" #: src/code/unix.lisp -msgid "Non-blocking reads" +msgid "Too many references: can't splice" msgstr "" #: src/code/unix.lisp -msgid "Append on each write" +msgid "Connection timed out" msgstr "" #: src/code/unix.lisp -msgid "Signal pgrp when data ready" +msgid "Connection refused" msgstr "" #: src/code/unix.lisp -msgid "Create if nonexistant" +msgid "Too many levels of symbolic links" msgstr "" #: src/code/unix.lisp -msgid "Truncate to zero length" +msgid "File name too long" msgstr "" #: src/code/unix.lisp -msgid "Error if already created" +msgid "Host is down" msgstr "" #: src/code/unix.lisp -msgid "" -"Unix-fcntl manipulates file descriptors according to the\n" -" argument CMD which can be one of the following:\n" -"\n" -" F-DUPFD Duplicate a file descriptor.\n" -" F-GETFD Get file descriptor flags.\n" -" F-SETFD Set file descriptor flags.\n" -" F-GETFL Get file flags.\n" -" F-SETFL Set file flags.\n" -" F-GETOWN Get owner.\n" -" F-SETOWN Set owner.\n" -"\n" -" The flags that can be specified for F-SETFL are:\n" -"\n" -" FNDELAY Non-blocking reads.\n" -" FAPPEND Append on each write.\n" -" FASYNC Signal pgrp when data ready.\n" -" FCREAT Create if nonexistant.\n" -" FTRUNC Truncate to zero length.\n" -" FEXCL Error if already created.\n" -" " +msgid "No route to host" msgstr "" #: src/code/unix.lisp -msgid "" -"Unix-link creates a hard link from the file with name1 to the\n" -" file with name2." +msgid "Directory not empty" msgstr "" #: src/code/unix.lisp -msgid "set the file pointer" +msgid "Too many processes" msgstr "" #: src/code/unix.lisp -msgid "increment the file pointer" +msgid "Too many users" msgstr "" #: src/code/unix.lisp -msgid "extend the file size" +msgid "Disc quota exceeded" msgstr "" #: src/code/unix.lisp -msgid "" -"Unix-lseek accepts a file descriptor and moves the file pointer ahead\n" -" a certain offset for that file. Whence can be any of the following:\n" -"\n" -" l_set Set the file pointer.\n" -" l_incr Increment the file pointer.\n" -" l_xtnd Extend the file size.\n" -" _N" +msgid "namei should continue locally" msgstr "" #: src/code/unix.lisp -msgid "" -"Unix-mkdir creates a new directory with the specified name and mode.\n" -" (Same as those for unix-chmod.) It returns T upon success, otherwise\n" -" NIL and an error number." +msgid "namei was handled remotely" msgstr "" #: src/code/unix.lisp -msgid "Read-only flag." +msgid "Remote file system error _N" msgstr "" #: src/code/unix.lisp -msgid "Write-only flag." +msgid "syscall was handled by Vice" msgstr "" #: src/code/unix.lisp -msgid "Read-write flag." +msgid "No message of desired type" msgstr "" #: src/code/unix.lisp -msgid "Non-blocking I/O" +msgid "Identifier removed" msgstr "" #: src/code/unix.lisp -msgid "Append flag." +msgid "Channel number out of range" msgstr "" #: src/code/unix.lisp -msgid "Create if nonexistant flag." +msgid "Level 2 not synchronized" msgstr "" #: src/code/unix.lisp -msgid "Truncate flag." +msgid "Level 3 halted" msgstr "" #: src/code/unix.lisp -msgid "Error if already exists." +msgid "Level 3 reset" msgstr "" #: src/code/unix.lisp -msgid "Don't assign controlling tty" +msgid "Link number out of range" msgstr "" #: src/code/unix.lisp -msgid "Non-blocking mode" +msgid "Protocol driver not attached" msgstr "" #: src/code/unix.lisp -msgid "Synchronous writes (on ext2)" +msgid "No CSI structure available" msgstr "" #: src/code/unix.lisp -msgid "" -"Unix-open opens the file whose pathname is specified by path\n" -" for reading and/or writing as specified by the flags argument.\n" -" The flags argument can be:\n" -"\n" -" o_rdonly Read-only flag.\n" -" o_wronly Write-only flag.\n" -" o_rdwr Read-and-write flag.\n" -" o_append Append flag.\n" -" o_creat Create-if-nonexistant flag.\n" -" o_trunc Truncate-to-size-0 flag.\n" -"\n" -" If the o_creat flag is specified, then the file is created with\n" -" a permission of argument mode if the file doesn't exist. An\n" -" integer file descriptor is returned by unix-open." +msgid "Level 2 halted" msgstr "" #: src/code/unix.lisp -msgid "" -"Unix-pipe sets up a unix-piping mechanism consisting of\n" -" an input pipe and an output pipe. Unix-Pipe returns two\n" -" values: if no error occurred the first value is the pipe\n" -" to be read from and the second is can be written to. If\n" -" an error occurred the first value is NIL and the second\n" -" the unix error code." +msgid "Deadlock situation detected/avoided" msgstr "" #: src/code/unix.lisp -msgid "" -"Unix-read attempts to read from the file described by fd into\n" -" the buffer buf until it is full. Len is the length of the buffer.\n" -" The number of bytes actually read is returned or NIL and an error\n" -" number if an error occured." +msgid "No record locks available" msgstr "" #: src/code/unix.lisp -msgid "" -"Unix-readlink invokes the readlink system call on the file name\n" -" specified by the simple string path. It returns up to two values:\n" -" the contents of the symbolic link if the call is successful, or\n" -" NIL and the Unix error number." +msgid "Error 47" msgstr "" #: src/code/unix.lisp -msgid "" -"Unix-rename renames the file with string name1 to the string\n" -" name2. NIL and an error code is returned if an error occured." +msgid "Error 48" msgstr "" #: src/code/unix.lisp -msgid "" -"Unix-rmdir attempts to remove the directory name. NIL and\n" -" an error number is returned if an error occured." +msgid "Bad exchange descriptor" msgstr "" #: src/code/unix.lisp -msgid "" -"Perform the UNIX select(2) system call.\n" -" (declare (type (integer 0 #.FD-SETSIZE) num-descriptors)\n" -" (type (or (alien (* (struct fd-set))) null)\n" -" read-fds write-fds exception-fds)\n" -" (type (or null (unsigned-byte 31)) timeout-secs)\n" -" (type (unsigned-byte 31) timeout-usecs)\n" -" (optimize (speed 3) (safety 0) (inhibit-warnings 3)))" +msgid "Bad request descriptor" msgstr "" #: src/code/unix.lisp -msgid "" -"Unix-select examines the sets of descriptors passed as arguments\n" -" to see if they are ready for reading and writing. See the UNIX\n" -" Programmers Manual for more information." +msgid "Message tables full" msgstr "" #: src/code/unix.lisp -msgid "" -"Unix-sync writes all information in core memory which has been\n" -" modified to disk. It returns NIL and an error code if an error\n" -" occured." +msgid "Anode table overflow" msgstr "" #: src/code/unix.lisp -msgid "" -"Unix-fsync writes the core image of the file described by\n" -" fd to disk." +msgid "Bad request code" msgstr "" #: src/code/unix.lisp -msgid "" -"Unix-truncate truncates the named file to the length (in\n" -" bytes) specified by len. NIL and an error number is returned\n" -" if the call is unsuccessful." +msgid "Invalid slot" msgstr "" #: src/code/unix.lisp -msgid "" -"Unix-ftruncate is similar to unix-truncate except that the first\n" -" argument is a file descriptor rather than a file name." +msgid "File locking deadlock" msgstr "" #: src/code/unix.lisp -msgid "" -"Unix-symlink creates a symbolic link named name2 to the file\n" -" named name1. NIL and an error number is returned if the call\n" -" is unsuccessful." +msgid "Bad font file format" msgstr "" #: src/code/unix.lisp -msgid "" -"Unix-unlink removes the directory entry for the named file.\n" -" NIL and an error code is returned if the call fails." +msgid "Not a stream device" msgstr "" #: src/code/unix.lisp -msgid "" -"Unix-write attempts to write a character buffer (buf) of length\n" -" len to the file described by the file descriptor fd. NIL and an\n" -" error is returned if the call is unsuccessful." +msgid "No data available" msgstr "" #: src/code/unix.lisp -msgid "" -"Unix-ioctl performs a variety of operations on open i/o\n" -" descriptors. See the UNIX Programmer's Manual for more\n" -" information." +msgid "Timer expired" msgstr "" #: src/code/unix.lisp -msgid "Get terminal attributes." +msgid "Out of stream resources" msgstr "" #: src/code/unix.lisp -msgid "Set terminal attributes." +msgid "Machine is not on the network" msgstr "" #: src/code/unix.lisp -msgid "Get terminal output speed." +msgid "Package not installed" msgstr "" #: src/code/unix.lisp -msgid "Set terminal output speed." +msgid "Object is remote" msgstr "" #: src/code/unix.lisp -msgid "Bogus baud rate ~S" +msgid "Link has been severed" msgstr "" #: src/code/unix.lisp -msgid "Get terminal input speed." +msgid "Advertise error" msgstr "" #: src/code/unix.lisp -msgid "Set terminal input speed." +msgid "Srmount error" msgstr "" #: src/code/unix.lisp -msgid "Send break" +msgid "Communication error on send" msgstr "" #: src/code/unix.lisp -msgid "Wait for output for finish" +msgid "Protocol error" msgstr "" #: src/code/unix.lisp -msgid "See tcflush(3)" +msgid "Multihop attempted" msgstr "" #: src/code/unix.lisp -msgid "Flow control" +msgid "Not a data message" msgstr "" #: src/code/unix.lisp -msgid "Set the tty-process-group for the unix file-descriptor FD to PGRP." +msgid "Value too large for defined data type" msgstr "" #: src/code/unix.lisp -msgid "Get the tty-process-group for the unix file-descriptor FD." +msgid "Name not unique on network" msgstr "" #: src/code/unix.lisp -msgid "" -"Get the tty-process-group for the unix file-descriptor FD. If not supplied," -"\n" -" FD defaults to /dev/tty." +msgid "File descriptor in bad state" msgstr "" #: src/code/unix.lisp -msgid "" -"Set the tty-process-group for the unix file-descriptor FD to PGRP. If not\n" -" supplied, FD defaults to /dev/tty." +msgid "Remote address changed" msgstr "" #: src/code/unix.lisp -msgid "Set the socket process-group for the unix file-descriptor FD to PGRP." +msgid "Can not access a needed shared library" msgstr "" #: src/code/unix.lisp -msgid "" -"Unix-exit terminates the current process with an optional\n" -" error code. If successful, the call doesn't return. If\n" -" unsuccessful, the call returns NIL and an error number." +msgid "Accessing a corrupted shared library" msgstr "" #: src/code/unix.lisp -msgid "" -"Unix-stat retrieves information about the specified\n" -" file returning them in the form of multiple values.\n" -" See the UNIX Programmer's Manual for a description\n" -" of the values returned. If the call fails, then NIL\n" -" and an error number is returned instead." +msgid ".lib section in a.out corrupted" msgstr "" #: src/code/unix.lisp -msgid "" -"Unix-lstat is similar to unix-stat except the specified\n" -" file must be a symbolic link." +msgid "Attempting to link in more shared libraries than system limit" msgstr "" #: src/code/unix.lisp -msgid "" -"Unix-fstat is similar to unix-stat except the file is specified\n" -" by the file descriptor fd." +msgid "Can not exec a shared library directly" msgstr "" #: src/code/unix.lisp -msgid "The calling process." +msgid "Error 88" msgstr "" #: src/code/unix.lisp -msgid "Terminated child processes." +msgid "Operation not applicable" msgstr "" #: src/code/unix.lisp msgid "" -"Like call getrusage, but return only the system and user time, and returns\n" -" the seconds and microseconds as separate values." +"Number of symbolic links encountered during path name traversal exceeds " +"MAXSYMLINKS" msgstr "" #: src/code/unix.lisp -msgid "" -"Unix-getrusage returns information about the resource usage\n" -" of the process specified by who. Who can be either the\n" -" current process (rusage_self) or all of the terminated\n" -" child processes (rusage_children). NIL and an error number\n" -" is returned if the call fails." +msgid "Error 91" msgstr "" #: src/code/unix.lisp -msgid "" -"Unix-times returns information about the cpu time usage of the process\n" -" and its children." +msgid "Error 92" msgstr "" #: src/code/unix.lisp -msgid "" -"If it works, unix-gettimeofday returns 5 values: T, the seconds and\n" -" microseconds of the current time of day, the timezone (in minutes west\n" -" of Greenwich), and a daylight-savings flag. If it doesn't work, it\n" -" returns NIL and the errno." +msgid "Option not supported by protocol" msgstr "" #: src/code/unix.lisp -msgid "" -"Unix-utimes sets the 'last-accessed' and 'last-updated'\n" -" times on a specified file. NIL and an error number is\n" -" returned if the call is unsuccessful." +msgid "Operation not supported on transport endpoint" msgstr "" #: src/code/unix.lisp -msgid "" -"Unix-setreuid sets the real and effective user-id's of the current\n" -" process to the specified ones. NIL and an error number is returned\n" -" if the call fails." +msgid "Cannot assign requested address" msgstr "" #: src/code/unix.lisp -msgid "" -"Unix-setregid sets the real and effective group-id's of the current\n" -" process process to the specified ones. NIL and an error number is\n" -" returned if the call fails." +msgid "Network dropped connection because of reset" msgstr "" #: src/code/unix.lisp -msgid "Unix-getpid returns the process-id of the current process." +msgid "Transport endpoint is already connected" msgstr "" #: src/code/unix.lisp -msgid "" -"Unix-getppid returns the process-id of the parent of the current process." +msgid "Transport endpoint is not connected" msgstr "" #: src/code/unix.lisp -msgid "Unix-getgid returns the real group-id of the current process." +msgid "Cannot send after socket shutdown" msgstr "" #: src/code/unix.lisp -msgid "Unix-getegid returns the effective group-id of the current process." +msgid "Too many references: cannot splice" msgstr "" #: src/code/unix.lisp -msgid "Unix-getpgrp returns the group-id of the calling process." +msgid "Stale NFS file handle" msgstr "" #: src/code/unix.lisp -msgid "" -"Unix-setpgrp sets the process group on the process pid to\n" -" pgrp. NIL and an error number are returned upon failure." +msgid "Resource deadlock would occur" msgstr "" #: src/code/unix.lisp -msgid "" -"Unix-setpgid sets the process group of the process pid to\n" -" pgrp. If pgid is equal to pid, the process becomes a process\n" -" group leader. NIL and an error number are returned upon failure." +msgid "Function not implemented" msgstr "" #: src/code/unix.lisp -msgid "" -"Unix-getuid returns the real user-id associated with the\n" -" current process." +msgid "Too many symbolic links encountered" msgstr "" #: src/code/unix.lisp -msgid "Unix-getpagesize returns the number of bytes in a system page." +msgid "Invalid exchange" msgstr "" #: src/code/unix.lisp -msgid "Unix-gethostname returns the name of the host machine as a string." +msgid "Invalid request descriptor" msgstr "" #: src/code/unix.lisp -msgid "" -"Unix-gethostid returns a 32-bit integer which provides unique\n" -" identification for the host machine." +msgid "Exchange full" msgstr "" #: src/code/unix.lisp -msgid "" -"Executes the unix fork system call. Returns 0 in the child and the pid\n" -" of the child in the parent if it works, or NIL and an error number if it\n" -" doesn't work." +msgid "No anode" msgstr "" #: src/code/unix.lisp -msgid "" -"Get the value of the environment variable named Name. If no such\n" -" variable exists, Nil is returned." +msgid "Invalid request code" msgstr "" #: src/code/unix.lisp -msgid "" -"Adds the environment variable named Name to the environment with\n" -" the given Value if Name does not already exist. If Name does exist,\n" -" the value is changed to Value if Overwrite is non-zero. Otherwise,\n" -" the value is not changed." +msgid "File locking deadlock error" msgstr "" #: src/code/unix.lisp -msgid "" -"Adds or changes the environment. Name-value must be a string of\n" -" the form \"name=value\". If the name does not exist, it is added.\n" -" If name does exist, the value is updated to the given value." +msgid "Device not a stream" msgstr "" #: src/code/unix.lisp -msgid "Removes the variable Name from the environment" +msgid "Out of streams resources" msgstr "" #: src/code/unix.lisp -msgid "Returns either :file, :directory, :link, :special, or NIL." +msgid "RFS specific error" msgstr "" #: src/code/unix.lisp -msgid "Returns the pathname with all symbolic links resolved." +msgid "Attempting to link in too many shared libraries" msgstr "" #: src/code/unix.lisp -msgid "Error reading link ~S: ~S" +msgid "Cannot exec a shared library directly" msgstr "" #: src/code/unix.lisp -msgid "" -"Accepts a Unix file descriptor and returns T if the device\n" -" associated with it is a terminal." +msgid "Illegal byte sequence" msgstr "" #: src/code/unix.lisp -msgid "" -"Executes the Unix execve system call. If the system call suceeds, lisp\n" -" will no longer be running in this process. If the system call fails " -"this\n" -" function returns two values: NIL and an error code. Arg-list should be " -"a\n" -" list of simple-strings which are passed as arguments to the exec'ed " -"program.\n" -" Environment should be an a-list mapping symbols to simple-strings which " -"this\n" -" function bashes together to form the environment for the exec'ed " -"program." +msgid "Interrupted system call should be restarted _N" msgstr "" #: src/code/unix.lisp -msgid "" -"Unix-getitimer returns the INTERVAL and VALUE slots of one of\n" -" three system timers (:real :virtual or :profile). On success,\n" -" unix-getitimer returns 5 values,\n" -" T, it-interval-secs, it-interval-usec, it-value-secs, it-value-usec." +msgid "Streams pipe error" msgstr "" #: src/code/unix.lisp -msgid "" -" Unix-setitimer sets the INTERVAL and VALUE slots of one of\n" -" three system timers (:real :virtual or :profile). A SIGALRM signal\n" -" will be delivered VALUE <seconds+microseconds> from now. INTERVAL,\n" -" when non-zero, is <seconds+microseconds> to be loaded each time\n" -" the timer expires. Setting INTERVAL and VALUE to zero disables\n" -" the timer. See the Unix man page for more details. On success,\n" -" unix-setitimer returns the old contents of the INTERVAL and VALUE\n" -" slots as in unix-getitimer." +msgid "Address family not supported by protocol" msgstr "" #: src/code/unix.lisp -msgid "" -"Return a USER-INFO structure for the user identified by LOGIN, or NIL if " -"not found." +msgid "Cannot send after transport endpoint shutdown" msgstr "" #: src/code/unix.lisp -msgid "" -"Return a USER-INFO structure for the user identified by UID, or NIL if not " -"found." +msgid "Structure needs cleaning" msgstr "" #: src/code/unix.lisp -msgid "The maximum size of the group entry buffer" +msgid "Not a XENIX named type file" msgstr "" #: src/code/unix.lisp -msgid "" -"Return a GROUP-INFO structure for the group identified by NAME, or NIL if " -"not found." +msgid "No XENIX semaphores available" msgstr "" #: src/code/unix.lisp -msgid "" -"Return a GROUP-INFO structure for the group identified by GID, or NIL if " -"not found." +msgid "Is a named type file" msgstr "" #: src/code/unix.lisp -msgid "CPU time per process (in milliseconds)" +msgid "Remote I/O error" msgstr "" #: src/code/unix.lisp -msgid "Maximum file size" +msgid "Quota exceeded" msgstr "" #: src/code/unix.lisp -msgid "Data segment size" +msgid "" +"Returns a string describing the error number which was returned by a\n" +" UNIX system call." msgstr "" #: src/code/unix.lisp -msgid "Stack size" +msgid "Unknown error [~d]" msgstr "" #: src/code/unix.lisp -msgid "Core file size" +msgid "" +"Perform the UNIX select(2) system call.\n" +" (declare (type (integer 0 #.FD-SETSIZE) num-descriptors)\n" +" (type (or (alien (* (struct fd-set))) null)\n" +" read-fds write-fds exception-fds)\n" +" (type (or null (unsigned-byte 31)) timeout-secs)\n" +" (type (unsigned-byte 31) timeout-usecs)\n" +" (optimize (speed 3) (safety 0) (inhibit-warnings 3)))" msgstr "" #: src/code/unix.lisp -msgid "Number of open files" +msgid "" +"Unix-select examines the sets of descriptors passed as arguments\n" +" to see if they are ready for reading and writing. See the UNIX\n" +" Programmers Manual for more information." msgstr "" #: src/code/unix.lisp -msgid "Maximum mapped memory" +msgid "" +"Unix-symlink creates a symbolic link named name2 to the file\n" +" named name1. NIL and an error number is returned if the call\n" +" is unsuccessful." msgstr "" #: src/code/unix.lisp -msgid "CPU time per process" +msgid "" +"If it works, unix-gettimeofday returns 5 values: T, the seconds and\n" +" microseconds of the current time of day, the timezone (in minutes west\n" +" of Greenwich), and a daylight-savings flag. If it doesn't work, it\n" +" returns NIL and the errno." msgstr "" #: src/code/unix.lisp -msgid "File size" +msgid "" +"Unix-utimes sets the 'last-accessed' and 'last-updated'\n" +" times on a specified file. NIL and an error number is\n" +" returned if the call is unsuccessful." msgstr "" #: src/code/unix.lisp -msgid "Addess space (resident set size)" +msgid "Unix-getpid returns the process-id of the current process." msgstr "" #: src/code/unix.lisp -msgid "Locked-in-memory address space" +msgid "" +"Accepts a Unix file descriptor and returns T if the device\n" +" associated with it is a terminal." msgstr "" #: src/code/unix.lisp -msgid "Number of processes" +msgid "" +" Unix-setitimer sets the INTERVAL and VALUE slots of one of\n" +" three system timers (:real :virtual or :profile). A SIGALRM signal\n" +" will be delivered VALUE <seconds+microseconds> from now. INTERVAL,\n" +" when non-zero, is <seconds+microseconds> to be loaded each time\n" +" the timer expires. Setting INTERVAL and VALUE to zero disables\n" +" the timer. See the Unix man page for more details. On success,\n" +" unix-setitimer returns the old contents of the INTERVAL and VALUE\n" +" slots as in unix-getitimer." msgstr "" #: src/code/unix.lisp msgid "" -"Get the limits on the consumption of system resouce specified by\n" -" Resource. If successful, return three values: T, the current (soft)\n" -" limit, and the maximum (hard) limit." +"Return a USER-INFO structure for the user identified by UID, or NIL if not " +"found." msgstr "" View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/f260121544e4f793509b2bb2e…

1 0

[cmucl/cmucl][rtoy-unix-core] Compile unix.lisp like we do for asdf and defsystem.
by Raymond Toy 22 Apr '15

22 Apr '15

Raymond Toy pushed to rtoy-unix-core at cmucl / cmucl Commits: 77a830ba by Raymond Toy at 2015-04-21T20:43:58Z Compile unix.lisp like we do for asdf and defsystem. - - - - - 1 changed file: - bin/build.sh Changes: ===================================== bin/build.sh ===================================== --- a/bin/build.sh +++ b/bin/build.sh @@ -260,6 +260,9 @@ $TARGET/lisp/lisp -noinit -nositeinit -batch "$@" << EOF || exit 3 (compile-file "modules:asdf/asdf") (compile-file "modules:defsystem/defsystem") +(intl::install) +(ext:without-package-locks + (compile-file "modules:unix/unix")) EOF View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/77a830ba32df5f5cc32d3d2d0…

1 0

[cmucl/cmucl][rtoy-unix-core] 2 commits: %name->file and %file->name macros need to be defined for
by Raymond Toy 22 Apr '15

22 Apr '15

Raymond Toy pushed to rtoy-unix-core at cmucl / cmucl Commits: b81c7be3 by Raymond Toy at 2015-04-21T19:55:56Z %name->file and %file->name macros need to be defined for contrib/unix/unix.lisp. Why are these macros anyway? Can't they be functions? - - - - - 4f53f883 by Raymond Toy at 2015-04-21T19:57:45Z Install unix.lisp along with asdf and defsystem. - - - - - 2 changed files: - bin/make-main-dist.sh - src/code/unix.lisp Changes: ===================================== bin/make-main-dist.sh ===================================== --- a/bin/make-main-dist.sh +++ b/bin/make-main-dist.sh @@ -127,7 +127,7 @@ do done # Create the directories and install the fasl files for asdf and defsystem -for f in asdf defsystem +for f in asdf defsystem unix do install -d ${GROUP} ${OWNER} -m 0755 $DESTDIR/lib/cmucl/lib/contrib/$f install ${GROUP} ${OWNER} -m 0644 $TARGET/contrib/$f/$f.$FASL $DESTDIR/lib/cmucl/lib/contrib/$f ===================================== src/code/unix.lisp ===================================== --- a/src/code/unix.lisp +++ b/src/code/unix.lisp @@ -25,7 +25,7 @@ ;; Must be set to NIL initially to enable building Lisp! (defvar *filename-encoding* nil) -(eval-when (:compile-toplevel) +(eval-when (:compile-toplevel :load-toplevel :execute) (defmacro %name->file (string) `(if *filename-encoding* (string-encode ,string *filename-encoding*) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/compare/17c7bba5dfd6d901a4599d35…

1 0

[cmucl/cmucl][rtoy-unix-core] 3 commits: Put back a comment.
by Raymond Toy 18 Apr '15

18 Apr '15

Raymond Toy pushed to rtoy-unix-core at cmucl / cmucl Commits: d3f0167d by Raymond Toy at 2015-04-18T16:39:26Z Put back a comment. - - - - - 852b35a7 by Raymond Toy at 2015-04-18T16:40:05Z Remove items that are already in code/unix.lisp. - - - - - 17c7bba5 by Raymond Toy at 2015-04-18T16:42:53Z Add a unix module so users can (require :unix) to get the rest of the unix package functions. This is for backward copmatibility. - - - - - 4 changed files: - src/code/module.lisp - src/code/unix.lisp - + src/contrib/load-unix.lisp - src/contrib/unix/unix.lisp Changes: ===================================== src/code/module.lisp ===================================== --- a/src/code/module.lisp +++ b/src/code/module.lisp @@ -161,3 +161,6 @@ (defmodule :cmu-contribs "modules:contrib") + +(defmodule :unix + "modules:load-unix") ===================================== src/code/unix.lisp ===================================== --- a/src/code/unix.lisp +++ b/src/code/unix.lisp @@ -2194,6 +2194,9 @@ (it-interval (struct timeval)) ; timer interval (it-value (struct timeval)))) ; current value +;;; +;;; Support for the Interval Timer (experimental) +;;; (defconstant ITIMER-REAL 0) (defconstant ITIMER-VIRTUAL 1) (defconstant ITIMER-PROF 2) ===================================== src/contrib/load-unix.lisp ===================================== --- /dev/null +++ b/src/contrib/load-unix.lisp @@ -0,0 +1,6 @@ +;; Load extra functionality in the UNIX package. + +(ext:without-package-locks + (load "modules:unix/unix")) + +(provide 'unix) ===================================== src/contrib/unix/unix.lisp ===================================== --- a/src/contrib/unix/unix.lisp +++ b/src/contrib/unix/unix.lisp @@ -4,8 +4,10 @@ ;;; This code was written as part of the CMU Common Lisp project at ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; +;;; This contains extra functionality for the UNIX package that is not +;;; needed by CMUCL core. (ext:file-comment - "$Header: src/code/unix.lisp $") + "$Header: src/contrib/unix/unix.lisp $") ;;; ;;; ********************************************************************** ;;; @@ -18,13 +20,6 @@ (use-package "EXT") (intl:textdomain "cmucl-unix") -;; Check the G_BROKEN_FILENAMES environment variable; if set the encoding -;; is locale-dependent...else use :utf-8 on Unicode Lisps. On 8 bit Lisps -;; it must be set to :iso8859-1 (or left as NIL), making files with -;; non-Latin-1 characters "mojibake", but otherwise they'll be inaccessible. -;; Must be set to NIL initially to enable building Lisp! -(defvar *filename-encoding* nil) - (export '(daddr-t caddr-t ino-t swblk-t size-t time-t dev-t off-t uid-t gid-t timeval tv-sec tv-usec timezone tz-minuteswest tz-dsttime itimerval it-interval it-value tchars t-intrc t-quitc t-startc @@ -188,24 +183,11 @@ unix-uname)) -(pushnew :unix *features*) - -(eval-when (:compile-toplevel) - (defmacro %name->file (string) - `(if *filename-encoding* - (string-encode ,string *filename-encoding*) - ,string)) - (defmacro %file->name (string) - `(if *filename-encoding* - (string-decode ,string *filename-encoding*) - ,string))) - ;;;; Common machine independent structures. ;;; From sys/types.h -(def-alien-type int64-t (signed 64)) (def-alien-type u-int64-t (unsigned 64)) (def-alien-type daddr-t @@ -214,53 +196,9 @@ (def-alien-type caddr-t (* char)) -(def-alien-type ino-t - #+netbsd u-int64-t - #+alpha unsigned-int - #-(or alpha netbsd) unsigned-long) - (def-alien-type swblk-t long) -(def-alien-type size-t - #-(or linux alpha) long - #+linux unsigned-int - #+alpha unsigned-long) - -(def-alien-type time-t - #-(or bsd linux alpha) unsigned-long - #+linux long - #+(and bsd (not netbsd)) long - #+(and bsd netbsd) int64-t - #+alpha unsigned-int) - -(def-alien-type dev-t - #-(or alpha svr4 bsd linux) short - #+linux unsigned-short - #+netbsd u-int64-t - #+alpha int - #+(and (not linux) (not netbsd) (or bsd svr4)) unsigned-long) - -#-BSD -(progn - (deftype file-offset () '(signed-byte 32)) - (def-alien-type off-t - #-alpha long - #+alpha unsigned-long) ;??? very dubious - (def-alien-type uid-t - #-(or alpha svr4) unsigned-short - #+alpha unsigned-int - #+svr4 long) - (def-alien-type gid-t - #-(or alpha svr4) unsigned-short - #+alpha unsigned-int - #+svr4 long)) - -#+BSD -(progn - (deftype file-offset () '(signed-byte 64)) - (def-alien-type off-t int64-t) - (def-alien-type uid-t unsigned-long) - (def-alien-type gid-t unsigned-long)) + ;;; Large file support for Solaris. Define some of the 64-bit types ;;; we need. Unlike unix-glibc's large file support, Solaris's @@ -283,76 +221,13 @@ (def-alien-type ino64-t u-int64-t) (def-alien-type blkcnt64-t u-int64-t)) -(def-alien-type mode-t - #-(or alpha svr4) unsigned-short - #+alpha unsigned-int - #+svr4 unsigned-long) - (def-alien-type nlink-t #-(or svr4 netbsd) unsigned-short #+netbsd unsigned-long #+svr4 unsigned-long) -(defconstant FD-SETSIZE - #-(or hpux alpha linux FreeBSD) 256 - #+hpux 2048 #+alpha 4096 #+(or linux FreeBSD) 1024) - -;; not checked for linux... -(def-alien-type nil - (struct fd-set - (fds-bits (array #-alpha unsigned-long #+alpha int #.(/ fd-setsize 32))))) - -;; not checked for linux... -(defmacro fd-set (offset fd-set) - (let ((word (gensym)) - (bit (gensym))) - `(multiple-value-bind (,word ,bit) (floor ,offset 32) - (setf (deref (slot ,fd-set 'fds-bits) ,word) - (logior (truly-the (unsigned-byte 32) (ash 1 ,bit)) - (deref (slot ,fd-set 'fds-bits) ,word)))))) - -;; not checked for linux... -(defmacro fd-clr (offset fd-set) - (let ((word (gensym)) - (bit (gensym))) - `(multiple-value-bind (,word ,bit) (floor ,offset 32) - (setf (deref (slot ,fd-set 'fds-bits) ,word) - (logand (deref (slot ,fd-set 'fds-bits) ,word) - (32bit-logical-not - (truly-the (unsigned-byte 32) (ash 1 ,bit)))))))) - -;; not checked for linux... -(defmacro fd-isset (offset fd-set) - (let ((word (gensym)) - (bit (gensym))) - `(multiple-value-bind (,word ,bit) (floor ,offset 32) - (logbitp ,bit (deref (slot ,fd-set 'fds-bits) ,word))))) - -;; not checked for linux... -(defmacro fd-zero (fd-set) - `(progn - ,@(loop for index upfrom 0 below (/ fd-setsize 32) - collect `(setf (deref (slot ,fd-set 'fds-bits) ,index) 0)))) - ;;; From sys/time.h -(def-alien-type nil - (struct timeval - (tv-sec #-linux time-t #+linux int) ; seconds - (tv-usec int))) ; and microseconds - -(def-alien-type nil - (struct timezone - (tz-minuteswest int) ; minutes west of Greenwich - (tz-dsttime ; type of dst correction - #-linux (enum nil :none :usa :aust :wet :met :eet :can) - #+linux int))) - -(def-alien-type nil - (struct itimerval - (it-interval (struct timeval)) ; timer interval - (it-value (struct timeval)))) ; current value - #+(or linux svr4) ; High-res time. Actually posix definition under svr4 name. (def-alien-type nil @@ -360,142 +235,11 @@ (tv-sec time-t) (tv-nsec long))) -#+(or linux BSD) -(def-alien-type nil - (struct timespec-t - (ts-sec time-t) - (ts-nsec long))) - ;;; From ioctl.h -(def-alien-type nil - (struct tchars - (t-intrc char) ; interrupt - (t-quitc char) ; quit - #+linux (t-eofc char) - (t-startc char) ; start output - (t-stopc char) ; stop output - #-linux (t-eofc char) ; end-of-file - (t-brkc char))) ; input delimiter (like nl) - -;; not found (semi) linux -(def-alien-type nil - (struct ltchars - #+linux (t-werasc char) ; word erase - (t-suspc char) ; stop process signal - (t-dsuspc char) ; delayed stop process signal - (t-rprntc char) ; reprint line - (t-flushc char) ; flush output (toggles) - #-linux (t-werasc char) ; word erase - (t-lnextc char))) ; literal next character - - -(def-alien-type nil - (struct sgttyb - #+linux (sg-flags #+mach short #-mach int) ; mode flags - (sg-ispeed char) ; input speed. - (sg-ospeed char) ; output speed - (sg-erase char) ; erase character - #-linux (sg-kill char) ; kill character - #-linux (sg-flags #+mach short #-mach int) ; mode flags - #+linux (sg-kill char) - #+linux (t (struct termios)) - #+linux (check int))) -(def-alien-type nil - (struct winsize - (ws-row unsigned-short) ; rows, in characters - (ws-col unsigned-short) ; columns, in characters - (ws-xpixel unsigned-short) ; horizontal size, pixels - (ws-ypixel unsigned-short))) ; veritical size, pixels - - -;;; From sys/termios.h - -;;; NOTE: There is both a termio (SYSV) and termios (POSIX) -;;; structure with similar but incompatible definitions. It may be that -;;; the non-BSD variant of termios below is really a termio but I (pw) -;;; can't verify. The BSD variant uses the Posix termios def. Some systems -;;; (Ultrix and OSF1) seem to support both if used independently. -;;; The 17f version of this seems a bit confused wrt the conditionals. -;;; Please check these defs for your system. - -;;; TSM: from what I can tell looking at the 17f definition, my guess is that it -;;; was originally a termio for sunos (nonsolaris) (because it had the c-line -;;; member for sunos only), and then was mutated into the termios definition for -;;; later systems. The definition here is definitely not an IRIX termio because -;;; it doesn't have c-line. In any case, the functions tcgetattr, etc., -;;; definitely take a termios, and termios seems to be the more standard -;;; standard now, so my suggestion is to just go with termios and forget about -;;; termio. Note the SVID says NCCS not NCC for the constant here, so I've -;;; changed it (which means you need to bootstrap it to avoid a reader error). - -;;; On top of all that, SGI decided to change the termios structure on irix -;;; 6.[34] (but NOT 6.2), left the old routines named the same in the library, -;;; but introduced static functions in termios.h to redirect new calls to the -;;; new library--which means it's important not to #include termios.h before -;;; undefineds.h when building lisp. - -(defconstant +NCCS+ - #+hpux 16 - #+irix 23 - #+(or linux solaris) 19 - #+(or bsd osf1) 20 - #+(and sunos (not svr4)) 17 - _N"Size of control character vector.") - -(def-alien-type nil - (struct termios - (c-iflag unsigned-int) - (c-oflag unsigned-int) - (c-cflag unsigned-int) - (c-lflag unsigned-int) - #+(or linux hpux (and sunos (not svr4))) - (c-reserved #-(or linux (and sunos (not svr4))) unsigned-int - #+(or linux (and sunos (not svr4))) unsigned-char) - (c-cc (array unsigned-char #.+NCCS+)) - #+(or bsd osf1) (c-ispeed unsigned-int) - #+(or bsd osf1) (c-ospeed unsigned-int))) ;;; From sys/dir.h ;;; -;;; (For Solaris, this is not struct direct, but struct dirent!) -#-bsd -(def-alien-type nil - (struct direct - #+(and sunos (not svr4)) (d-off long) ; offset of next disk directory entry - (d-ino ino-t); inode number of entry - #+(or linux svr4) (d-off long) - (d-reclen unsigned-short) ; length of this record - #-(or linux svr4) - (d-namlen unsigned-short) ; length of string in d-name - (d-name (array char 256)))) ; name must be no longer than this - -#+(and bsd (not netbsd)) -(def-alien-type nil - (struct direct - (d-fileno unsigned-long) - (d-reclen unsigned-short) - (d-type unsigned-char) - (d-namlen unsigned-char) ; length of string in d-name - (d-name (array char 256)))) ; name must be no longer than this - -#+netbsd -(def-alien-type nil - (struct direct - (d-fileno ino-t) - (d-reclen unsigned-short) - (d-namlen unsigned-short) - (d-type unsigned-char) - (d-name (array char 512)))) - -;;; The 64-bit version of struct dirent. -#+solaris -(def-alien-type nil - (struct dirent64 - (d-ino ino64-t); inode number of entry - (d-off off64-t) ; offset of next disk directory entry - (d-reclen unsigned-short) ; length of this record - (d-name (array char 256)))) ; name must be no longer than this ;;; From sys/stat.h @@ -522,27 +266,6 @@ (st-blocks #-alpha long #+alpha int) (st-spare4 (array long 2)))) -#+(and bsd (not netbsd)) -(def-alien-type nil - (struct stat - (st-dev dev-t) - (st-ino ino-t) - (st-mode mode-t) - (st-nlink nlink-t) - (st-uid uid-t) - (st-gid gid-t) - (st-rdev dev-t) - (st-atime (struct timespec-t)) - (st-mtime (struct timespec-t)) - (st-ctime (struct timespec-t)) - (st-size off-t) - (st-blocks off-t) - (st-blksize unsigned-long) - (st-flags unsigned-long) - (st-gen unsigned-long) - (st-lspare long) - (st-qspare (array long 4)))) - #+netbsd (def-alien-type nil (struct stat @@ -619,395 +342,23 @@ (st-fstype (array char 16)) (st-pad4 (array long 8)))) -(defconstant s-ifmt #o0170000) -(defconstant s-ifdir #o0040000) -(defconstant s-ifchr #o0020000) -#+linux (defconstant s-ififo #x0010000) -(defconstant s-ifblk #o0060000) -(defconstant s-ifreg #o0100000) -(defconstant s-iflnk #o0120000) -(defconstant s-ifsock #o0140000) -(defconstant s-isuid #o0004000) -(defconstant s-isgid #o0002000) -(defconstant s-isvtx #o0001000) -(defconstant s-iread #o0000400) -(defconstant s-iwrite #o0000200) -(defconstant s-iexec #o0000100) - ;;; From sys/resource.h (def-alien-type nil - (struct rusage - (ru-utime (struct timeval)) ; user time used - (ru-stime (struct timeval)) ; system time used. - (ru-maxrss long) - (ru-ixrss long) ; integral sharded memory size - (ru-idrss long) ; integral unsharded data " - (ru-isrss long) ; integral unsharded stack " - (ru-minflt long) ; page reclaims - (ru-majflt long) ; page faults - (ru-nswap long) ; swaps - (ru-inblock long) ; block input operations - (ru-oublock long) ; block output operations - (ru-msgsnd long) ; messages sent - (ru-msgrcv long) ; messages received - (ru-nsignals long) ; signals received - (ru-nvcsw long) ; voluntary context switches - (ru-nivcsw long))) ; involuntary " - -(def-alien-type nil (struct rlimit (rlim-cur #-(or linux alpha) int #+linux long #+alpha unsigned-int) ; current (soft) limit (rlim-max #-(or linux alpha) int #+linux long #+alpha unsigned-int))); maximum value for rlim-cur -;;;; Errno stuff. - -(eval-when (compile eval) - -(defparameter *compiler-unix-errors* nil) - -(defmacro def-unix-error (name number description) - `(progn - (eval-when (compile eval) - (push (cons ,number ,description) *compiler-unix-errors*)) - (defconstant ,name ,number ,description) - (export ',name))) - -(defmacro emit-unix-errors () - (let* ((max (apply #'max (mapcar #'car *compiler-unix-errors*))) - (array (make-array (1+ max) :initial-element nil))) - (dolist (error *compiler-unix-errors*) - (setf (svref array (car error)) (cdr error))) - `(progn - (defvar *unix-errors* ',array) - (declaim (simple-vector *unix-errors*))))) - -) ;eval-when - -;;; -;;; From <errno.h> -;;; -(def-unix-error ESUCCESS 0 _N"Successful") -(def-unix-error EPERM 1 _N"Operation not permitted") -(def-unix-error ENOENT 2 _N"No such file or directory") -(def-unix-error ESRCH 3 _N"No such process") -(def-unix-error EINTR 4 _N"Interrupted system call") -(def-unix-error EIO 5 _N"I/O error") -(def-unix-error ENXIO 6 _N"Device not configured") -(def-unix-error E2BIG 7 _N"Arg list too long") -(def-unix-error ENOEXEC 8 _N"Exec format error") -(def-unix-error EBADF 9 _N"Bad file descriptor") -(def-unix-error ECHILD 10 _N"No child process") -#+bsd(def-unix-error EDEADLK 11 _N"Resource deadlock avoided") -#-bsd(def-unix-error EAGAIN 11 #-linux _N"No more processes" #+linux _N"Try again") -(def-unix-error ENOMEM 12 _N"Out of memory") -(def-unix-error EACCES 13 _N"Permission denied") -(def-unix-error EFAULT 14 _N"Bad address") -(def-unix-error ENOTBLK 15 _N"Block device required") -(def-unix-error EBUSY 16 _N"Device or resource busy") -(def-unix-error EEXIST 17 _N"File exists") -(def-unix-error EXDEV 18 _N"Cross-device link") -(def-unix-error ENODEV 19 _N"No such device") -(def-unix-error ENOTDIR 20 _N"Not a director") -(def-unix-error EISDIR 21 _N"Is a directory") -(def-unix-error EINVAL 22 _N"Invalid argument") -(def-unix-error ENFILE 23 _N"File table overflow") -(def-unix-error EMFILE 24 _N"Too many open files") -(def-unix-error ENOTTY 25 _N"Inappropriate ioctl for device") -(def-unix-error ETXTBSY 26 _N"Text file busy") -(def-unix-error EFBIG 27 _N"File too large") -(def-unix-error ENOSPC 28 _N"No space left on device") -(def-unix-error ESPIPE 29 _N"Illegal seek") -(def-unix-error EROFS 30 _N"Read-only file system") -(def-unix-error EMLINK 31 _N"Too many links") -(def-unix-error EPIPE 32 _N"Broken pipe") -;;; -;;; Math -(def-unix-error EDOM 33 _N"Numerical argument out of domain") -(def-unix-error ERANGE 34 #-linux _N"Result too large" #+linux _N"Math result not representable") -;;; -#-(or linux svr4) -(progn -;;; non-blocking and interrupt i/o -(def-unix-error EWOULDBLOCK 35 _N"Operation would block") -#-bsd(def-unix-error EDEADLK 35 _N"Operation would block") ; Ditto -#+bsd(def-unix-error EAGAIN 35 _N"Resource temporarily unavailable") -(def-unix-error EINPROGRESS 36 _N"Operation now in progress") -(def-unix-error EALREADY 37 _N"Operation already in progress") -;;; -;;; ipc/network software -(def-unix-error ENOTSOCK 38 _N"Socket operation on non-socket") -(def-unix-error EDESTADDRREQ 39 _N"Destination address required") -(def-unix-error EMSGSIZE 40 _N"Message too long") -(def-unix-error EPROTOTYPE 41 _N"Protocol wrong type for socket") -(def-unix-error ENOPROTOOPT 42 _N"Protocol not available") -(def-unix-error EPROTONOSUPPORT 43 _N"Protocol not supported") -(def-unix-error ESOCKTNOSUPPORT 44 _N"Socket type not supported") -(def-unix-error EOPNOTSUPP 45 _N"Operation not supported on socket") -(def-unix-error EPFNOSUPPORT 46 _N"Protocol family not supported") -(def-unix-error EAFNOSUPPORT 47 _N"Address family not supported by protocol family") -(def-unix-error EADDRINUSE 48 _N"Address already in use") -(def-unix-error EADDRNOTAVAIL 49 _N"Can't assign requested address") -;;; -;;; operational errors -(def-unix-error ENETDOWN 50 _N"Network is down") -(def-unix-error ENETUNREACH 51 _N"Network is unreachable") -(def-unix-error ENETRESET 52 _N"Network dropped connection on reset") -(def-unix-error ECONNABORTED 53 _N"Software caused connection abort") -(def-unix-error ECONNRESET 54 _N"Connection reset by peer") -(def-unix-error ENOBUFS 55 _N"No buffer space available") -(def-unix-error EISCONN 56 _N"Socket is already connected") -(def-unix-error ENOTCONN 57 _N"Socket is not connected") -(def-unix-error ESHUTDOWN 58 _N"Can't send after socket shutdown") -(def-unix-error ETOOMANYREFS 59 _N"Too many references: can't splice") -(def-unix-error ETIMEDOUT 60 _N"Connection timed out") -(def-unix-error ECONNREFUSED 61 _N"Connection refused") -;;; -(def-unix-error ELOOP 62 _N"Too many levels of symbolic links") -(def-unix-error ENAMETOOLONG 63 _N"File name too long") -;;; -(def-unix-error EHOSTDOWN 64 _N"Host is down") -(def-unix-error EHOSTUNREACH 65 _N"No route to host") -(def-unix-error ENOTEMPTY 66 _N"Directory not empty") -;;; -;;; quotas & resource -(def-unix-error EPROCLIM 67 _N"Too many processes") -(def-unix-error EUSERS 68 _N"Too many users") -(def-unix-error EDQUOT 69 _N"Disc quota exceeded") -;;; -;;; CMU RFS -(def-unix-error ELOCAL 126 _N"namei should continue locally") -(def-unix-error EREMOTE 127 _N"namei was handled remotely") -;;; -;;; VICE -(def-unix-error EVICEERR 70 _N"Remote file system error _N") -(def-unix-error EVICEOP 71 _N"syscall was handled by Vice") -) -#+svr4 -(progn -(def-unix-error ENOMSG 35 _N"No message of desired type") -(def-unix-error EIDRM 36 _N"Identifier removed") -(def-unix-error ECHRNG 37 _N"Channel number out of range") -(def-unix-error EL2NSYNC 38 _N"Level 2 not synchronized") -(def-unix-error EL3HLT 39 _N"Level 3 halted") -(def-unix-error EL3RST 40 _N"Level 3 reset") -(def-unix-error ELNRNG 41 _N"Link number out of range") -(def-unix-error EUNATCH 42 _N"Protocol driver not attached") -(def-unix-error ENOCSI 43 _N"No CSI structure available") -(def-unix-error EL2HLT 44 _N"Level 2 halted") -(def-unix-error EDEADLK 45 _N"Deadlock situation detected/avoided") -(def-unix-error ENOLCK 46 _N"No record locks available") -(def-unix-error ECANCELED 47 _N"Error 47") -(def-unix-error ENOTSUP 48 _N"Error 48") -(def-unix-error EBADE 50 _N"Bad exchange descriptor") -(def-unix-error EBADR 51 _N"Bad request descriptor") -(def-unix-error EXFULL 52 _N"Message tables full") -(def-unix-error ENOANO 53 _N"Anode table overflow") -(def-unix-error EBADRQC 54 _N"Bad request code") -(def-unix-error EBADSLT 55 _N"Invalid slot") -(def-unix-error EDEADLOCK 56 _N"File locking deadlock") -(def-unix-error EBFONT 57 _N"Bad font file format") -(def-unix-error ENOSTR 60 _N"Not a stream device") -(def-unix-error ENODATA 61 _N"No data available") -(def-unix-error ETIME 62 _N"Timer expired") -(def-unix-error ENOSR 63 _N"Out of stream resources") -(def-unix-error ENONET 64 _N"Machine is not on the network") -(def-unix-error ENOPKG 65 _N"Package not installed") -(def-unix-error EREMOTE 66 _N"Object is remote") -(def-unix-error ENOLINK 67 _N"Link has been severed") -(def-unix-error EADV 68 _N"Advertise error") -(def-unix-error ESRMNT 69 _N"Srmount error") -(def-unix-error ECOMM 70 _N"Communication error on send") -(def-unix-error EPROTO 71 _N"Protocol error") -(def-unix-error EMULTIHOP 74 _N"Multihop attempted") -(def-unix-error EBADMSG 77 _N"Not a data message") -(def-unix-error ENAMETOOLONG 78 _N"File name too long") -(def-unix-error EOVERFLOW 79 _N"Value too large for defined data type") -(def-unix-error ENOTUNIQ 80 _N"Name not unique on network") -(def-unix-error EBADFD 81 _N"File descriptor in bad state") -(def-unix-error EREMCHG 82 _N"Remote address changed") -(def-unix-error ELIBACC 83 _N"Can not access a needed shared library") -(def-unix-error ELIBBAD 84 _N"Accessing a corrupted shared library") -(def-unix-error ELIBSCN 85 _N".lib section in a.out corrupted") -(def-unix-error ELIBMAX 86 _N"Attempting to link in more shared libraries than system limit") -(def-unix-error ELIBEXEC 87 _N"Can not exec a shared library directly") -(def-unix-error EILSEQ 88 _N"Error 88") -(def-unix-error ENOSYS 89 _N"Operation not applicable") -(def-unix-error ELOOP 90 _N"Number of symbolic links encountered during path name traversal exceeds MAXSYMLINKS") -(def-unix-error ERESTART 91 _N"Error 91") -(def-unix-error ESTRPIPE 92 _N"Error 92") -(def-unix-error ENOTEMPTY 93 _N"Directory not empty") -(def-unix-error EUSERS 94 _N"Too many users") -(def-unix-error ENOTSOCK 95 _N"Socket operation on non-socket") -(def-unix-error EDESTADDRREQ 96 _N"Destination address required") -(def-unix-error EMSGSIZE 97 _N"Message too long") -(def-unix-error EPROTOTYPE 98 _N"Protocol wrong type for socket") -(def-unix-error ENOPROTOOPT 99 _N"Option not supported by protocol") -(def-unix-error EPROTONOSUPPORT 120 _N"Protocol not supported") -(def-unix-error ESOCKTNOSUPPORT 121 _N"Socket type not supported") -(def-unix-error EOPNOTSUPP 122 _N"Operation not supported on transport endpoint") -(def-unix-error EPFNOSUPPORT 123 _N"Protocol family not supported") -(def-unix-error EAFNOSUPPORT 124 _N"Address family not supported by protocol family") -(def-unix-error EADDRINUSE 125 _N"Address already in use") -(def-unix-error EADDRNOTAVAIL 126 _N"Cannot assign requested address") -(def-unix-error ENETDOWN 127 _N"Network is down") -(def-unix-error ENETUNREACH 128 _N"Network is unreachable") -(def-unix-error ENETRESET 129 _N"Network dropped connection because of reset") -(def-unix-error ECONNABORTED 130 _N"Software caused connection abort") -(def-unix-error ECONNRESET 131 _N"Connection reset by peer") -(def-unix-error ENOBUFS 132 _N"No buffer space available") -(def-unix-error EISCONN 133 _N"Transport endpoint is already connected") -(def-unix-error ENOTCONN 134 _N"Transport endpoint is not connected") -(def-unix-error ESHUTDOWN 143 _N"Cannot send after socket shutdown") -(def-unix-error ETOOMANYREFS 144 _N"Too many references: cannot splice") -(def-unix-error ETIMEDOUT 145 _N"Connection timed out") -(def-unix-error ECONNREFUSED 146 _N"Connection refused") -(def-unix-error EHOSTDOWN 147 _N"Host is down") -(def-unix-error EHOSTUNREACH 148 _N"No route to host") -(def-unix-error EWOULDBLOCK 11 _N"Resource temporarily unavailable") -(def-unix-error EALREADY 149 _N"Operation already in progress") -(def-unix-error EINPROGRESS 150 _N"Operation now in progress") -(def-unix-error ESTALE 151 _N"Stale NFS file handle") -) -#+linux -(progn -(def-unix-error EDEADLK 35 _N"Resource deadlock would occur") -(def-unix-error ENAMETOOLONG 36 _N"File name too long") -(def-unix-error ENOLCK 37 _N"No record locks available") -(def-unix-error ENOSYS 38 _N"Function not implemented") -(def-unix-error ENOTEMPTY 39 _N"Directory not empty") -(def-unix-error ELOOP 40 _N"Too many symbolic links encountered") -(def-unix-error EWOULDBLOCK 11 _N"Operation would block") -(def-unix-error ENOMSG 42 _N"No message of desired type") -(def-unix-error EIDRM 43 _N"Identifier removed") -(def-unix-error ECHRNG 44 _N"Channel number out of range") -(def-unix-error EL2NSYNC 45 _N"Level 2 not synchronized") -(def-unix-error EL3HLT 46 _N"Level 3 halted") -(def-unix-error EL3RST 47 _N"Level 3 reset") -(def-unix-error ELNRNG 48 _N"Link number out of range") -(def-unix-error EUNATCH 49 _N"Protocol driver not attached") -(def-unix-error ENOCSI 50 _N"No CSI structure available") -(def-unix-error EL2HLT 51 _N"Level 2 halted") -(def-unix-error EBADE 52 _N"Invalid exchange") -(def-unix-error EBADR 53 _N"Invalid request descriptor") -(def-unix-error EXFULL 54 _N"Exchange full") -(def-unix-error ENOANO 55 _N"No anode") -(def-unix-error EBADRQC 56 _N"Invalid request code") -(def-unix-error EBADSLT 57 _N"Invalid slot") -(def-unix-error EDEADLOCK EDEADLK _N"File locking deadlock error") -(def-unix-error EBFONT 59 _N"Bad font file format") -(def-unix-error ENOSTR 60 _N"Device not a stream") -(def-unix-error ENODATA 61 _N"No data available") -(def-unix-error ETIME 62 _N"Timer expired") -(def-unix-error ENOSR 63 _N"Out of streams resources") -(def-unix-error ENONET 64 _N"Machine is not on the network") -(def-unix-error ENOPKG 65 _N"Package not installed") -(def-unix-error EREMOTE 66 _N"Object is remote") -(def-unix-error ENOLINK 67 _N"Link has been severed") -(def-unix-error EADV 68 _N"Advertise error") -(def-unix-error ESRMNT 69 _N"Srmount error") -(def-unix-error ECOMM 70 _N"Communication error on send") -(def-unix-error EPROTO 71 _N"Protocol error") -(def-unix-error EMULTIHOP 72 _N"Multihop attempted") -(def-unix-error EDOTDOT 73 _N"RFS specific error") -(def-unix-error EBADMSG 74 _N"Not a data message") -(def-unix-error EOVERFLOW 75 _N"Value too large for defined data type") -(def-unix-error ENOTUNIQ 76 _N"Name not unique on network") -(def-unix-error EBADFD 77 _N"File descriptor in bad state") -(def-unix-error EREMCHG 78 _N"Remote address changed") -(def-unix-error ELIBACC 79 _N"Can not access a needed shared library") -(def-unix-error ELIBBAD 80 _N"Accessing a corrupted shared library") -(def-unix-error ELIBSCN 81 _N".lib section in a.out corrupted") -(def-unix-error ELIBMAX 82 _N"Attempting to link in too many shared libraries") -(def-unix-error ELIBEXEC 83 _N"Cannot exec a shared library directly") -(def-unix-error EILSEQ 84 _N"Illegal byte sequence") -(def-unix-error ERESTART 85 _N"Interrupted system call should be restarted _N") -(def-unix-error ESTRPIPE 86 _N"Streams pipe error") -(def-unix-error EUSERS 87 _N"Too many users") -(def-unix-error ENOTSOCK 88 _N"Socket operation on non-socket") -(def-unix-error EDESTADDRREQ 89 _N"Destination address required") -(def-unix-error EMSGSIZE 90 _N"Message too long") -(def-unix-error EPROTOTYPE 91 _N"Protocol wrong type for socket") -(def-unix-error ENOPROTOOPT 92 _N"Protocol not available") -(def-unix-error EPROTONOSUPPORT 93 _N"Protocol not supported") -(def-unix-error ESOCKTNOSUPPORT 94 _N"Socket type not supported") -(def-unix-error EOPNOTSUPP 95 _N"Operation not supported on transport endpoint") -(def-unix-error EPFNOSUPPORT 96 _N"Protocol family not supported") -(def-unix-error EAFNOSUPPORT 97 _N"Address family not supported by protocol") -(def-unix-error EADDRINUSE 98 _N"Address already in use") -(def-unix-error EADDRNOTAVAIL 99 _N"Cannot assign requested address") -(def-unix-error ENETDOWN 100 _N"Network is down") -(def-unix-error ENETUNREACH 101 _N"Network is unreachable") -(def-unix-error ENETRESET 102 _N"Network dropped connection because of reset") -(def-unix-error ECONNABORTED 103 _N"Software caused connection abort") -(def-unix-error ECONNRESET 104 _N"Connection reset by peer") -(def-unix-error ENOBUFS 105 _N"No buffer space available") -(def-unix-error EISCONN 106 _N"Transport endpoint is already connected") -(def-unix-error ENOTCONN 107 _N"Transport endpoint is not connected") -(def-unix-error ESHUTDOWN 108 _N"Cannot send after transport endpoint shutdown") -(def-unix-error ETOOMANYREFS 109 _N"Too many references: cannot splice") -(def-unix-error ETIMEDOUT 110 _N"Connection timed out") -(def-unix-error ECONNREFUSED 111 _N"Connection refused") -(def-unix-error EHOSTDOWN 112 _N"Host is down") -(def-unix-error EHOSTUNREACH 113 _N"No route to host") -(def-unix-error EALREADY 114 _N"Operation already in progress") -(def-unix-error EINPROGRESS 115 _N"Operation now in progress") -(def-unix-error ESTALE 116 _N"Stale NFS file handle") -(def-unix-error EUCLEAN 117 _N"Structure needs cleaning") -(def-unix-error ENOTNAM 118 _N"Not a XENIX named type file") -(def-unix-error ENAVAIL 119 _N"No XENIX semaphores available") -(def-unix-error EISNAM 120 _N"Is a named type file") -(def-unix-error EREMOTEIO 121 _N"Remote I/O error") -(def-unix-error EDQUOT 122 _N"Quota exceeded") -) -;;; -;;; And now for something completely different ... -(emit-unix-errors) - -(def-alien-routine ("os_get_errno" unix-get-errno) int) -(def-alien-routine ("os_set_errno" unix-set-errno) int (newvalue int)) -(defun unix-errno () (unix-get-errno)) (defun (setf unix-errno) (newvalue) (unix-set-errno newvalue)) -;;; GET-UNIX-ERROR-MSG -- public. -;;; -(defun get-unix-error-msg (&optional (error-number (unix-errno))) - _N"Returns a string describing the error number which was returned by a - UNIX system call." - (declare (type integer error-number)) - (if (array-in-bounds-p *unix-errors* error-number) - (svref *unix-errors* error-number) - (format nil _"Unknown error [~d]" error-number))) - - -;;;; Lisp types used by syscalls. - -(deftype unix-pathname () 'simple-string) -(deftype unix-fd () `(integer 0 ,most-positive-fixnum)) - -(deftype unix-file-mode () '(unsigned-byte 32)) -(deftype unix-pid () '(unsigned-byte 32)) -(deftype unix-uid () '(unsigned-byte 32)) -(deftype unix-gid () '(unsigned-byte 32)) - ;;;; User and group database structures -(defstruct user-info - (name "" :type string) - (password "" :type string) - (uid 0 :type unix-uid) - (gid 0 :type unix-gid) - #+solaris (age "" :type string) - #+solaris (comment "" :type string) - #+freebsd (change -1 :type fixnum) - (gecos "" :type string) - (dir "" :type string) - (shell "" :type string)) + (defstruct group-info (name "" :type string) @@ -1015,36 +366,6 @@ (gid 0 :type unix-gid) (members nil :type list)) ; list of logins as strings -;; see <pwd.h> -#+solaris -(def-alien-type nil - (struct passwd - (pw-name (* char)) ; user's login name - (pw-passwd (* char)) ; no longer used - (pw-uid uid-t) ; user id - (pw-gid gid-t) ; group id - (pw-age (* char)) ; password age (not used) - (pw-comment (* char)) ; not used - (pw-gecos (* char)) ; typically user's full name - (pw-dir (* char)) ; user's home directory - (pw-shell (* char)))) ; user's login shell - -#+bsd -(def-alien-type nil - (struct passwd - (pw-name (* char)) ; user's login name - (pw-passwd (* char)) ; no longer used - (pw-uid uid-t) ; user id - (pw-gid gid-t) ; group id - (pw-change int) ; password change time - (pw-class (* char)) ; user access class - (pw-gecos (* char)) ; typically user's full name - (pw-dir (* char)) ; user's home directory - (pw-shell (* char)) ; user's login shell - (pw-expire int) ; account expiration - #+(or freebsd darwin) - (pw-fields int))) ; internal - ;; see <grp.h> (def-alien-type nil (struct group @@ -1054,96 +375,8 @@ (gr-mem (* (* char))))) ; vector of pointers to member names -;;;; System calls. - -(defmacro %syscall ((name (&rest arg-types) result-type) - success-form &rest args) - `(let* ((fn (extern-alien ,name (function ,result-type ,@arg-types))) - (result (alien-funcall fn ,@args))) - (if (eql -1 result) - (values nil (unix-errno)) - ,success-form))) - -(defmacro syscall ((name &rest arg-types) success-form &rest args) - `(%syscall (,name (,@arg-types) int) ,success-form ,@args)) - -;;; Like syscall, but if it fails, signal an error instead of returing error -;;; codes. Should only be used for syscalls that will never really get an -;;; error. -;;; -(defmacro syscall* ((name &rest arg-types) success-form &rest args) - `(let ((result (alien-funcall (extern-alien ,name (function int ,@arg-types)) - ,@args))) - (if (eql -1 result) - (error _"Syscall ~A failed: ~A" ,name (get-unix-error-msg)) - ,success-form))) - -(defmacro void-syscall ((name &rest arg-types) &rest args) - `(syscall (,name ,@arg-types) (values t 0) ,@args)) - -(defmacro int-syscall ((name &rest arg-types) &rest args) - `(syscall (,name ,@arg-types) (values result 0) ,@args)) - -(defmacro off-t-syscall ((name arg-types) &rest args) - `(%syscall (,name ,arg-types off-t) (values result 0) ,@args)) - - -;;;; Memory-mapped files - -(defconstant +null+ (sys:int-sap 0)) - -(defconstant prot_read 1) ; Readable -(defconstant prot_write 2) ; Writable -(defconstant prot_exec 4) ; Executable -(defconstant prot_none 0) ; No access - -(defconstant map_shared 1) ; Changes are shared -(defconstant map_private 2) ; Changes are private -(defconstant map_fixed 16) ; Fixed, user-defined address -(defconstant map_noreserve #x40) ; Don't reserve swap space -(defconstant map_anonymous - #+solaris #x100 ; Solaris - #+linux 32 ; Linux - #+bsd #x1000) - -(defconstant ms_async 1) -(defconstant ms_sync 4) -(defconstant ms_invalidate 2) -;; The return value from mmap that means mmap failed. -(defconstant map_failed (int-sap (1- (ash 1 vm:word-bits)))) -(defun unix-mmap (addr length prot flags fd offset) - (declare (type (or null system-area-pointer) addr) - (type (unsigned-byte 32) length) - (type (integer 1 7) prot) - (type (unsigned-byte 32) flags) - (type (or null unix-fd) fd) - (type file-offset offset)) - ;; Can't use syscall, because the address that is returned could be - ;; "negative". Hence we explicitly check for mmap returning - ;; MAP_FAILED. - (let ((result - (alien-funcall (extern-alien "mmap" (function system-area-pointer - system-area-pointer - size-t int int int off-t)) - (or addr +null+) length prot flags (or fd -1) offset))) - (if (sap= result map_failed) - (values nil (unix-errno)) - (values result 0)))) - -(defun unix-munmap (addr length) - (declare (type system-area-pointer addr) - (type (unsigned-byte 32) length)) - (syscall ("munmap" system-area-pointer size-t) t addr length)) - -(defun unix-mprotect (addr length prot) - (declare (type system-area-pointer addr) - (type (unsigned-byte 32) length) - (type (integer 1 7) prot)) - (syscall ("mprotect" system-area-pointer size-t int) - t addr length prot)) - (defun unix-setuid (uid) _N"Set the user ID of the calling process to UID. If the calling process is the super-user, set the real @@ -1166,93 +399,7 @@ (type (signed-byte 32) flags)) (syscall ("msync" system-area-pointer size-t int) t addr length flags)) -;;; Unix-access accepts a path and a mode. It returns two values the -;;; first is T if the file is accessible and NIL otherwise. The second -;;; only has meaning in the second case and is the unix errno value. - -(defconstant r_ok 4 _N"Test for read permission") -(defconstant w_ok 2 _N"Test for write permission") -(defconstant x_ok 1 _N"Test for execute permission") -(defconstant f_ok 0 _N"Test for presence of file") - -(defun unix-access (path mode) - _N"Given a file path (a string) and one of four constant modes, - unix-access returns T if the file is accessible with that - mode and NIL if not. It also returns an errno value with - NIL which determines why the file was not accessible. - - The access modes are: - r_ok Read permission. - w_ok Write permission. - x_ok Execute permission. - f_ok Presence of file." - (declare (type unix-pathname path) - (type (mod 8) mode)) - (void-syscall ("access" c-string int) (%name->file path) mode)) - -;;; Unix-chdir accepts a directory name and makes that the -;;; current working directory. - -(defun unix-chdir (path) - _N"Given a file path string, unix-chdir changes the current working - directory to the one specified." - (declare (type unix-pathname path)) - (void-syscall ("chdir" c-string) (%name->file path))) - -;;; Unix-chmod accepts a path and a mode and changes the mode to the new mode. - -(defconstant setuidexec #o4000 _N"Set user ID on execution") -(defconstant setgidexec #o2000 _N"Set group ID on execution") -(defconstant savetext #o1000 _N"Save text image after execution") -(defconstant readown #o400 _N"Read by owner") -(defconstant writeown #o200 _N"Write by owner") -(defconstant execown #o100 _N"Execute (search directory) by owner") -(defconstant readgrp #o40 _N"Read by group") -(defconstant writegrp #o20 _N"Write by group") -(defconstant execgrp #o10 _N"Execute (search directory) by group") -(defconstant readoth #o4 _N"Read by others") -(defconstant writeoth #o2 _N"Write by others") -(defconstant execoth #o1 _N"Execute (search directory) by others") - -(defun unix-chmod (path mode) - _N"Given a file path string and a constant mode, unix-chmod changes the - permission mode for that file to the one specified. The new mode - can be created by logically OR'ing the following: - - setuidexec Set user ID on execution. - setgidexec Set group ID on execution. - savetext Save text image after execution. - readown Read by owner. - writeown Write by owner. - execown Execute (search directory) by owner. - readgrp Read by group. - writegrp Write by group. - execgrp Execute (search directory) by group. - readoth Read by others. - writeoth Write by others. - execoth Execute (search directory) by others. - - Thus #o444 and (logior unix:readown unix:readgrp unix:readoth) - are equivalent for 'mode. The octal-base is familar to Unix users. - It returns T on successfully completion; NIL and an error number - otherwise." - (declare (type unix-pathname path) - (type unix-file-mode mode)) - (void-syscall ("chmod" c-string int) (%name->file path) mode)) - -;;; Unix-fchmod accepts a file descriptor ("fd") and a file protection mode -;;; ("mode") and changes the protection of the file described by "fd" to -;;; "mode". - -(defun unix-fchmod (fd mode) - _N"Given an integer file descriptor and a mode (the same as those - used for unix-chmod), unix-fchmod changes the permission mode - for that file to the one specified. T is returned if the call - was successful." - (declare (type unix-fd fd) - (type unix-file-mode mode)) - (void-syscall ("fchmod" int int) fd mode)) (defun unix-chown (path uid gid) _N"Given a file path, an integer user-id, and an integer group-id, @@ -1285,42 +432,6 @@ one time.)" (int-syscall ("getdtablesize"))) -;;; Unix-close accepts a file descriptor and attempts to close the file -;;; associated with it. - -(defun unix-close (fd) - _N"Unix-close takes an integer file descriptor as an argument and - closes the file associated with it. T is returned upon successful - completion, otherwise NIL and an error number." - (declare (type unix-fd fd)) - (void-syscall ("close" int) fd)) - -;;; Unix-creat accepts a file name and a mode. It creates a new file -;;; with name and sets it mode to mode (as for chmod). - -(defun unix-creat (name mode) - _N"Unix-creat accepts a file name and a mode (same as those for - unix-chmod) and creates a file by that name with the specified - permission mode. It returns a file descriptor on success, - or NIL and an error number otherwise. - - This interface is made obsolete by UNIX-OPEN." - - (declare (type unix-pathname name) - (type unix-file-mode mode)) - (int-syscall (#+solaris "creat64" #-solaris "creat" c-string int) - (%name->file name) mode)) - -;;; Unix-dup returns a duplicate copy of the existing file-descriptor -;;; passed as an argument. - -(defun unix-dup (fd) - _N"Unix-dup duplicates an existing file descriptor (given as the - argument) and return it. If FD is not a valid file descriptor, NIL - and an error number are returned." - (declare (type unix-fd fd)) - (int-syscall ("dup" int) fd)) - ;;; Unix-dup2 makes the second file-descriptor describe the same file ;;; as the first. If the second file-descriptor points to an open ;;; file, it is first closed. In any case, the second should have a @@ -1335,74 +446,6 @@ (declare (type unix-fd fd1 fd2)) (void-syscall ("dup2" int int) fd1 fd2)) -;;; Unix-fcntl takes a file descriptor, an integer command -;;; number, and optional command arguments. It performs -;;; operations on the associated file and/or returns inform- -;;; ation about the file. - -;;; Operations performed on file descriptors: - -(defconstant F-DUPFD 0 _N"Duplicate a file descriptor") -(defconstant F-GETFD 1 _N"Get file desc. flags") -(defconstant F-SETFD 2 _N"Set file desc. flags") -(defconstant F-GETFL 3 _N"Get file flags") -(defconstant F-SETFL 4 _N"Set file flags") -#-(or linux svr4) -(defconstant F-GETOWN 5 _N"Get owner") -#+svr4 -(defconstant F-GETOWN 23 _N"Get owner") -#+linux -(defconstant F-GETLK 5 _N"Get lock") -#-(or linux svr4) -(defconstant F-SETOWN 6 _N"Set owner") -#+svr4 -(defconstant F-SETOWN 24 _N"Set owner") -#+linux -(defconstant F-SETLK 6 _N"Set lock") -#+linux -(defconstant F-SETLKW 7 _N"Set lock, wait for release") -#+linux -(defconstant F-SETOWN 8 _N"Set owner") - -;;; File flags for F-GETFL and F-SETFL: - -(defconstant FNDELAY #-osf1 #o0004 #+osf1 #o100000 _N"Non-blocking reads") -(defconstant FAPPEND #-linux #o0010 #+linux #o2000 _N"Append on each write") -(defconstant FASYNC #-(or linux svr4) #o0100 #+svr4 #o10000 #+linux #o20000 - _N"Signal pgrp when data ready") -;; doesn't exist in Linux ;-( -#-linux (defconstant FCREAT #-(or hpux svr4) #o1000 #+(or hpux svr4) #o0400 - _N"Create if nonexistant") -#-linux (defconstant FTRUNC #-(or hpux svr4) #o2000 #+(or hpux svr4) #o1000 - _N"Truncate to zero length") -#-linux (defconstant FEXCL #-(or hpux svr4) #o4000 #+(or hpux svr4) #o2000 - _N"Error if already created") - -(defun unix-fcntl (fd cmd arg) - _N"Unix-fcntl manipulates file descriptors according to the - argument CMD which can be one of the following: - - F-DUPFD Duplicate a file descriptor. - F-GETFD Get file descriptor flags. - F-SETFD Set file descriptor flags. - F-GETFL Get file flags. - F-SETFL Set file flags. - F-GETOWN Get owner. - F-SETOWN Set owner. - - The flags that can be specified for F-SETFL are: - - FNDELAY Non-blocking reads. - FAPPEND Append on each write. - FASYNC Signal pgrp when data ready. - FCREAT Create if nonexistant. - FTRUNC Truncate to zero length. - FEXCL Error if already created. - " - (declare (type unix-fd fd) - (type (unsigned-byte 32) cmd) - (type (unsigned-byte 32) arg)) - (int-syscall ("fcntl" int unsigned-int unsigned-int) fd cmd arg)) ;;; Unix-link creates a hard link from name2 to name1. @@ -1413,283 +456,6 @@ (void-syscall ("link" c-string c-string) (%name->file name1) (%name->file name2))) -;;; Unix-lseek accepts a file descriptor, an offset, and whence value. - -(defconstant l_set 0 _N"set the file pointer") -(defconstant l_incr 1 _N"increment the file pointer") -(defconstant l_xtnd 2 _N"extend the file size") - -#-solaris -(defun unix-lseek (fd offset whence) - _N"Unix-lseek accepts a file descriptor and moves the file pointer ahead - a certain offset for that file. Whence can be any of the following: - - l_set Set the file pointer. - l_incr Increment the file pointer. - l_xtnd Extend the file size. - _N" - (declare (type unix-fd fd) - (type file-offset offset) - (type (integer 0 2) whence)) - (off-t-syscall ("lseek" (int off-t int)) fd offset whence)) - -#+solaris -(defun unix-lseek (fd offset whence) - _N"Unix-lseek accepts a file descriptor and moves the file pointer ahead - a certain offset for that file. Whence can be any of the following: - - l_set Set the file pointer. - l_incr Increment the file pointer. - l_xtnd Extend the file size. - _N" - (declare (type unix-fd fd) - (type file-offset64 offset) - (type (integer 0 2) whence)) - (let ((result (alien-funcall - (extern-alien "lseek64" (function off64-t int off64-t int)) - fd offset whence))) - (if (minusp result) - (progn - (values nil (unix-errno))) - (values result 0)))) - -;;; Unix-mkdir accepts a name and a mode and attempts to create the -;;; corresponding directory with mode mode. - -(defun unix-mkdir (name mode) - _N"Unix-mkdir creates a new directory with the specified name and mode. - (Same as those for unix-chmod.) It returns T upon success, otherwise - NIL and an error number." - (declare (type unix-pathname name) - (type unix-file-mode mode)) - (void-syscall ("mkdir" c-string int) (%name->file name) mode)) - -;;; Unix-open accepts a pathname (a simple string), flags, and mode and -;;; attempts to open file with name pathname. - -(defconstant o_rdonly 0 _N"Read-only flag.") -(defconstant o_wronly 1 _N"Write-only flag.") -(defconstant o_rdwr 2 _N"Read-write flag.") -#+(or hpux linux svr4) -(defconstant o_ndelay #-linux 4 #+linux #o4000 _N"Non-blocking I/O") -(defconstant o_append #-linux #o10 #+linux #o2000 _N"Append flag.") -#+(or hpux svr4 linux) -(progn - (defconstant o_creat #-linux #o400 #+linux #o100 _N"Create if nonexistant flag.") - (defconstant o_trunc #o1000 _N"Truncate flag.") - (defconstant o_excl #-linux #o2000 #+linux #o200 _N"Error if already exists.") - (defconstant o_noctty #+linux #o400 #+hpux #o400000 #+(or irix solaris) #x800 - _N"Don't assign controlling tty")) -#+(or hpux svr4 BSD) -(defconstant o_nonblock #+hpux #o200000 #+(or irix solaris) #x80 #+BSD #x04 - _N"Non-blocking mode") -#+BSD -(defconstant o_ndelay o_nonblock) ; compatibility -#+linux -(progn - (defconstant o_sync #o10000 _N"Synchronous writes (on ext2)")) - -#-(or hpux svr4 linux) -(progn - (defconstant o_creat #o1000 _N"Create if nonexistant flag.") - (defconstant o_trunc #o2000 _N"Truncate flag.") - (defconstant o_excl #o4000 _N"Error if already exists.")) - -(defun unix-open (path flags mode) - _N"Unix-open opens the file whose pathname is specified by path - for reading and/or writing as specified by the flags argument. - The flags argument can be: - - o_rdonly Read-only flag. - o_wronly Write-only flag. - o_rdwr Read-and-write flag. - o_append Append flag. - o_creat Create-if-nonexistant flag. - o_trunc Truncate-to-size-0 flag. - - If the o_creat flag is specified, then the file is created with - a permission of argument mode if the file doesn't exist. An - integer file descriptor is returned by unix-open." - (declare (type unix-pathname path) - (type fixnum flags) - (type unix-file-mode mode)) - (int-syscall (#+solaris "open64" #-solaris "open" c-string int int) - (%name->file path) flags mode)) - -(defun unix-pipe () - _N"Unix-pipe sets up a unix-piping mechanism consisting of - an input pipe and an output pipe. Unix-Pipe returns two - values: if no error occurred the first value is the pipe - to be read from and the second is can be written to. If - an error occurred the first value is NIL and the second - the unix error code." - (with-alien ((fds (array int 2))) - (syscall ("pipe" (* int)) - (values (deref fds 0) (deref fds 1)) - (cast fds (* int))))) - -;;; Unix-read accepts a file descriptor, a buffer, and the length to read. -;;; It attempts to read len bytes from the device associated with fd -;;; and store them into the buffer. It returns the actual number of -;;; bytes read. - -(defun unix-read (fd buf len) - _N"Unix-read attempts to read from the file described by fd into - the buffer buf until it is full. Len is the length of the buffer. - The number of bytes actually read is returned or NIL and an error - number if an error occured." - (declare (type unix-fd fd) - (type (unsigned-byte 32) len)) - #+(or sunos gencgc) - ;; Note: Under sunos we touch each page before doing the read to give - ;; the segv handler a chance to fix the permissions. Otherwise, - ;; read will return EFAULT. This also bypasses a bug in 4.1.1 in which - ;; read fails with EFAULT if the page has never been touched even if - ;; the permissions are okay. - ;; - ;; (Is this true for Solaris?) - ;; - ;; Also, with gencgc, the collector tries to keep raw objects like - ;; strings in separate pages that are not write-protected. However, - ;; this isn't always true. Thus, BUF will sometimes be - ;; write-protected and the kernel doesn't like writing to - ;; write-protected pages. So go through and touch each page to give - ;; the segv handler a chance to unprotect the pages. - (without-gcing - (let* ((page-size (get-page-size)) - (1-page-size (1- page-size)) - (sap (etypecase buf - (system-area-pointer buf) - (vector (vector-sap buf)))) - (end (sap+ sap len))) - (declare (type (and fixnum unsigned-byte) page-size 1-page-size) - (type system-area-pointer sap end) - (optimize (speed 3) (safety 0))) - ;; Touch the beginning of every page - (do ((sap (int-sap (logand (sap-int sap) - (logxor 1-page-size (ldb (byte 32 0) -1)))) - (sap+ sap page-size))) - ((sap>= sap end)) - (declare (type system-area-pointer sap)) - (setf (sap-ref-8 sap 0) (sap-ref-8 sap 0))))) - (int-syscall ("read" int (* char) int) fd buf len)) - -(defun unix-readlink (path) - _N"Unix-readlink invokes the readlink system call on the file name - specified by the simple string path. It returns up to two values: - the contents of the symbolic link if the call is successful, or - NIL and the Unix error number." - (declare (type unix-pathname path)) - (with-alien ((buf (array char 1024))) - (syscall ("readlink" c-string (* char) int) - (let ((string (make-string result))) - #-unicode - (kernel:copy-from-system-area - (alien-sap buf) 0 - string (* vm:vector-data-offset vm:word-bits) - (* result vm:byte-bits)) - #+unicode - (let ((sap (alien-sap buf))) - (dotimes (k result) - (setf (aref string k) - (code-char (sap-ref-8 sap k))))) - (%file->name string)) - (%name->file path) (cast buf (* char)) 1024))) - -;;; Unix-rename accepts two files names and renames the first to the second. - -(defun unix-rename (name1 name2) - _N"Unix-rename renames the file with string name1 to the string - name2. NIL and an error code is returned if an error occured." - (declare (type unix-pathname name1 name2)) - (void-syscall ("rename" c-string c-string) - (%name->file name1) (%name->file name2))) - -;;; Unix-rmdir accepts a name and removes the associated directory. - -(defun unix-rmdir (name) - _N"Unix-rmdir attempts to remove the directory name. NIL and - an error number is returned if an error occured." - (declare (type unix-pathname name)) - (void-syscall ("rmdir" c-string) (%name->file name))) - - -;;; UNIX-FAST-SELECT -- public. -;;; -(defmacro unix-fast-select (num-descriptors - read-fds write-fds exception-fds - timeout-secs &optional (timeout-usecs 0)) - _N"Perform the UNIX select(2) system call. - (declare (type (integer 0 #.FD-SETSIZE) num-descriptors) - (type (or (alien (* (struct fd-set))) null) - read-fds write-fds exception-fds) - (type (or null (unsigned-byte 31)) timeout-secs) - (type (unsigned-byte 31) timeout-usecs) - (optimize (speed 3) (safety 0) (inhibit-warnings 3)))" - `(let ((timeout-secs ,timeout-secs)) - (with-alien ((tv (struct timeval))) - (when timeout-secs - (setf (slot tv 'tv-sec) timeout-secs) - (setf (slot tv 'tv-usec) ,timeout-usecs)) - (int-syscall (#-netbsd "select" #+netbsd "__select50" int (* (struct fd-set)) (* (struct fd-set)) - (* (struct fd-set)) (* (struct timeval))) - ,num-descriptors ,read-fds ,write-fds ,exception-fds - (if timeout-secs (alien-sap (addr tv)) (int-sap 0)))))) - - -;;; Unix-select accepts sets of file descriptors and waits for an event -;;; to happen on one of them or to time out. - -(defmacro num-to-fd-set (fdset num) - `(if (fixnump ,num) - (progn - (setf (deref (slot ,fdset 'fds-bits) 0) ,num) - ,@(loop for index upfrom 1 below (/ fd-setsize 32) - collect `(setf (deref (slot ,fdset 'fds-bits) ,index) 0))) - (progn - ,@(loop for index upfrom 0 below (/ fd-setsize 32) - collect `(setf (deref (slot ,fdset 'fds-bits) ,index) - (ldb (byte 32 ,(* index 32)) ,num)))))) - -(defmacro fd-set-to-num (nfds fdset) - `(if (<= ,nfds 32) - (deref (slot ,fdset 'fds-bits) 0) - (+ ,@(loop for index upfrom 0 below (/ fd-setsize 32) - collect `(ash (deref (slot ,fdset 'fds-bits) ,index) - ,(* index 32)))))) - -(defun unix-select (nfds rdfds wrfds xpfds to-secs &optional (to-usecs 0)) - _N"Unix-select examines the sets of descriptors passed as arguments - to see if they are ready for reading and writing. See the UNIX - Programmers Manual for more information." - (declare (type (integer 0 #.FD-SETSIZE) nfds) - (type unsigned-byte rdfds wrfds xpfds) - (type (or (unsigned-byte 31) null) to-secs) - (type (unsigned-byte 31) to-usecs) - (optimize (speed 3) (safety 0) (inhibit-warnings 3))) - (with-alien ((tv (struct timeval)) - (rdf (struct fd-set)) - (wrf (struct fd-set)) - (xpf (struct fd-set))) - (when to-secs - (setf (slot tv 'tv-sec) to-secs) - (setf (slot tv 'tv-usec) to-usecs)) - (num-to-fd-set rdf rdfds) - (num-to-fd-set wrf wrfds) - (num-to-fd-set xpf xpfds) - (macrolet ((frob (lispvar alienvar) - `(if (zerop ,lispvar) - (int-sap 0) - (alien-sap (addr ,alienvar))))) - (syscall (#-netbsd "select" #+netbsd "__select50" int (* (struct fd-set)) (* (struct fd-set)) - (* (struct fd-set)) (* (struct timeval))) - (values result - (fd-set-to-num nfds rdf) - (fd-set-to-num nfds wrf) - (fd-set-to-num nfds xpf)) - nfds (frob rdfds rdf) (frob wrfds wrf) (frob xpfds xpf) - (if to-secs (alien-sap (addr tv)) (int-sap 0)))))) - ;;; Unix-sync writes all information in core memory which has been modified ;;; to permanent storage (i.e. disk). @@ -1733,277 +499,12 @@ #+(and bsd x86) (void-syscall ("ftruncate" int unsigned-long unsigned-long) fd len 0)) -(defun unix-symlink (name1 name2) - _N"Unix-symlink creates a symbolic link named name2 to the file - named name1. NIL and an error number is returned if the call - is unsuccessful." - (declare (type unix-pathname name1 name2)) - (void-syscall ("symlink" c-string c-string) - (%name->file name1) (%name->file name2))) - -;;; Unix-unlink accepts a name and deletes the directory entry for that -;;; name and the file if this is the last link. - -(defun unix-unlink (name) - _N"Unix-unlink removes the directory entry for the named file. - NIL and an error code is returned if the call fails." - (declare (type unix-pathname name)) - (void-syscall ("unlink" c-string) (%name->file name))) - -;;; Unix-write accepts a file descriptor, a buffer, an offset, and the -;;; length to write. It attempts to write len bytes to the device -;;; associated with fd from the buffer starting at offset. It returns -;;; the actual number of bytes written. - -(defun unix-write (fd buf offset len) - _N"Unix-write attempts to write a character buffer (buf) of length - len to the file described by the file descriptor fd. NIL and an - error is returned if the call is unsuccessful." - (declare (type unix-fd fd) - (type (unsigned-byte 32) offset len)) - (int-syscall ("write" int (* char) int) - fd - (with-alien ((ptr (* char) (etypecase buf - ((simple-array * (*)) - (vector-sap buf)) - (system-area-pointer - buf)))) - (addr (deref ptr offset))) - len)) - -;;; Unix-ioctl is used to change parameters of devices in a device -;;; dependent way. - - -(defconstant terminal-speeds - '#(0 50 75 110 134 150 200 300 600 #+hpux 900 1200 1800 2400 #+hpux 3600 - 4800 #+hpux 7200 9600 19200 38400 57600 115200 230400 - #+hpux 460800)) - -;;; from /usr/include/bsd/sgtty.h (linux) - -(defconstant tty-raw #-linux #o40 #+linux 1) -(defconstant tty-crmod #-linux #o20 #+linux 4) -#-(or hpux svr4 bsd linux) (defconstant tty-echo #o10) ;; 8 -(defconstant tty-lcase #-linux #o4 #+linux 2) -#-hpux -(defconstant tty-cbreak #-linux #o2 #+linux 64) -#-(or linux hpux) -(defconstant tty-tandem #o1) - -#+(or hpux svr4 bsd linux) -(progn - (defmacro def-enum (inc cur &rest names) - (flet ((defform (name) - (prog1 (when name `(defconstant ,name ,cur)) - (setf cur (funcall inc cur 1))))) - `(progn ,@(mapcar #'defform names)))) - - ;; Input modes. Linux: /usr/include/asm/termbits.h - (def-enum ash 1 tty-ignbrk tty-brkint tty-ignpar tty-parmrk tty-inpck - tty-istrip tty-inlcr tty-igncr tty-icrnl #-bsd tty-iuclc - tty-ixon #-bsd tty-ixany tty-ixoff #+bsd tty-ixany - #+hpux tty-ienqak #+bsd nil tty-imaxbel) - - ;; output modes - #-bsd (def-enum ash 1 tty-opost tty-olcuc tty-onlcr tty-ocrnl tty-onocr - tty-onlret tty-ofill tty-ofdel) - #+bsd (def-enum ash 1 tty-opost tty-onlcr) - - ;; local modes - #-bsd (def-enum ash 1 tty-isig tty-icanon tty-xcase tty-echo tty-echoe - tty-echok tty-echonl tty-noflsh #+irix tty-iexten - #+(or sunos linux) tty-tostop tty-echoctl tty-echoprt - tty-echoke #+(or sunos svr4) tty-defecho tty-flusho - #+linux nil tty-pendin #+irix tty-tostop - #+(or sunos linux) tty-iexten) - #+bsd (def-enum ash 1 tty-echoke tty-echoe tty-echok tty-echo tty-echonl - tty-echoprt tty-echoctl tty-isig tty-icanon nil - tty-iexten) - #+bsd (defconstant tty-tostop #x00400000) - #+bsd (defconstant tty-flusho #x00800000) - #+bsd (defconstant tty-pendin #x20000000) - #+bsd (defconstant tty-noflsh #x80000000) - #+hpux (defconstant tty-tostop #o10000000000) - #+hpux (defconstant tty-iexten #o20000000000) - - ;; control modes - (def-enum ash #-bsd #o100 #+bsd #x400 #+hpux nil tty-cstopb - tty-cread tty-parenb tty-parodd tty-hupcl tty-clocal - #+svr4 rcv1en #+svr4 xmt1en #+(or hpux svr4) tty-loblk) - - ;; special control characters - #+(or hpux svr4 linux) (def-enum + 0 vintr vquit verase vkill veof - #-linux veol #-linux veol2) - #+bsd (def-enum + 0 veof veol veol2 verase nil vkill nil nil vintr vquit) - #+linux (defconstant veol 11) - #+linux (defconstant veol2 16) - - (defconstant tciflush 0) - (defconstant tcoflush 1) - (defconstant tcioflush 2)) - -#+bsd -(progn - (defconstant vmin 16) - (defconstant vtime 17) - (defconstant vsusp 10) - (defconstant vstart 12) - (defconstant vstop 13) - (defconstant vdsusp 11)) - -#+hpux -(progn - (defconstant vmin 11) - (defconstant vtime 12) - (defconstant vsusp 13) - (defconstant vstart 14) - (defconstant vstop 15) - (defconstant vdsusp 21)) - -#+(or hpux bsd linux) -(progn - (defconstant tcsanow 0) - (defconstant tcsadrain 1) - (defconstant tcsaflush 2)) - -#+(or linux svr4) -(progn - #-linux (defconstant vdsusp 11) - (defconstant vstart 8) - (defconstant vstop 9) - (defconstant vsusp 10) - (defconstant vmin #-linux 4 #+linux 6) - (defconstant vtime 5)) - -#+(or sunos svr4) -(progn - ;; control modes - (defconstant tty-cbaud #o17) - (defconstant tty-csize #o60) - (defconstant tty-cs5 #o0) - (defconstant tty-cs6 #o20) - (defconstant tty-cs7 #o40) - (defconstant tty-cs8 #o60)) - -#+bsd -(progn - ;; control modes - (defconstant tty-csize #x300) - (defconstant tty-cs5 #x000) - (defconstant tty-cs6 #x100) - (defconstant tty-cs7 #x200) - (defconstant tty-cs8 #x300)) - -#+svr4 -(progn - (defconstant tcsanow #x540e) - (defconstant tcsadrain #x540f) - (defconstant tcsaflush #x5410)) - -(eval-when (compile load eval) - -#-(or (and svr4 (not irix)) linux) -(progn - (defconstant iocparm-mask #x7f) ; Freebsd: #x1fff ? - (defconstant ioc_void #x20000000) - (defconstant ioc_out #x40000000) - (defconstant ioc_in #x80000000) - (defconstant ioc_inout (logior ioc_in ioc_out))) - -#-(or linux (and svr4 (not irix))) -(defmacro define-ioctl-command (name dev cmd arg &optional (parm-type :void)) - (let* ((ptype (ecase parm-type - (:void ioc_void) - (:in ioc_in) - (:out ioc_out) - (:inout ioc_inout))) - (code (logior (ash (char-code dev) 8) cmd ptype))) - (when arg - (setf code - `(logior (ash (logand (alien-size ,arg :bytes) - ,iocparm-mask) - 16) - ,code))) - `(eval-when (eval load compile) - (defconstant ,name ,code)))) - -#+(and svr4 (not irix)) -(defmacro define-ioctl-command (name dev cmd arg &optional (parm-type :void)) - (declare (ignore dev arg parm-type)) - `(eval-when (eval load compile) - (defconstant ,name ,(logior (ash (char-code #\t) 8) cmd)))) - -#+linux -(defmacro define-ioctl-command (name dev cmd arg &optional (parm-type :void)) - (declare (ignore arg parm-type)) - `(eval-when (eval load compile) - (defconstant ,name ,(logior (ash (- (char-code dev) #x20) 8) cmd)))) - -) - ;;; TTY ioctl commands. -(define-ioctl-command TIOCGETP #\t #-linux 8 #+linux #x81 (struct sgttyb) :out) -(define-ioctl-command TIOCSETP #\t #-linux 9 #+linux #x82 (struct sgttyb) :in) -(define-ioctl-command TIOCFLUSH #\t #-linux 16 #+linux #x89 int :in) -(define-ioctl-command TIOCSETC #\t #-linux 17 #+linux #x84 (struct tchars) :in) -(define-ioctl-command TIOCGETC #\t #-linux 18 #+linux #x83 (struct tchars) :out) -(define-ioctl-command TIOCGWINSZ #\t #-hpux 104 #+hpux 107 (struct winsize) - :out) -(define-ioctl-command TIOCSWINSZ #\t #-hpux 103 #+hpux 106 (struct winsize) - :in) - -(define-ioctl-command TIOCNOTTY #\t #-linux 113 #+linux #x22 nil :void) -#-hpux -(progn - (define-ioctl-command TIOCSLTC #\t #-linux 117 #+linux #x84 (struct ltchars) :in) - (define-ioctl-command TIOCGLTC #\t #-linux 116 #+linux #x85 (struct ltchars) :out) - (define-ioctl-command TIOCSPGRP #\t #-svr4 118 #+svr4 21 int :in) - (define-ioctl-command TIOCGPGRP #\t #-svr4 119 #+svr4 20 int :out)) -#+hpux -(progn - (define-ioctl-command TIOCSLTC #\T 23 (struct ltchars) :in) - (define-ioctl-command TIOCGLTC #\T 24 (struct ltchars) :out) - (define-ioctl-command TIOCSPGRP #\T 29 int :in) - (define-ioctl-command TIOCGPGRP #\T 30 int :out) - (define-ioctl-command TIOCSIGSEND #\t 93 nil)) - -;;; File ioctl commands. -(define-ioctl-command FIONREAD #\f #-linux 127 #+linux #x1B int :out) - -(defun unix-ioctl (fd cmd arg) - _N"Unix-ioctl performs a variety of operations on open i/o - descriptors. See the UNIX Programmer's Manual for more - information." - (declare (type unix-fd fd) - (type (unsigned-byte 32) cmd)) - (int-syscall ("ioctl" int unsigned-int (* char)) fd cmd arg)) #+(or svr4 hpux bsd linux) (progn - (defun unix-tcgetattr (fd termios) - _N"Get terminal attributes." - (declare (type unix-fd fd)) - (void-syscall ("tcgetattr" int (* (struct termios))) fd termios)) - - (defun unix-tcsetattr (fd opt termios) - _N"Set terminal attributes." - (declare (type unix-fd fd)) - (void-syscall ("tcsetattr" int int (* (struct termios))) fd opt termios)) - - ;; XXX rest of functions in this progn probably are present in linux, but - ;; not verified. - #-bsd - (defun unix-cfgetospeed (termios) - _N"Get terminal output speed." - (multiple-value-bind (speed errno) - (int-syscall ("cfgetospeed" (* (struct termios))) termios) - (if speed - (values (svref terminal-speeds speed) 0) - (values speed errno)))) - #+bsd (defun unix-cfgetospeed (termios) _N"Get terminal output speed." @@ -2141,75 +642,8 @@ siocspgrp (alien:alien-sap (alien:addr alien-pgrp))))) -;;; Unix-exit terminates a program. - -(defun unix-exit (&optional (code 0)) - _N"Unix-exit terminates the current process with an optional - error code. If successful, the call doesn't return. If - unsuccessful, the call returns NIL and an error number." - (declare (type (signed-byte 32) code)) - (void-syscall ("exit" int) code)) - ;;; STAT and friends. -(defmacro extract-stat-results (buf) - `(values T - (slot ,buf 'st-dev) - (slot ,buf 'st-ino) - (slot ,buf 'st-mode) - (slot ,buf 'st-nlink) - (slot ,buf 'st-uid) - (slot ,buf 'st-gid) - (slot ,buf 'st-rdev) - (slot ,buf 'st-size) - #-(or svr4 BSD) (slot ,buf 'st-atime) - #+svr4 (slot (slot ,buf 'st-atime) 'tv-sec) - #+BSD (slot (slot ,buf 'st-atime) 'ts-sec) - #-(or svr4 BSD)(slot ,buf 'st-mtime) - #+svr4 (slot (slot ,buf 'st-mtime) 'tv-sec) - #+BSD(slot (slot ,buf 'st-mtime) 'ts-sec) - #-(or svr4 BSD) (slot ,buf 'st-ctime) - #+svr4 (slot (slot ,buf 'st-ctime) 'tv-sec) - #+BSD(slot (slot ,buf 'st-ctime) 'ts-sec) - #+netbsd (slot (slot ,buf 'st-birthtime) 'ts-sec) - (slot ,buf 'st-blksize) - (slot ,buf 'st-blocks))) - -#-solaris -(progn -(defun unix-stat (name) - _N"Unix-stat retrieves information about the specified - file returning them in the form of multiple values. - See the UNIX Programmer's Manual for a description - of the values returned. If the call fails, then NIL - and an error number is returned instead." - (declare (type unix-pathname name)) - (when (string= name "") - (setf name ".")) - (with-alien ((buf (struct stat))) - (syscall (#-netbsd "stat" #+netbsd "__stat50" c-string (* (struct stat))) - (extract-stat-results buf) - (%name->file name) (addr buf)))) - -(defun unix-lstat (name) - _N"Unix-lstat is similar to unix-stat except the specified - file must be a symbolic link." - (declare (type unix-pathname name)) - (with-alien ((buf (struct stat))) - (syscall (#-netbsd "lstat" #+netbsd "__lstat50" c-string (* (struct stat))) - (extract-stat-results buf) - (%name->file name) (addr buf)))) - -(defun unix-fstat (fd) - _N"Unix-fstat is similar to unix-stat except the file is specified - by the file descriptor fd." - (declare (type unix-fd fd)) - (with-alien ((buf (struct stat))) - (syscall (#-netbsd "fstat" #+netbsd "__fstat50" int (* (struct stat))) - (extract-stat-results buf) - fd (addr buf)))) -) - ;;; 64-bit versions of stat and friends #+solaris (progn @@ -2247,54 +681,6 @@ ) -(defconstant rusage_self 0 _N"The calling process.") -(defconstant rusage_children -1 _N"Terminated child processes.") - -(declaim (inline unix-fast-getrusage)) -(defun unix-fast-getrusage (who) - _N"Like call getrusage, but return only the system and user time, and returns - the seconds and microseconds as separate values." - (declare (values (member t) - (unsigned-byte 31) (mod 1000000) - (unsigned-byte 31) (mod 1000000))) - (with-alien ((usage (struct rusage))) - (syscall* (#-netbsd "getrusage" #+netbsd "__getrusage50" int (* (struct rusage))) - (values t - (slot (slot usage 'ru-utime) 'tv-sec) - (slot (slot usage 'ru-utime) 'tv-usec) - (slot (slot usage 'ru-stime) 'tv-sec) - (slot (slot usage 'ru-stime) 'tv-usec)) - who (addr usage)))) - -(defun unix-getrusage (who) - _N"Unix-getrusage returns information about the resource usage - of the process specified by who. Who can be either the - current process (rusage_self) or all of the terminated - child processes (rusage_children). NIL and an error number - is returned if the call fails." - (with-alien ((usage (struct rusage))) - (syscall (#-netbsd "getrusage" #+netbsd "__getrusage50" int (* (struct rusage))) - (values t - (+ (* (slot (slot usage 'ru-utime) 'tv-sec) 1000000) - (slot (slot usage 'ru-utime) 'tv-usec)) - (+ (* (slot (slot usage 'ru-stime) 'tv-sec) 1000000) - (slot (slot usage 'ru-stime) 'tv-usec)) - (slot usage 'ru-maxrss) - (slot usage 'ru-ixrss) - (slot usage 'ru-idrss) - (slot usage 'ru-isrss) - (slot usage 'ru-minflt) - (slot usage 'ru-majflt) - (slot usage 'ru-nswap) - (slot usage 'ru-inblock) - (slot usage 'ru-oublock) - (slot usage 'ru-msgsnd) - (slot usage 'ru-msgrcv) - (slot usage 'ru-nsignals) - (slot usage 'ru-nvcsw) - (slot usage 'ru-nivcsw)) - who (addr usage)))) - ;;; Getrusage is not provided in the C library on Solaris 2.4, and is ;;; rather slow on later versions so the "times" system call is ;;; provided. @@ -2355,50 +741,7 @@ #+irix (fakeout-compiler "tzname" (if dst 1 0))) ) ) ) -(declaim (inline unix-gettimeofday)) -(defun unix-gettimeofday () - _N"If it works, unix-gettimeofday returns 5 values: T, the seconds and - microseconds of the current time of day, the timezone (in minutes west - of Greenwich), and a daylight-savings flag. If it doesn't work, it - returns NIL and the errno." - (with-alien ((tv (struct timeval)) - #-(or svr4 netbsd) (tz (struct timezone))) - (syscall* (#-netbsd "gettimeofday" - #+netbsd "__gettimeofday50" - (* (struct timeval)) #-svr4 (* (struct timezone))) - (values T - (slot tv 'tv-sec) - (slot tv 'tv-usec) - #-(or svr4 netbsd) (slot tz 'tz-minuteswest) - #+svr4 (unix-get-minutes-west (slot tv 'tv-sec)) - #-(or svr4 netbsd) (slot tz 'tz-dsttime) - #+svr4 (unix-get-timezone (slot tv 'tv-sec)) - ) - (addr tv) - #-(or svr4 netbsd) (addr tz) #+netbsd nil))) - -;;; Unix-utimes changes the accessed and updated times on UNIX -;;; files. The first argument is the filename (a string) and -;;; the second argument is a list of the 4 times- accessed and -;;; updated seconds and microseconds. - -#-hpux -(defun unix-utimes (file atime-sec atime-usec mtime-sec mtime-usec) - _N"Unix-utimes sets the 'last-accessed' and 'last-updated' - times on a specified file. NIL and an error number is - returned if the call is unsuccessful." - (declare (type unix-pathname file) - (type (alien unsigned-long) - atime-sec atime-usec - mtime-sec mtime-usec)) - (with-alien ((tvp (array (struct timeval) 2))) - (setf (slot (deref tvp 0) 'tv-sec) atime-sec) - (setf (slot (deref tvp 0) 'tv-usec) atime-usec) - (setf (slot (deref tvp 1) 'tv-sec) mtime-sec) - (setf (slot (deref tvp 1) 'tv-usec) mtime-usec) - (void-syscall (#-netbsd "utimes" #+netbsd "__utimes50" c-string (* (struct timeval))) - file - (cast tvp (* (struct timeval)))))) + ;;; Unix-setreuid sets the real and effective user-id's of the current ;;; process to the arguments "ruid" and "euid", respectively. Usage is @@ -2424,9 +767,6 @@ returned if the call fails." (void-syscall ("setregid" int int) rgid egid)) -(def-alien-routine ("getpid" unix-getpid) int - _N"Unix-getpid returns the process-id of the current process.") - (def-alien-routine ("getppid" unix-getppid) int _N"Unix-getppid returns the process-id of the parent of the current process.") @@ -2462,27 +802,6 @@ group leader. NIL and an error number are returned upon failure." (void-syscall ("setpgid" int int) pid pgrp)) -(def-alien-routine ("getuid" unix-getuid) int - _N"Unix-getuid returns the real user-id associated with the - current process.") - -;;; Unix-getpagesize returns the number of bytes in the system page. - -(defun unix-getpagesize () - _N"Unix-getpagesize returns the number of bytes in a system page." - (int-syscall ("getpagesize"))) - -(defun unix-gethostname () - _N"Unix-gethostname returns the name of the host machine as a string." - (with-alien ((buf (array char 256))) - (syscall* ("gethostname" (* char) int) - (cast buf c-string) - (cast buf (* char)) 256))) - -(def-alien-routine ("gethostid" unix-gethostid) unsigned-long - _N"Unix-gethostid returns a 32-bit integer which provides unique - identification for the host machine.") - (defun unix-fork () _N"Executes the unix fork system call. Returns 0 in the child and the pid of the child in the parent if it works, or NIL and an error number if it @@ -2518,370 +837,11 @@ _N"Removes the variable Name from the environment") -;;; Operations on Unix Directories. - -(export '(open-dir read-dir close-dir)) - -(defstruct (%directory - (:conc-name directory-) - (:constructor make-directory) - (:print-function %print-directory)) - name - (dir-struct (required-argument) :type system-area-pointer)) - -(defun %print-directory (dir stream depth) - (declare (ignore depth)) - (format stream "#<Directory ~S>" (directory-name dir))) - -(defun open-dir (pathname) - (declare (type unix-pathname pathname)) - (when (string= pathname "") - (setf pathname ".")) - (let ((kind (unix-file-kind pathname))) - (case kind - (:directory - (let ((dir-struct - (alien-funcall (extern-alien "opendir" - (function system-area-pointer - c-string)) - (%name->file pathname)))) - (if (zerop (sap-int dir-struct)) - (values nil (unix-errno)) - (make-directory :name pathname :dir-struct dir-struct)))) - ((nil) - (values nil enoent)) - (t - (values nil enotdir))))) - -#-(and bsd (not solaris)) -(defun read-dir (dir) - (declare (type %directory dir)) - (let ((daddr (alien-funcall (extern-alien "readdir" - (function system-area-pointer - system-area-pointer)) - (directory-dir-struct dir)))) - (declare (type system-area-pointer daddr)) - (if (zerop (sap-int daddr)) - nil - (with-alien ((direct (* (struct direct)) daddr)) - #-(or linux svr4) - (let ((nlen (slot direct 'd-namlen)) - (ino (slot direct 'd-ino))) - (declare (type (unsigned-byte 16) nlen)) - (let ((string (make-string nlen))) - #-unicode - (kernel:copy-from-system-area - (alien-sap (addr (slot direct 'd-name))) 0 - string (* vm:vector-data-offset vm:word-bits) - (* nlen vm:byte-bits)) - #+unicode - (let ((sap (alien-sap (addr (slot direct 'd-name))))) - (dotimes (k nlen) - (setf (aref string k) - (code-char (sap-ref-8 sap k))))) - (values (%file->name string) ino))) - #+(or linux svr4) - (values (%file->name (cast (slot direct 'd-name) c-string)) - (slot direct 'd-ino)))))) - -;;; 64-bit readdir for Solaris -#+solaris -(defun read-dir (dir) - (declare (type %directory dir)) - (let ((daddr (alien-funcall (extern-alien "readdir64" - (function system-area-pointer - system-area-pointer)) - (directory-dir-struct dir)))) - (declare (type system-area-pointer daddr)) - (if (zerop (sap-int daddr)) - nil - (with-alien ((direct (* (struct dirent64)) daddr)) - #-(or linux svr4) - (let ((nlen (slot direct 'd-namlen)) - (ino (slot direct 'd-ino))) - (declare (type (unsigned-byte 16) nlen)) - (let ((string (make-string nlen))) - #-unicode - (kernel:copy-from-system-area - (alien-sap (addr (slot direct 'd-name))) 0 - string (* vm:vector-data-offset vm:word-bits) - (* nlen vm:byte-bits)) - #+unicode - (let ((sap (alien-sap (addr (slot direct 'd-name))))) - (dotimes (k nlen) - (setf (aref string k) - (code-char (sap-ref-8 sap k))))) - (values (%file->name string) ino))) - #+(or linux svr4) - (values (%file->name (cast (slot direct 'd-name) c-string)) - (slot direct 'd-ino)))))) - -#+(and bsd (not solaris)) -(defun read-dir (dir) - (declare (type %directory dir)) - (let ((daddr (alien-funcall (extern-alien "readdir" - (function system-area-pointer - system-area-pointer)) - (directory-dir-struct dir)))) - (declare (type system-area-pointer daddr)) - (if (zerop (sap-int daddr)) - nil - (with-alien ((direct (* (struct direct)) daddr)) - (let ((nlen (slot direct 'd-namlen)) - (fino (slot direct 'd-fileno))) - (declare (type (unsigned-byte #+netbsd 16 #-netbsd 8) nlen) - (type (unsigned-byte #+netbsd 64 #-netbsd 32) fino)) - (let ((string (make-string nlen))) - #-unicode - (kernel:copy-from-system-area - (alien-sap (addr (slot direct 'd-name))) 0 - string (* vm:vector-data-offset vm:word-bits) - (* nlen vm:byte-bits)) - #+unicode - (let ((sap (alien-sap (addr (slot direct 'd-name))))) - (dotimes (k nlen) - (setf (aref string k) - (code-char (sap-ref-8 sap k))))) - (values (%file->name string) fino))))))) - - -(defun close-dir (dir) - (declare (type %directory dir)) - (alien-funcall (extern-alien "closedir" - (function void system-area-pointer)) - (directory-dir-struct dir)) - nil) - - -;; Use getcwd instead of getwd. But what should we do if the path -;; won't fit? Try again with a larger size? We don't do that right -;; now. -(defun unix-current-directory () - ;; 5120 is some randomly selected maximum size for the buffer for getcwd. - (with-alien ((buf (array c-call:char 5120))) - (let ((result - (alien-funcall - (extern-alien "getcwd" - (function (* c-call:char) - (* c-call:char) c-call:int)) - (cast buf (* c-call:char)) - 5120))) - - (values (not (zerop - (sap-int (alien-sap result)))) - (%file->name (cast buf c-call:c-string)))))) - - - ;;;; Support routines for dealing with unix pathnames. (export '(unix-file-kind unix-maybe-prepend-current-directory unix-resolve-links unix-simplify-pathname)) -(defun unix-file-kind (name &optional check-for-links) - _N"Returns either :file, :directory, :link, :special, or NIL." - (declare (simple-string name)) - (multiple-value-bind (res dev ino mode) - (if check-for-links - (unix-lstat name) - (unix-stat name)) - (declare (type (or fixnum null) mode) - (ignore dev ino)) - (when res - (let ((kind (logand mode s-ifmt))) - (cond ((eql kind s-ifdir) :directory) - ((eql kind s-ifreg) :file) - ((eql kind s-iflnk) :link) - (t :special)))))) - -(defun unix-maybe-prepend-current-directory (name) - (declare (simple-string name)) - (if (and (> (length name) 0) (char= (schar name 0) #\/)) - name - (multiple-value-bind (win dir) (unix-current-directory) - (if win - (concatenate 'simple-string dir "/" name) - name)))) - -(defun unix-resolve-links (pathname) - _N"Returns the pathname with all symbolic links resolved." - (declare (simple-string pathname)) - (let ((len (length pathname)) - (pending pathname)) - (declare (fixnum len) (simple-string pending)) - (if (zerop len) - pathname - (let ((result (make-string 100 :initial-element (code-char 0))) - (fill-ptr 0) - (name-start 0)) - (loop - (let* ((name-end (or (position #\/ pending :start name-start) len)) - (new-fill-ptr (+ fill-ptr (- name-end name-start)))) - ;; grow the result string, if necessary. the ">=" (instead of - ;; using ">") allows for the trailing "/" if we find this - ;; component is a directory. - (when (>= new-fill-ptr (length result)) - (let ((longer (make-string (* 3 (length result)) - :initial-element (code-char 0)))) - (replace longer result :end1 fill-ptr) - (setq result longer))) - (replace result pending - :start1 fill-ptr - :end1 new-fill-ptr - :start2 name-start - :end2 name-end) - (let ((kind (unix-file-kind (if (zerop name-end) "/" result) t))) - (unless kind (return nil)) - (cond ((eq kind :link) - (multiple-value-bind (link err) (unix-readlink result) - (unless link - (error (intl:gettext "Error reading link ~S: ~S") - (subseq result 0 fill-ptr) - (get-unix-error-msg err))) - (cond ((or (zerop (length link)) - (char/= (schar link 0) #\/)) - ;; It's a relative link - (fill result (code-char 0) - :start fill-ptr - :end new-fill-ptr)) - ((string= result "/../" :end1 4) - ;; It's across the super-root. - (let ((slash (or (position #\/ result :start 4) - 0))) - (fill result (code-char 0) - :start slash - :end new-fill-ptr) - (setf fill-ptr slash))) - (t - ;; It's absolute. - (and (> (length link) 0) - (char= (schar link 0) #\/)) - (fill result (code-char 0) :end new-fill-ptr) - (setf fill-ptr 0))) - (setf pending - (if (= name-end len) - link - (concatenate 'simple-string - link - (subseq pending name-end)))) - (setf len (length pending)) - (setf name-start 0))) - ((= name-end len) - (when (eq kind :directory) - (setf (schar result new-fill-ptr) #\/) - (incf new-fill-ptr)) - (return (subseq result 0 new-fill-ptr))) - ((eq kind :directory) - (setf (schar result new-fill-ptr) #\/) - (setf fill-ptr (1+ new-fill-ptr)) - (setf name-start (1+ name-end))) - (t - (return nil)))))))))) - -(defun unix-simplify-pathname (src) - (declare (simple-string src)) - (let* ((src-len (length src)) - (dst (make-string src-len)) - (dst-len 0) - (dots 0) - (last-slash nil)) - (macrolet ((deposit (char) - `(progn - (setf (schar dst dst-len) ,char) - (incf dst-len)))) - (dotimes (src-index src-len) - (let ((char (schar src src-index))) - (cond ((char= char #\.) - (when dots - (incf dots)) - (deposit char)) - ((char= char #\/) - (case dots - (0 - ;; Either ``/...' or ``...//...' - (unless last-slash - (setf last-slash dst-len) - (deposit char))) - (1 - ;; Either ``./...'' or ``..././...'' - (decf dst-len)) - (2 - ;; We've found .. - (cond - ((and last-slash (not (zerop last-slash))) - ;; There is something before this .. - (let ((prev-prev-slash - (position #\/ dst :end last-slash :from-end t))) - (cond ((and (= (+ (or prev-prev-slash 0) 2) - last-slash) - (char= (schar dst (- last-slash 2)) #\.) - (char= (schar dst (1- last-slash)) #\.)) - ;; The something before this .. is another .. - (deposit char) - (setf last-slash dst-len)) - (t - ;; The something is some random dir. - (setf dst-len - (if prev-prev-slash - (1+ prev-prev-slash) - 0)) - (setf last-slash prev-prev-slash))))) - (t - ;; There is nothing before this .., so we need to keep it - (setf last-slash dst-len) - (deposit char)))) - (t - ;; Something other than a dot between slashes. - (setf last-slash dst-len) - (deposit char))) - (setf dots 0)) - (t - (setf dots nil) - (setf (schar dst dst-len) char) - (incf dst-len)))))) - (when (and last-slash (not (zerop last-slash))) - (case dots - (1 - ;; We've got ``foobar/.'' - (decf dst-len)) - (2 - ;; We've got ``foobar/..'' - (unless (and (>= last-slash 2) - (char= (schar dst (1- last-slash)) #\.) - (char= (schar dst (- last-slash 2)) #\.) - (or (= last-slash 2) - (char= (schar dst (- last-slash 3)) #\/))) - (let ((prev-prev-slash - (position #\/ dst :end last-slash :from-end t))) - (if prev-prev-slash - (setf dst-len (1+ prev-prev-slash)) - (return-from unix-simplify-pathname "./"))))))) - (cond ((zerop dst-len) - "./") - ((= dst-len src-len) - dst) - (t - (subseq dst 0 dst-len))))) - - -;;;; Other random routines. - -(def-alien-routine ("isatty" unix-isatty) boolean - _N"Accepts a Unix file descriptor and returns T if the device - associated with it is a terminal." - (fd int)) - -(def-alien-routine ("ttyname" unix-ttyname) c-string - (fd int)) - -(def-alien-routine ("openpty" unix-openpty) int - (amaster int :out) - (aslave int :out) - (name c-string) - (termp (* (struct termios))) - (winp (* (struct winsize)))) - - ;;;; UNIX-EXECVE @@ -2997,128 +957,11 @@ -;;;; Socket support. - -(def-alien-routine ("socket" unix-socket) int - (domain int) - (type int) - (protocol int)) - -(def-alien-routine ("connect" unix-connect) int - (socket int) - (sockaddr (* t)) - (len int)) - -(def-alien-routine ("bind" unix-bind) int - (socket int) - (sockaddr (* t)) - (len int)) - -(def-alien-routine ("listen" unix-listen) int - (socket int) - (backlog int)) - -(def-alien-routine ("accept" unix-accept) int - (socket int) - (sockaddr (* t)) - (len int :in-out)) - -(def-alien-routine ("recv" unix-recv) int - (fd int) - (buffer c-string) - (length int) - (flags int)) - -(def-alien-routine ("send" unix-send) int - (fd int) - (buffer c-string) - (length int) - (flags int)) - -(def-alien-routine ("getpeername" unix-getpeername) int - (socket int) - (sockaddr (* t)) - (len (* unsigned))) - -(def-alien-routine ("getsockname" unix-getsockname) int - (socket int) - (sockaddr (* t)) - (len (* unsigned))) - -(def-alien-routine ("getsockopt" unix-getsockopt) int - (socket int) - (level int) - (optname int) - (optval (* t)) - (optlen unsigned :in-out)) - -(def-alien-routine ("setsockopt" unix-setsockopt) int - (socket int) - (level int) - (optname int) - (optval (* t)) - (optlen unsigned)) - -;; Datagram support - -(defun unix-recvfrom (fd buffer length flags sockaddr len) - (with-alien ((l c-call:int len)) - (values - (alien-funcall (extern-alien "recvfrom" - (function c-call:int - c-call:int - system-area-pointer - c-call:int - c-call:int - (* t) - (* c-call:int))) - fd - (system:vector-sap buffer) - length - flags - sockaddr - (addr l)) - l))) - -#-unicode -(def-alien-routine ("sendto" unix-sendto) int - (fd int) - (buffer c-string) - (length int) - (flags int) - (sockaddr (* t)) - (len int)) - -(defun unix-sendto (fd buffer length flags sockaddr len) - (alien-funcall (extern-alien "sendto" - (function c-call:int - c-call:int - system-area-pointer - c-call:int - c-call:int - (* t) - c-call:int)) - fd - (system:vector-sap buffer) - length - flags - sockaddr - len)) - -(def-alien-routine ("shutdown" unix-shutdown) int - (socket int) - (level int)) - - ;;; ;;; Support for the Interval Timer (experimental) ;;; -(defconstant ITIMER-REAL 0) -(defconstant ITIMER-VIRTUAL 1) -(defconstant ITIMER-PROF 2) - (defun unix-getitimer (which) _N"Unix-getitimer returns the INTERVAL and VALUE slots of one of three system timers (:real :virtual or :profile). On success, @@ -3143,41 +986,6 @@ (slot (slot itv 'it-value) 'tv-usec)) which (alien-sap (addr itv)))))) -(defun unix-setitimer (which int-secs int-usec val-secs val-usec) - _N" Unix-setitimer sets the INTERVAL and VALUE slots of one of - three system timers (:real :virtual or :profile). A SIGALRM signal - will be delivered VALUE <seconds+microseconds> from now. INTERVAL, - when non-zero, is <seconds+microseconds> to be loaded each time - the timer expires. Setting INTERVAL and VALUE to zero disables - the timer. See the Unix man page for more details. On success, - unix-setitimer returns the old contents of the INTERVAL and VALUE - slots as in unix-getitimer." - (declare (type (member :real :virtual :profile) which) - (type (unsigned-byte 29) int-secs val-secs) - (type (integer 0 (1000000)) int-usec val-usec) - (values t - (unsigned-byte 29) - (mod 1000000) - (unsigned-byte 29) - (mod 1000000))) - (let ((which (ecase which - (:real ITIMER-REAL) - (:virtual ITIMER-VIRTUAL) - (:profile ITIMER-PROF)))) - (with-alien ((itvn (struct itimerval)) - (itvo (struct itimerval))) - (setf (slot (slot itvn 'it-interval) 'tv-sec ) int-secs - (slot (slot itvn 'it-interval) 'tv-usec) int-usec - (slot (slot itvn 'it-value ) 'tv-sec ) val-secs - (slot (slot itvn 'it-value ) 'tv-usec) val-usec) - (syscall* (#-netbsd "setitimer" #+netbsd "__setitimer50" int (* (struct timeval))(* (struct timeval))) - (values T - (slot (slot itvo 'it-interval) 'tv-sec) - (slot (slot itvo 'it-interval) 'tv-usec) - (slot (slot itvo 'it-value) 'tv-sec) - (slot (slot itvo 'it-value) 'tv-usec)) - which (alien-sap (addr itvn))(alien-sap (addr itvo)))))) - ;;;; User and group database access, POSIX Standard 9.2.2 @@ -3232,55 +1040,6 @@ :dir (string (cast (slot result 'pw-dir) c-call:c-string)) :shell (string (cast (slot result 'pw-shell) c-call:c-string)))))) -#+solaris -(defun unix-getpwuid (uid) - _N"Return a USER-INFO structure for the user identified by UID, or NIL if not found." - (declare (type unix-uid uid)) - (with-alien ((buf (array c-call:char 1024)) - (user-info (struct passwd))) - (let ((result - (alien-funcall - (extern-alien "getpwuid_r" - (function (* (struct passwd)) - c-call:unsigned-int - (* (struct passwd)) - (* c-call:char) - c-call:unsigned-int)) - uid - (addr user-info) - (cast buf (* c-call:char)) - 1024))) - (when (not (zerop (sap-int (alien-sap result)))) - (make-user-info - :name (string (cast (slot result 'pw-name) c-call:c-string)) - :password (string (cast (slot result 'pw-passwd) c-call:c-string)) - :uid (slot result 'pw-uid) - :gid (slot result 'pw-gid) - :age (string (cast (slot result 'pw-age) c-call:c-string)) - :comment (string (cast (slot result 'pw-comment) c-call:c-string)) - :gecos (string (cast (slot result 'pw-gecos) c-call:c-string)) - :dir (string (cast (slot result 'pw-dir) c-call:c-string)) - :shell (string (cast (slot result 'pw-shell) c-call:c-string))))))) - -#+bsd -(defun unix-getpwuid (uid) - _N"Return a USER-INFO structure for the user identified by UID, or NIL if not found." - (declare (type unix-uid uid)) - (let ((result - (alien-funcall - (extern-alien "getpwuid" - (function (* (struct passwd)) - c-call:unsigned-int)) - uid))) - (when (not (zerop (sap-int (alien-sap result)))) - (make-user-info - :name (string (cast (slot result 'pw-name) c-call:c-string)) - :password (string (cast (slot result 'pw-passwd) c-call:c-string)) - :uid (slot result 'pw-uid) - :gid (slot result 'pw-gid) - :gecos (string (cast (slot result 'pw-gecos) c-call:c-string)) - :dir (string (cast (slot result 'pw-dir) c-call:c-string)) - :shell (string (cast (slot result 'pw-shell) c-call:c-string)))))) #+solaris (eval-when (:compile-toplevel :load-toplevel :execute) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/compare/2a6b55bbb617992d9901e6be…

1 0

[cmucl/cmucl][master] 2 commits: Add asdf documentation.
by Raymond Toy 17 Apr '15

17 Apr '15

Raymond Toy pushed to master at cmucl / cmucl Commits: 64f8e6a9 by Raymond Toy at 2015-04-16T20:25:33Z Add asdf documentation. - - - - - 48c324f4 by Raymond Toy at 2015-04-16T20:41:01Z Install the asdf docs too. Also, install the asdf/defsystem sources before the fasls so that the fasls have a newer timestamp than the source. - - - - - 4 changed files: - bin/make-main-dist.sh - + src/contrib/asdf/doc/asdf.html - + src/contrib/asdf/doc/asdf.info - + src/contrib/asdf/doc/asdf.pdf Changes: ===================================== bin/make-main-dist.sh ===================================== --- a/bin/make-main-dist.sh +++ b/bin/make-main-dist.sh @@ -126,11 +126,11 @@ do install ${GROUP} ${OWNER} -m 0644 $f $DESTDIR/lib/cmucl/lib/ext-formats/ done -# Create the directories and install the fasl files for asdf and defsystem -for f in asdf defsystem +set -x +# Create the directories for asdf and defsystem +for f in asdf defsystem asdf/doc do install -d ${GROUP} ${OWNER} -m 0755 $DESTDIR/lib/cmucl/lib/contrib/$f - install ${GROUP} ${OWNER} -m 0644 $TARGET/contrib/$f/$f.$FASL $DESTDIR/lib/cmucl/lib/contrib/$f done # Copy the source files for asdf and defsystem @@ -139,6 +139,19 @@ do install ${GROUP} ${OWNER} -m 0644 src/$f $DESTDIR/lib/cmucl/lib/$f done +# Install the fasl files for asdf and defsystem +for f in asdf defsystem +do + install ${GROUP} ${OWNER} -m 0644 $TARGET/contrib/$f/$f.$FASL $DESTDIR/lib/cmucl/lib/contrib/$f +done + +# Install the docs for asdf +for f in src/contrib/asdf/doc/* +do + base=`basename $f` + install ${GROUP} ${OWNER} -m 0644 $f $DESTDIR/lib/cmucl/lib/contrib/asdf/doc/$base +done + install ${GROUP} ${OWNER} -m 0644 src/general-info/cmucl.1 \ $DESTDIR/${MANDIR}/ install ${GROUP} ${OWNER} -m 0644 src/general-info/lisp.1 \ ===================================== src/contrib/asdf/doc/asdf.html ===================================== --- /dev/null +++ b/src/contrib/asdf/doc/asdf.html @@ -0,0 +1,4661 @@ +<html lang="en"> +<head> +<title>ASDF Manual</title> +<meta http-equiv="Content-Type" content="text/html"> +<meta name="description" content="ASDF Manual"> +<meta name="generator" content="makeinfo 4.13"> +<link title="Top" rel="top" href="#Top"> +<link href="http://www.gnu.org/software/texinfo/" rel="generator-home" title="Texinfo Homepage"> + +<meta http-equiv="Content-Style-Type" content="text/css"> +<style type="text/css"></style> +</head> +<body> +<h1 class="settitle">ASDF Manual</h1> + <div class="contents"> +<h2>Table of Contents</h2> +<ul> +<li><a name="toc_Top" href="#Top">asdf: another system definition facility</a> +<li><a name="toc_Introduction" href="#Introduction">1 Introduction</a> +<li><a name="toc_Loading-ASDF" href="#Loading-ASDF">2 Loading ASDF</a> +<ul> +<li><a href="#Loading-ASDF">2.1 Loading a pre-installed ASDF</a> +<li><a href="#Loading-ASDF">2.2 Checking whether ASDF is loaded</a> +<li><a href="#Loading-ASDF">2.3 Upgrading ASDF</a> +<li><a href="#Loading-ASDF">2.4 Loading an otherwise installed ASDF</a> +</li></ul> +<li><a name="toc_Configuring-ASDF" href="#Configuring-ASDF">3 Configuring ASDF</a> +<ul> +<li><a href="#Configuring-ASDF">3.1 Configuring ASDF to find your systems</a> +<li><a href="#Configuring-ASDF">3.2 Configuring ASDF to find your systems — old style</a> +<li><a href="#Configuring-ASDF">3.3 Configuring where ASDF stores object files</a> +<li><a href="#Using-ASDF">3.4 Resetting Configuration</a> +</li></ul> +<li><a name="toc_Using-ASDF" href="#Using-ASDF">4 Using ASDF</a> +<ul> +<li><a href="#Using-ASDF">4.1 Loading a system</a> +<li><a href="#Using-ASDF">4.2 Other Operations</a> +<li><a href="#Using-ASDF">4.3 Summary</a> +<li><a href="#Using-ASDF">4.4 Moving on</a> +</li></ul> +<li><a name="toc_Defining-systems-with-defsystem" href="#Defining-systems-with-defsystem">5 Defining systems with defsystem</a> +<ul> +<li><a href="#The-defsystem-form">5.1 The defsystem form</a> +<li><a href="#A-more-involved-example">5.2 A more involved example</a> +<li><a href="#The-defsystem-grammar">5.3 The defsystem grammar</a> +<ul> +<li><a href="#The-defsystem-grammar">5.3.1 Component names</a> +<li><a href="#The-defsystem-grammar">5.3.2 Component types</a> +<li><a href="#The-defsystem-grammar">5.3.3 System class names</a> +<li><a href="#The-defsystem-grammar">5.3.4 Defsystem depends on</a> +<li><a href="#The-defsystem-grammar">5.3.5 Weakly depends on</a> +<li><a href="#The-defsystem-grammar">5.3.6 Pathname specifiers</a> +<li><a href="#The-defsystem-grammar">5.3.7 Version specifiers</a> +<li><a href="#The-defsystem-grammar">5.3.8 Using logical pathnames</a> +<li><a href="#The-defsystem-grammar">5.3.9 Serial dependencies</a> +<li><a href="#The-defsystem-grammar">5.3.10 Source location</a> +<li><a href="#The-defsystem-grammar">5.3.11 if-feature option</a> +<li><a href="#The-defsystem-grammar">5.3.12 if-component-dep-fails option</a> +</li></ul> +<li><a href="#Other-code-in-_002easd-files">5.4 Other code in .asd files</a> +</li></ul> +<li><a name="toc_The-object-model-of-ASDF" href="#The-object-model-of-ASDF">6 The object model of ASDF</a> +<ul> +<li><a href="#Operations">6.1 Operations</a> +<ul> +<li><a href="#Predefined-operations-of-ASDF">6.1.1 Predefined operations of ASDF</a> +<li><a href="#Creating-new-operations">6.1.2 Creating new operations</a> +</li></ul> +<li><a href="#Components">6.2 Components</a> +<ul> +<li><a href="#Common-attributes-of-components">6.2.1 Common attributes of components</a> +<ul> +<li><a href="#Common-attributes-of-components">6.2.1.1 Name</a> +<li><a href="#Common-attributes-of-components">6.2.1.2 Version identifier</a> +<li><a href="#Common-attributes-of-components">6.2.1.3 Required features</a> +<li><a href="#Common-attributes-of-components">6.2.1.4 Dependencies</a> +<li><a href="#Common-attributes-of-components">6.2.1.5 pathname</a> +<li><a href="#Common-attributes-of-components">6.2.1.6 properties</a> +</li></ul> +<li><a href="#Pre_002ddefined-subclasses-of-component">6.2.2 Pre-defined subclasses of component</a> +<li><a href="#Creating-new-component-types">6.2.3 Creating new component types</a> +</li></ul> +<li><a href="#Functions">6.3 Functions</a> +</li></ul> +<li><a name="toc_Controlling-where-ASDF-searches-for-systems" href="#Controlling-where-ASDF-searches-for-systems">7 Controlling where ASDF searches for systems</a> +<ul> +<li><a href="#Controlling-where-ASDF-searches-for-systems">7.1 Configurations</a> +<li><a href="#Controlling-where-ASDF-searches-for-systems">7.2 Truenames and other dangers</a> +<li><a href="#Controlling-where-ASDF-searches-for-systems">7.3 XDG base directory</a> +<li><a href="#Controlling-where-ASDF-searches-for-systems">7.4 Backward Compatibility</a> +<li><a href="#Controlling-where-ASDF-searches-for-systems">7.5 Configuration DSL</a> +<li><a href="#Controlling-where-ASDF-searches-for-systems">7.6 Configuration Directories</a> +<ul> +<li><a href="#Controlling-where-ASDF-searches-for-systems">7.6.1 The :here directive</a> +</li></ul> +<li><a href="#Controlling-where-ASDF-searches-for-systems">7.7 Shell-friendly syntax for configuration</a> +<li><a href="#Controlling-where-ASDF-searches-for-systems">7.8 Search Algorithm</a> +<li><a href="#Controlling-where-ASDF-searches-for-systems">7.9 Caching Results</a> +<li><a href="#Controlling-where-ASDF-searches-for-systems">7.10 Configuration API</a> +<li><a href="#Controlling-where-ASDF-searches-for-systems">7.11 Status</a> +<li><a href="#Controlling-where-ASDF-searches-for-systems">7.12 Rejected ideas</a> +<li><a href="#Controlling-where-ASDF-searches-for-systems">7.13 TODO</a> +<li><a href="#Controlling-where-ASDF-searches-for-systems">7.14 Credits for the source-registry</a> +</li></ul> +<li><a name="toc_Controlling-where-ASDF-saves-compiled-files" href="#Controlling-where-ASDF-saves-compiled-files">8 Controlling where ASDF saves compiled files</a> +<ul> +<li><a href="#Controlling-where-ASDF-saves-compiled-files">8.1 Configurations</a> +<li><a href="#Controlling-where-ASDF-saves-compiled-files">8.2 Backward Compatibility</a> +<li><a href="#Controlling-where-ASDF-saves-compiled-files">8.3 Configuration DSL</a> +<li><a href="#Controlling-where-ASDF-saves-compiled-files">8.4 Configuration Directories</a> +<li><a href="#Controlling-where-ASDF-saves-compiled-files">8.5 Shell-friendly syntax for configuration</a> +<li><a href="#Controlling-where-ASDF-saves-compiled-files">8.6 Semantics of Output Translations</a> +<li><a href="#Controlling-where-ASDF-saves-compiled-files">8.7 Caching Results</a> +<li><a href="#Controlling-where-ASDF-saves-compiled-files">8.8 Output location API</a> +<li><a href="#Controlling-where-ASDF-saves-compiled-files">8.9 Credits for output translations</a> +</li></ul> +<li><a name="toc_Error-handling" href="#Error-handling">9 Error handling</a> +<ul> +<li><a href="#Error-handling">9.1 ASDF errors</a> +<li><a href="#Error-handling">9.2 Compilation error and warning handling</a> +</li></ul> +<li><a name="toc_Miscellaneous-additional-functionality" href="#Miscellaneous-additional-functionality">10 Miscellaneous additional functionality</a> +<ul> +<li><a href="#Miscellaneous-additional-functionality">10.1 Controlling file compilation</a> +<li><a href="#Miscellaneous-additional-functionality">10.2 Controlling source file character encoding</a> +<li><a href="#Miscellaneous-additional-functionality">10.3 Miscellaneous Functions</a> +<li><a href="#Miscellaneous-additional-functionality">10.4 Some Utility Functions</a> +</li></ul> +<li><a name="toc_Getting-the-latest-version" href="#Getting-the-latest-version">11 Getting the latest version</a> +<li><a name="toc_FAQ" href="#FAQ">12 FAQ</a> +<ul> +<li><a href="#FAQ">12.1 “Where do I report a bug?”</a> +<li><a href="#FAQ">12.2 “What has changed between ASDF 1 and ASDF 2?”</a> +<ul> +<li><a href="#FAQ">12.2.1 What are ASDF 1 and ASDF 2?</a> +<li><a href="#FAQ">12.2.2 ASDF can portably name files in subdirectories</a> +<li><a href="#FAQ">12.2.3 Output translations</a> +<li><a href="#FAQ">12.2.4 Source Registry Configuration</a> +<li><a href="#FAQ">12.2.5 Usual operations are made easier to the user</a> +<li><a href="#FAQ">12.2.6 Many bugs have been fixed</a> +<li><a href="#FAQ">12.2.7 ASDF itself is versioned</a> +<li><a href="#FAQ">12.2.8 ASDF can be upgraded</a> +<li><a href="#FAQ">12.2.9 Decoupled release cycle</a> +<li><a href="#FAQ">12.2.10 Pitfalls of the transition to ASDF 2</a> +</li></ul> +<li><a href="#FAQ">12.3 Issues with installing the proper version of ASDF</a> +<ul> +<li><a href="#FAQ">12.3.1 “My Common Lisp implementation comes with an outdated version of ASDF. What to do?”</a> +<li><a href="#FAQ">12.3.2 “I'm a Common Lisp implementation vendor. When and how should I upgrade ASDF?”</a> +</li></ul> +<li><a href="#FAQ">12.4 Issues with configuring ASDF</a> +<ul> +<li><a href="#FAQ">12.4.1 “How can I customize where fasl files are stored?”</a> +<li><a href="#FAQ">12.4.2 “How can I wholly disable the compiler output cache?”</a> +</li></ul> +<li><a href="#FAQ">12.5 Issues with using and extending ASDF to define systems</a> +<ul> +<li><a href="#FAQ">12.5.1 “How can I cater for unit-testing in my system?”</a> +<li><a href="#FAQ">12.5.2 “How can I cater for documentation generation in my system?”</a> +<li><a href="#FAQ">12.5.3 “How can I maintain non-Lisp (e.g. C) source files?”</a> +<li><a href="#FAQ">12.5.4 “I want to put my module's files at the top level. How do I do this?”</a> +<li><a href="#FAQ">12.5.5 How do I create a system definition where all the source files have a .cl extension?</a> +</li></ul> +</li></ul> +<li><a name="toc_TODO-list" href="#TODO-list">13 TODO list</a> +<ul> +<li><a href="#TODO-list">13.1 Outstanding spec questions, things to add</a> +<li><a href="#TODO-list">13.2 Missing bits in implementation</a> +</li></ul> +<li><a name="toc_Inspiration" href="#Inspiration">14 Inspiration</a> +<ul> +<li><a href="#Inspiration">14.1 mk-defsystem (defsystem-3.x)</a> +<li><a href="#Inspiration">14.2 defsystem-4 proposal</a> +<li><a href="#Inspiration">14.3 kmp's “The Description of Large Systems”, MIT AI Memo 801</a> +</li></ul> +<li><a name="toc_Concept-Index" href="#Concept-Index">Concept Index</a> +<li><a name="toc_Function-and-Class-Index" href="#Function-and-Class-Index">Function and Class Index</a> +<li><a name="toc_Variable-Index" href="#Variable-Index">Variable Index</a> +</li></ul> +</div> + + + + +<p><a name="Top"></a> + +<h2 class="unnumbered">asdf: another system definition facility</h2> + +<p>This manual describes ASDF, a system definition facility +for Common Lisp programs and libraries. + + <p>You can find the latest version of this manual at +<a href="http://common-lisp.net/project/asdf/asdf.html">http://common-lisp.net/project/asdf/asdf.html</a>. + + <p>ASDF Copyright © 2001-2013 Daniel Barlow and contributors. + + <p>This manual Copyright © 2001-2013 Daniel Barlow and contributors. + + <p>This manual revised © 2009-2013 Robert P. Goldman and Francois-Rene Rideau. + + <p>Permission is hereby granted, free of charge, to any person obtaining +a copy of this software and associated documentation files (the +“Software”), to deal in the Software without restriction, including +without limitation the rights to use, copy, modify, merge, publish, +distribute, sublicense, and/or sell copies of the Software, and to +permit persons to whom the Software is furnished to do so, subject to +the following conditions: + + <p>The above copyright notice and this permission notice shall be +included in all copies or substantial portions of the Software. + + <p>THE SOFTWARE IS PROVIDED “AS IS”, WITHOUT WARRANTY OF ANY KIND, +EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. + + +<p><a name="Introduction"></a> + + +<h2 class="chapter">1 Introduction</h2> + +<p><a name="index-ASDF_002drelated-features-1"></a><a name="index-g_t_002afeatures_002a-2"></a><a name="index-Testing-for-ASDF-3"></a><a name="index-ASDF-versions-4"></a><a name="index-g_t_003aasdf-5"></a><a name="index-g_t_003aasdf2-6"></a><a name="index-g_t_003aasdf3-7"></a> +ASDF is Another System Definition Facility: +a tool for specifying how systems of Common Lisp software +are comprised of components (sub-systems and files), +and how to operate on these components in the right order +so that they can be compiled, loaded, tested, etc. + + <p>ASDF presents three faces: +one for users of Common Lisp software who want to reuse other people's code, +one for writers of Common Lisp software who want to specify how to build their systems, +one for implementers of Common Lisp extensions who want to extend the build system. +See <a href="#Using-ASDF">Loading a system</a>, +to learn how to use ASDF to load a system. +See <a href="#Defining-systems-with-defsystem">Defining systems with defsystem</a>, +to learn how to define a system of your own. +See <a href="#The-object-model-of-ASDF">The object model of ASDF</a>, for a description of +the ASDF internals and how to extend ASDF. + + <p><em>Nota Bene</em>: +We have released ASDF 2.000 on May 31st 2010, +and ASDF 3.0 on January 31st 2013. +Releases of ASDF 2 and later have since then been included +in all actively maintained CL implementations that used to bundle ASDF 1, +plus some implementations that didn't use to, +and has been made to work with all actively used CL implementations and a few more. +See <a href="#FAQ">“What has changed between ASDF 1 and ASDF 2?”</a>. +Furthermore, it is possible to upgrade from ASDF 1 to ASDF 2 or ASDF 3 on the fly. +For this reason, we have stopped supporting ASDF 1 and ASDF 2. +If you are using ASDF 1 or ASDF 2 and are experiencing any kind of issues or limitations, +we recommend you upgrade to ASDF 3 +— and we explain how to do that. See <a href="#Loading-ASDF">Loading ASDF</a>. + + <p>Also note that ASDF is not to be confused with ASDF-Install. +ASDF-Install is not part of ASDF, but a separate piece of software. +ASDF-Install is also unmaintained and obsolete. +We recommend you use Quicklisp instead, +which works great and is being actively maintained. +If you want to download software from version control instead of tarballs, +so you may more easily modify it, we recommend clbuild. + +<p><a name="Loading-ASDF"></a> + + +<h2 class="chapter">2 Loading ASDF</h2> + +<p><a name="index-g_t_002acentral_002dregistry_002a-8"></a><a name="index-link-farm-9"></a><a name="index-load_002dsystem-10"></a><a name="index-require_002dsystem-11"></a><a name="index-compile_002dsystem-12"></a><a name="index-test_002dsystem-13"></a><a name="index-system-directory-designator-14"></a><a name="index-operate-15"></a><a name="index-oos-16"></a> + + + + +<h3 class="section">2.1 Loading a pre-installed ASDF</h3> + +<p>Most recent Lisp implementations include a copy of ASDF 2, and soon ASDF 3. +You can usually load this copy using Common Lisp's <code>require</code> function: + +<pre class="lisp"> (require "asdf") +</pre> + <p>As of the writing of this manual, +the following implementations provide ASDF 2 this way: +abcl allegro ccl clisp cmucl ecl lispworks mkcl sbcl xcl. +The following implementation doesn't provide it yet but will in an upcoming release: +scl. +The following implementations are obsolete, not actively maintained, +and most probably will never bundle it: +cormanlisp gcl genera mcl. + + <p>If the implementation you are using doesn't provide ASDF 2 or ASDF 3, +see see <a href="#Loading-ASDF">Loading an otherwise installed ASDF</a> below. +If that implementation is still actively maintained, +you may also send a bug report to your Lisp vendor and complain +about their failing to provide ASDF. + + <p>NB: all implementations except clisp also accept +<code>(require "ASDF")</code>, <code>(require 'asdf)</code> and <code>(require :asdf)</code>. +For portability's sake, you probably want to use <code>(require "asdf")</code>. + +<h3 class="section">2.2 Checking whether ASDF is loaded</h3> + +<p>To check whether ASDF is properly loaded in your current Lisp image, +you can run this form: + +<pre class="lisp"> (asdf:asdf-version) +</pre> + <p>If it returns a string, +that is the version of ASDF that is currently installed. + + <p>If it raises an error, +then either ASDF is not loaded, or +you are using an old version of ASDF. + + <p>You can check whether an old version is loaded +by checking if the ASDF package is present. +The form below will allow you to programmatically determine +whether a recent version is loaded, an old version is loaded, +or none at all: + +<pre class="lisp"> (when (find-package :asdf) + (let ((ver (symbol-value (or (find-symbol (string :*asdf-version*) :asdf) + (find-symbol (string :*asdf-revision*) :asdf))))) + (etypecase ver + (string ver) + (cons (with-output-to-string (s) + (loop for (n . m) on ver do (princ n s) (when m (princ "." s))))) + (null "1.0")))) +</pre> + <p>If it returns <code>nil</code> then ASDF is not installed. +Otherwise it should return a string. +If it returns <code>"1.0"</code>, then it can actually be +any version before 1.77 or so, or some buggy variant of 1.x. + + <p>If you are experiencing problems with ASDF, +please try upgrading to the latest released version, +using the method below, +before you contact us and raise an issue. + +<h3 class="section">2.3 Upgrading ASDF</h3> + +<p>If your implementation provides ASDF 3 or later, +you only need to <code>(require "asdf")</code>: +ASDF will automatically look whether an updated version of itself is available +amongst the regularly configured systems, before it compiles anything else. +See see <a href="#Configuring-ASDF">Configuring ASDF</a> below. + + <p>If your implementation does provide ASDF 2 or later, +but not ASDF 3 or later, +and you want to upgrade to a more recent version, +you need to install and configure your ASDF as above, +and additionally, you need to explicitly tell ASDF to load itself, +right after you require your implementation's old ASDF 2: + +<pre class="lisp"> (require "asdf") + (asdf:load-system :asdf) +</pre> + <p>If on the other hand, your implementation only provides an old ASDF, +you will require a special configuration step and an old-style loading. +Take special attention to not omit the trailing directory separator +<code>/</code> at the end of your pathname: + +<pre class="lisp"> (require "asdf") + (push #p"<var>/path/to/new/asdf/</var>" asdf:*central-registry*) + (asdf:oos 'asdf:load-op :asdf) +</pre> + <p>Note that ASDF 1 won't redirect its output files, +or at least won't do it according to your usual ASDF 2 configuration. +You therefore need write access on the directory +where you install the new ASDF, +and make sure you're not using it +for multiple mutually incompatible implementations. +At worst, you may have to have multiple copies of the new ASDF, +e.g. one per implementation installation, to avoid clashes. +Note that to our knowledge all implementations that provide ASDF +provide ASDF 2 in their latest release, so +you may want to upgrade your implementation rather than go through that hoop. + + <p>Finally, if you are using an unmaintained implementation +that does not provide ASDF at all, +see see <a href="#Loading-ASDF">Loading an otherwise installed ASDF</a> below. + + <p>Note that there are some limitations to upgrading ASDF: + <ul> +<li>Previously loaded ASDF extension becomes invalid, and will need to be reloaded. +This applies to e.g. CFFI-Grovel, or to hacks used by ironclad, etc. +Since it isn't possible to automatically detect what extensions are present +that need to be invalidated, +ASDF will actually invalidate all previously loaded systems +when it is loaded on top of a different ASDF version, +starting with ASDF 2.014.8 (as far as releases go, 2.015); +and it will automatically attempt this self-upgrade as its very first step +starting with ASDF 3. + + <li>For this an many other reasons, +it important reason to load, configure and upgrade ASDF (if needed) +as one of the very first things done by your build and startup scripts. +Until all implementations provide ASDF 3 or later, +it is safer if you upgrade ASDF and its extensions as a special step +at the very beginning of whatever script you are running, +before you start using ASDF to load anything else; +even afterwards, it is still a good idea, to avoid having to +load and reload code twice as it gets invalidated. + + <li>Until all implementations provide ASDF 3 or later, +it is unsafe to upgrade ASDF as part of loading a system +that depends on a more recent version of ASDF, +since the new one might shadow the old one while the old one is running, +and the running old one will be confused +when extensions are loaded into the new one. +In the meantime, we recommend that your systems should <em>not</em> specify +<code>:depends-on (:asdf)</code>, or <code>:depends-on ((:version :asdf "2.010"))</code>, +but instead that they check that a recent enough ASDF is installed, +with such code as: + <pre class="example"> (unless (or #+asdf2 (asdf:version-satisfies + (asdf:asdf-version) *required-asdf-version*)) + (error "FOO requires ASDF ~A or later." *required-asdf-version*)) +</pre> + <li>Until all implementations provide ASDF 3 or later, +it is unsafe for a system to transitively depend on ASDF +and not directly depend on ASDF; +if any of the system you use either depends-on asdf, +system-depends-on asdf, or transitively does, +you should also do as well. +</ul> + +<h3 class="section">2.4 Loading an otherwise installed ASDF</h3> + +<p>If your implementation doesn't include ASDF, +if for some reason the upgrade somehow fails, +does not or cannot apply to your case, +you will have to install the file <samp><span class="file">asdf.lisp</span></samp> +somewhere and load it with: + +<pre class="lisp"> (load "/path/to/your/installed/asdf.lisp") +</pre> + <p>The single file <samp><span class="file">asdf.lisp</span></samp> is all you normally need to use ASDF. + + <p>You can extract this file from latest release tarball on the +<a href="http://common-lisp.net/project/asdf/">ASDF website</a>. +If you are daring and willing to report bugs, you can get +the latest and greatest version of ASDF from its git repository. +See <a href="#Getting-the-latest-version">Getting the latest version</a>. + + <p>For maximum convenience you might want to have ASDF loaded +whenever you start your Lisp implementation, +for example by loading it from the startup script or dumping a custom core +— check your Lisp implementation's manual for details. + +<p><a name="Configuring-ASDF"></a> + + +<h2 class="chapter">3 Configuring ASDF</h2> + +<h3 class="section">3.1 Configuring ASDF to find your systems</h3> + +<p>So it may compile and load your systems, ASDF must be configured to find +the <samp><span class="file">.asd</span></samp> files that contain system definitions. + + <p>Since ASDF 2, the preferred way to configure where ASDF finds your systems is +the <code>source-registry</code> facility, +fully described in its own chapter of this manual. +See <a href="#Controlling-where-ASDF-searches-for-systems">Controlling where ASDF searches for systems</a>. + + <p>The default location for a user to install Common Lisp software is under +<samp><span class="file">~/.local/share/common-lisp/source/</span></samp>. +If you install software there (it can be a symlink), +you don't need further configuration. +If you're installing software yourself at a location that isn't standard, +you have to tell ASDF where you installed it. See below. +If you're using some tool to install software (e.g. Quicklisp), +the authors of that tool should already have configured ASDF. + + <p>The simplest way to add a path to your search path, +say <samp><span class="file">/home/luser/.asd-link-farm/</span></samp> +is to create the directory +<samp><span class="file">~/.config/common-lisp/source-registry.conf.d/</span></samp> +and there create a file with any name of your choice, +and with the type <samp><span class="file">conf</span></samp>, +for instance <samp><span class="file">42-asd-link-farm.conf</span></samp> +containing the line: + + <p><kbd>(:directory "/home/luser/.asd-link-farm/")</kbd> + + <p>If you want all the subdirectories under <samp><span class="file">/home/luser/lisp/</span></samp> +to be recursively scanned for <samp><span class="file">.asd</span></samp> files, instead use: + + <p><kbd>(:tree "/home/luser/lisp/")</kbd> + + <p>Note that your Operating System distribution or your system administrator +may already have configured system-managed libraries for you. + + <p>The required <samp><span class="file">.conf</span></samp> extension allows you to have disabled files +or editor backups (ending in <samp><span class="file">~</span></samp>), and works portably +(for instance, it is a pain to allow both empty and non-empty extension on CLISP). +Excluded are files the name of which start with a <samp><span class="file">.</span></samp> character. +It is customary to start the filename with two digits +that specify the order in which the directories will be scanned. + + <p>ASDF will automatically read your configuration +the first time you try to find a system. +You can reset the source-registry configuration with: + +<pre class="lisp"> (asdf:clear-source-registry) +</pre> + <p>And you probably should do so before you dump your Lisp image, +if the configuration may change +between the machine where you save it at the time you save it +and the machine you resume it at the time you resume it. +Actually, you should use <code>(asdf:clear-configuration)</code> +before you dump your Lisp image, which includes the above. + +<h3 class="section">3.2 Configuring ASDF to find your systems — old style</h3> + +<p>The old way to configure ASDF to find your systems is by +<code>push</code>ing directory pathnames onto the variable +<code>asdf:*central-registry*</code>. + + <p>You must configure this variable between the time you load ASDF +and the time you first try to use it. +Loading and configuring ASDF presumably happen +as part of some initialization script that builds or starts +your Common Lisp software system. +(For instance, some SBCL users used to put it in their <samp><span class="file">~/.sbclrc</span></samp>.) + + <p>The <code>asdf:*central-registry*</code> is empty by default in ASDF 2 or ASDF 3, +but is still supported for compatibility with ASDF 1. +When used, it takes precedence over the above source-registry<a rel="footnote" href="#fn-1" name="fnd-1"><sup>1</sup></a>. + + <p>For instance, if you wanted ASDF to find the <samp><span class="file">.asd</span></samp> file +<samp><span class="file">/home/me/src/foo/foo.asd</span></samp> your initialization script +could after it loads ASDF with <code>(require "asdf")</code> +configure it with: + +<pre class="lisp"> (push "/home/me/src/foo/" asdf:*central-registry*) +</pre> + <p>Note the trailing slash: when searching for a system, +ASDF will evaluate each entry of the central registry +and coerce the result to a pathname<a rel="footnote" href="#fn-2" name="fnd-2"><sup>2</sup></a> +at which point the presence of the trailing directory name separator +is necessary to tell Lisp that you're discussing a directory +rather than a file. + + <p>Typically, however, there are a lot of <samp><span class="file">.asd</span></samp> files, and +a common idiom was to have to put +a bunch of <em>symbolic links</em> to <samp><span class="file">.asd</span></samp> files +in a common directory +and push <em>that</em> directory (the “link farm”) +to the +<code>asdf:*central-registry*</code> +instead of pushing each of the many involved directories +to the <code>asdf:*central-registry*</code>. +ASDF knows how to follow such <em>symlinks</em> +to the actual file location when resolving the paths of system components +(on Windows, you can use Windows shortcuts instead of POSIX symlinks; +if you try aliases under MacOS, we are curious to hear about your experience). + + <p>For example, if <code>#p"/home/me/cl/systems/"</code> (note the trailing slash) +is a member of <code>*central-registry*</code>, you could set up the +system <var>foo</var> for loading with asdf with the following +commands at the shell: + +<pre class="example"> $ cd /home/me/cl/systems/ + $ ln -s ~/src/foo/foo.asd . +</pre> + <p>This old style for configuring ASDF is not recommended for new users, +but it is supported for old users, and for users who want to programmatically +control what directories are added to the ASDF search path. + +<h3 class="section">3.3 Configuring where ASDF stores object files</h3> + +<p><a name="index-clear_002doutput_002dtranslations-17"></a> +ASDF lets you configure where object files will be stored. +Sensible defaults are provided and +you shouldn't normally have to worry about it. + + <p>This allows the same source code repository may be shared +between several versions of several Common Lisp implementations, +between several users using different compilation options +and without write privileges on shared source directories, etc. +This also allows to keep source directories uncluttered +by plenty of object files. + + <p>Starting with ASDF 2, the <code>asdf-output-translations</code> facility +was added to ASDF itself, that controls where object files will be stored. +This facility is fully described in a chapter of this manual, +<a href="#Controlling-where-ASDF-saves-compiled-files">Controlling where ASDF saves compiled files</a>. + + <p>The simplest way to add a translation to your search path, +say from <samp><span class="file">/foo/bar/baz/quux/</span></samp> +to <samp><span class="file">/where/i/want/my/fasls/</span></samp> +is to create the directory +<samp><span class="file">~/.config/common-lisp/asdf-output-translations.conf.d/</span></samp> +and there create a file with any name of your choice and the type <samp><span class="file">conf</span></samp>, +for instance <samp><span class="file">42-bazquux.conf</span></samp> +containing the line: + + <p><kbd>("/foo/bar/baz/quux/" "/where/i/want/my/fasls/")</kbd> + + <p>To disable output translations for source under a given directory, +say <samp><span class="file">/toto/tata/</span></samp> +you can create a file <samp><span class="file">40-disable-toto.conf</span></samp> +with the line: + + <p><kbd>("/toto/tata/")</kbd> + + <p>To wholly disable output translations for all directories, +you can create a file <samp><span class="file">00-disable.conf</span></samp> +with the line: + + <p><kbd>(t t)</kbd> + + <p>Note that your Operating System distribution or your system administrator +may already have configured translations for you. +In absence of any configuration, the default is to redirect everything +under an implementation-dependent subdirectory of <samp><span class="file">~/.cache/common-lisp/</span></samp>. +See <a href="#Controlling-where-ASDF-searches-for-systems">Controlling where ASDF searches for systems</a>, for full details. + + <p>The required <samp><span class="file">.conf</span></samp> extension allows you to have disabled files +or editor backups (ending in <samp><span class="file">~</span></samp>), and works portably +(for instance, it is a pain to allow both empty and non-empty extension on CLISP). +Excluded are files the name of which start with a <samp><span class="file">.</span></samp> character. +It is customary to start the filename with two digits +that specify the order in which the directories will be scanned. + + <p>ASDF will automatically read your configuration +the first time you try to find a system. +You can reset the source-registry configuration with: + +<pre class="lisp"> (asdf:clear-output-translations) +</pre> + <p>And you probably should do so before you dump your Lisp image, +if the configuration may change +between the machine where you save it at the time you save it +and the machine you resume it at the time you resume it. +(Once again, you should use <code>(asdf:clear-configuration)</code> +before you dump your Lisp image, which includes the above.) + + <p>Finally note that before ASDF 2, +other ASDF add-ons offered the same functionality, +each in subtly different and incompatible ways: +ASDF-Binary-Locations, cl-launch, common-lisp-controller. +ASDF-Binary-Locations is now not needed anymore and should not be used. +cl-launch 3.000 and common-lisp-controller 7.2 have been updated +to just delegate this functionality to ASDF. + +<p><a name="Using-ASDF"></a> + + +<h3 class="section">3.4 Resetting Configuration</h3> + +<p>When you dump and restore an image, or when you tweak your configuration, +you may want to reset the ASDF configuration. +For that you may use the following function: + +<div class="defun"> +— Function: <b>clear-configuration</b><var><a name="index-clear_002dconfiguration-18"></a></var><br> +<blockquote><p> undoes any ASDF configuration, + regarding source-registry or output-translations. +</p></blockquote></div> + + <p>If you use SBCL, CMUCL or SCL, you may use this snippet +so that the ASDF configuration be cleared automatically as you dump an image: + +<pre class="example"> #+(or cmu sbcl scl) + (pushnew 'clear-configuration + #+(or cmu scl) ext:*before-save-initializations* + #+sbcl sb-ext:*save-hooks*) +</pre> + <p>For compatibility with all Lisp implementations, however, +you might want instead your build script to explicitly call +<code>(asdf:clear-configuration)</code> at an appropriate moment before dumping. + +<h2 class="chapter">4 Using ASDF</h2> + +<h3 class="section">4.1 Loading a system</h3> + +<p>The system <var>foo</var> is loaded (and compiled, if necessary) +by evaluating the following Lisp form: + +<pre class="example"> (asdf:load-system :<var>foo</var>) +</pre> + <p>On some implementations (namely recent versions of +ABCL, Allegro CL, Clozure CL, CMUCL, ECL, GNU CLISP, +LispWorks, MKCL, SBCL and XCL), +ASDF hooks into the <code>CL:REQUIRE</code> facility +and you can just use: + +<pre class="example"> (require :<var>foo</var>) +</pre> + <p>In older versions of ASDF, you needed to use +<code>(asdf:oos 'asdf:load-op :</code><var>foo</var><code>)</code>. +If your ASDF is too old to provide <code>asdf:load-system</code> though +we recommend that you upgrade to ASDF 3. +See <a href="#Loading-ASDF">Loading an otherwise installed ASDF</a>. + + <p>Note the name of a system is specified as a string or a symbol, +typically a keyword. +If a symbol (including a keyword), its name is taken and lowercased. +The name must be a suitable value for the <code>:name</code> initarg +to <code>make-pathname</code> in whatever filesystem the system is to be found. +The lower-casing-symbols behaviour is unconventional, +but was selected after some consideration. +Observations suggest that the type of systems we want to support +either have lowercase as customary case (unix, mac, windows) +or silently convert lowercase to uppercase (lpns), +so this makes more sense than attempting to use <code>:case :common</code>, +which is reported not to work on some implementations + +<h3 class="section">4.2 Other Operations</h3> + +<p>ASDF provides three commands for the most common system operations: +<code>load-system</code>, <code>compile-system</code> or <code>test-system</code>. +It also provides <code>require-system</code>, a version of <code>load-system</code> +that skips trying to update systems that are already loaded. + + <p>Because ASDF is an extensible system +for defining <em>operations</em> on <em>components</em>, +it also provides a generic function <code>operate</code> +(which is usually abbreviated by <code>oos</code>). +You'll use <code>oos</code> whenever you want to do something beyond +compiling, loading and testing. + + <p>Output from ASDF and ASDF extensions are supposed to be sent +to the CL stream <code>*standard-output*</code>, +and so rebinding that stream around calls to <code>asdf:operate</code> +should redirect all output from ASDF operations. + + <p>Reminder: before ASDF can operate on a system, however, +it must be able to find and load that system's definition. +See <a href="#Configuring-ASDF">Configuring ASDF to find your systems</a>. + + <p><a name="index-already_002dloaded_002dsystems-19"></a> +For the advanced users, note that +<code>require-system</code> calls <code>load-system</code> +with keyword arguments <code>:force-not (already-loaded-systems)</code>. +<code>already-loaded-systems</code> returns a list of the names of loaded systems. +<code>load-system</code> applies <code>operate</code> with the operation from +<code>*load-system-operation*</code>, which by default is <code>load-op</code>, +the system, and any provided keyword arguments. + +<h3 class="section">4.3 Summary</h3> + +<p>To use ASDF: + + <ul> +<li>Load ASDF itself into your Lisp image, either through +<code>(require "asdf")</code> or else through +<code>(load "/path/to/asdf.lisp")</code>. + + <li>Make sure ASDF can find system definitions +thanks to proper source-registry configuration. + + <li>Load a system with <code>(asdf:load-system :my-system)</code> +or use some other operation on some system of your choice. + + </ul> + +<h3 class="section">4.4 Moving on</h3> + +<p>That's all you need to know to use ASDF to load systems written by others. +The rest of this manual deals with writing system definitions +for Common Lisp software you write yourself, +including how to extend ASDF to define new operation and component types. + +<p><a name="Defining-systems-with-defsystem"></a> + + +<h2 class="chapter">5 Defining systems with defsystem</h2> + +<p>This chapter describes how to use asdf to define systems and develop +software. + +<p><a name="The-defsystem-form"></a> + + +<h3 class="section">5.1 The defsystem form</h3> + +<p>Systems can be constructed programmatically +by instantiating components using <code>make-instance</code>. +Most of the time, however, it is much more practical to use +a static <code>defsystem</code> form. +This section begins with an example of a system definition, +then gives the full grammar of <code>defsystem</code>. + + <p>Let's look at a simple system. +This is a complete file that would +usually be saved as <samp><span class="file">hello-lisp.asd</span></samp>: + +<pre class="lisp"> (in-package :asdf) + + (defsystem "hello-lisp" + :description "hello-lisp: a sample Lisp system." + :version "0.2.1" + :author "Joe User <joe(a)example.com>" + :licence "Public Domain" + :components ((:file "packages") + (:file "macros" :depends-on ("packages")) + (:file "hello" :depends-on ("macros")))) +</pre> + <p>Some notes about this example: + + <ul> +<li>The file starts with an <code>in-package</code> form +to use package <code>asdf</code>. +You could instead start your definition by using +a qualified name <code>asdf:defsystem</code>. + + <li>If in addition to simply using <code>defsystem</code>, +you are going to define functions, +create ASDF extension, globally bind symbols, etc., +it is recommended that to avoid namespace pollution between systems, +you should create your own package for that purpose, +for instance replacing the above <code>(in-package :asdf)</code> with: + + <pre class="lisp"> (defpackage :foo-system + (:use :cl :asdf)) + + (in-package :foo-system) +</pre> + <li>The <code>defsystem</code> form defines a system named <code>hello-lisp</code> +that contains three source files: +<samp><span class="file">packages</span></samp>, <samp><span class="file">macros</span></samp> and <samp><span class="file">hello</span></samp>. + + <li>The file <samp><span class="file">macros</span></samp> depends on <samp><span class="file">packages</span></samp> +(presumably because the package it's in is defined in <samp><span class="file">packages</span></samp>), +and the file <samp><span class="file">hello</span></samp> depends on <samp><span class="file">macros</span></samp> +(and hence, transitively on <samp><span class="file">packages</span></samp>). +This means that ASDF will compile and load <samp><span class="file">packages</span></samp> and <samp><span class="file">macros</span></samp> +before starting the compilation of file <samp><span class="file">hello</span></samp>. + + <li>The files are located in the same directory +as the file with the system definition. +ASDF resolves symbolic links (or Windows shortcuts) +before loading the system definition file and +stores its location in the resulting system<a rel="footnote" href="#fn-3" name="fnd-3"><sup>3</sup></a>. +This is a good thing because the user can move the system sources +without having to edit the system definition. + +  +  +  + <li>Make sure you know how the <code>:version</code> numbers will be parsed! +They are parsed as period-separated lists of integers. +I.e., in the example, <code>0.2.1</code> is to be interpreted, +roughly speaking, as <code>(0 2 1)</code>. +In particular, version <code>0.2.1</code> +is interpreted the same as <code>0.0002.1</code> and +is strictly version-less-than version <code>0.20.1</code>, +even though the two are the same when interpreted as decimal fractions. +Instead of a string representing the version, +the <code>:version</code> argument can be an expression that is resolved to +such a string using the following trivial domain-specific language: +in addition to being a literal string, it can be an expression of the form +<code>(:read-file-form <pathname-or-string> :at <access-at-specifier>)</code>, +which will be resolved by reading a form in the specified pathname +(read as a subpathname of the current system if relative or a unix-namestring). +You may use a <code>uiop:access-at</code> specifier +with the (optional) <code>:at</code> keyword, +by default the specifier is <code>0</code>, meaning the first form is returned. + + <p><a name="index-g_t_003aversion-20"></a> +</ul> + +<p><a name="A-more-involved-example"></a> + + +<h3 class="section">5.2 A more involved example</h3> + +<p>Let's illustrate some more involved uses of <code>defsystem</code> via a +slightly convoluted example: + +<pre class="lisp"> (defsystem "foo" + :version "1.0.0" + :components ((:module "mod" + :components ((:file "bar") + (:file"baz") + (:file "quux")) + :perform (compile-op :after (op c) + (do-something c)) + :explain (compile-op :after (op c) + (explain-something c))) + (:file "blah"))) +</pre> + <p>The <code>:module</code> component named <code>"mod"</code> is a collection of three files, +which will be located in a subdirectory of the main code directory named +<samp><span class="file">mod</span></samp> (this location can be overridden; see the discussion of the +<code>:pathname</code> option in <a href="#The-defsystem-grammar">The defsystem grammar</a>). + + <p>The method-form tokens provide a shorthand for defining methods on +particular components. This part + +<pre class="lisp"> :perform (compile-op :after (op c) + (do-something c)) + :explain (compile-op :after (op c) + (explain-something c)) +</pre> + <p>has the effect of + +<pre class="lisp"> (defmethod perform :after ((op compile-op) (c (eql ...))) + (do-something c)) + (defmethod explain :after ((op compile-op) (c (eql ...))) + (explain-something c)) +</pre> + <p>where <code>...</code> is the component in question. +In this case <code>...</code> would expand to something like + +<pre class="lisp"> (find-component "foo" "mod") +</pre> + <p>For more details on the syntax of such forms, see <a href="#The-defsystem-grammar">The defsystem grammar</a>. +For more details on what these methods do, see <a href="#Operations">Operations</a> in +<a href="#The-object-model-of-ASDF">The object model of ASDF</a>. + + + + + + + + +<p><a name="The-defsystem-grammar"></a> + + +<h3 class="section">5.3 The defsystem grammar</h3> + + + +<pre class="example"> system-definition := ( defsystem system-designator <var>system-option</var>* ) + + system-option := :defsystem-depends-on system-list + | :weakly-depends-on <var>system-list</var> + | :class class-name (see discussion below) + | module-option + | option + + module-option := :components component-list + | :serial [ t | nil ] + + option := + | :pathname pathname-specifier + | :default-component-class class-name + | :perform method-form + | :explain method-form + | :output-files method-form + | :operation-done-p method-form + | :if-feature feature-expression + | :depends-on ( <var>dependency-def</var>* ) + | :in-order-to ( <var>dependency</var>+ ) + + + system-list := ( <var>simple-component-name</var>* ) + + component-list := ( <var>component-def</var>* ) + + component-def := ( component-type simple-component-name <var>option</var>* ) + + component-type := :module | :file | :static-file | other-component-type + + other-component-type := symbol-by-name (see <a href="#The-defsystem-grammar">Component types</a>) + + # This is used in :depends-on, as opposed to ``dependency,'' + # which is used in :in-order-to + dependency-def := simple-component-name + | (feature <var>feature-name</var>) + | ( :version simple-component-name version-specifier) + + # ``dependency'' is used in :in-order-to, as opposed to + # ``dependency-def'' + dependency := (dependent-op <var>requirement</var>+) + requirement := (required-op <var>required-component</var>+) + | (:feature <var>feature-name</var>) + dependent-op := operation-name + required-op := operation-name + + simple-component-name := string + | symbol + + pathname-specifier := pathname | string | symbol + + method-form := (operation-name qual lambda-list &rest body) + qual := method qualifier + + component-dep-fail-option := :fail | :try-next | :ignore + + feature-expression := keyword | (:and <var>feature-expression</var>*) + | (:or <var>feature-expression</var>*) | (:not <var>feature-expression</var>) +</pre> +<h4 class="subsection">5.3.1 Component names</h4> + +<p>Component names (<code>simple-component-name</code>) +may be either strings or symbols. + +<h4 class="subsection">5.3.2 Component types</h4> + +<p>Component type names, even if expressed as keywords, will be looked up +by name in the current package and in the asdf package, if not found in +the current package. So a component type <code>my-component-type</code>, in +the current package <code>my-system-asd</code> can be specified as +<code>:my-component-type</code>, or <code>my-component-type</code>. + + <p><code>system</code> and its subclasses are <em>not</em> +allowed as component types for such children components. + +<h4 class="subsection">5.3.3 System class names</h4> + +<p>A system class name will be looked up +in the same way as a Component type (see above), +except that only <code>system</code> and its subclasses are allowed. +Typically, one will not need to specify a system +class name, unless using a non-standard system class defined in some +ASDF extension, typically loaded through <code>DEFSYSTEM-DEPENDS-ON</code>, +see below. For such class names in the ASDF package, we recommend that +the <code>:class</code> option be specified using a keyword symbol, such as + +<pre class="example"> :class :MY-NEW-SYSTEM-SUBCLASS +</pre> + <p>This practice will ensure that package name conflicts are avoided. +Otherwise, the symbol <code>MY-NEW-SYSTEM-SUBCLASS</code> will be read into +the current package <em>before</em> it has been exported from the ASDF +extension loaded by <code>:defsystem-depends-on</code>, causing a name +conflict in the current package. + +<h4 class="subsection">5.3.4 Defsystem depends on</h4> + +<p><a name="index-g_t_003adefsystem_002ddepends_002don-21"></a> +The <code>:defsystem-depends-on</code> option to <code>defsystem</code> allows the +programmer to specify another ASDF-defined system or set of systems that +must be loaded <em>before</em> the system definition is processed. +Typically this is used to load an ASDF extension that is used in the +system definition. + +<h4 class="subsection">5.3.5 Weakly depends on</h4> + +<p><a name="index-g_t_003aweakly_002ddepends_002don-22"></a> +We do <em>NOT</em> recommend you use this feature. +If you are tempted to write a system <var>foo</var> +that weakly-depends-on a system <var>bar</var>, +we recommend that you should instead +write system <var>foo</var> in a parametric way, +and offer some special variable and/or some hook to specialize its behavior; +then you should write a system <var>foo+bar</var> +that does the hooking of things together. + + <p>The (deprecated) <code>:weakly-depends-on</code> option to <code>defsystem</code> +allows the programmer to specify another ASDF-defined system or set of systems +that ASDF should <em>try</em> to load, +but need not load in order to be successful. +Typically this is used if there are a number of systems +that, if present, could provide additional functionality, +but which are not necessary for basic function. + + <p>Currently, although it is specified to be an option only to <code>defsystem</code>, +this option is accepted at any component, but it probably +only makes sense at the <code>defsystem</code> level. +Programmers are cautioned not +to use this component option except at the <code>defsystem</code> level, as +this anomalous behavior may be removed without warning. + + <p>Finally, you might look into the <code>asdf-system-connections</code> extension, +that will let you define additional code to be loaded +when two systems are simultaneously loaded. +It may or may not be considered good style, but at least it can be used +in a way that has deterministic behavior independent of load order, +unlike <code>weakly-depends-on</code>. + +<h4 class="subsection">5.3.6 Pathname specifiers</h4> + +<p><a name="index-pathname-specifiers-23"></a> +A pathname specifier (<code>pathname-specifier</code>) +may be a pathname, a string or a symbol. +When no pathname specifier is given for a component, +which is the usual case, the component name itself is used. + + <p>If a string is given, which is the usual case, +the string will be interpreted as a Unix-style pathname +where <code>/</code> characters will be interpreted as directory separators. +Usually, Unix-style relative pathnames are used +(i.e. not starting with <code>/</code>, as opposed to absolute pathnames); +they are relative to the path of the parent component. +Finally, depending on the <code>component-type</code>, +the pathname may be interpreted as either a file or a directory, +and if it's a file, +a file type may be added corresponding to the <code>component-type</code>, +or else it will be extracted from the string itself (if applicable). + + <p>For instance, the <code>component-type</code> <code>:module</code> +wants a directory pathname, and so a string <code>"foo/bar"</code> +will be interpreted as the pathname <samp><span class="file">#p"foo/bar/"</span></samp>. +On the other hand, the <code>component-type</code> <code>:file</code> +wants a file of type <code>lisp</code>, and so a string <code>"foo/bar"</code> +will be interpreted as the pathname <samp><span class="file">#p"foo/bar.lisp"</span></samp>, +and a string <code>"foo/bar.quux"</code> +will be interpreted as the pathname <samp><span class="file">#p"foo/bar.quux.lisp"</span></samp>. +Finally, the <code>component-type</code> <code>:static-file</code> +wants a file without specifying a type, and so a string <code>"foo/bar"</code> +will be interpreted as the pathname <samp><span class="file">#p"foo/bar"</span></samp>, +and a string <code>"foo/bar.quux"</code> +will be interpreted as the pathname <samp><span class="file">#p"foo/bar.quux"</span></samp>. + + <p>ASDF does not interpret the string <code>".."</code> to designate the parent +directory. This string will be passed through to the underlying +operating system for interpretation. We <em>believe</em> that this will +work on all platforms where ASDF is deployed, but do not guarantee this +behavior. A pathname object with a relative directory component of +<code>:up</code> or <code>:back</code> is the only guaranteed way to specify a +parent directory. + + <p>If a symbol is given, it will be translated into a string, +and downcased in the process. +The downcasing of symbols is unconventional, +but was selected after some consideration. +Observations suggest that the type of systems we want to support +either have lowercase as customary case (Unix, Mac, windows) +or silently convert lowercase to uppercase (lpns), +so this makes more sense than attempting to use <code>:case :common</code> +as argument to <code>make-pathname</code>, +which is reported not to work on some implementations. + + <p>Pathname objects may be given to override the path for a component. +Such objects are typically specified using reader macros such as <code>#p</code> +or <code>#.(make-pathname ...)</code>. +Note however, that <code>#p...</code> is +a shorthand for <code>#.(parse-namestring ...)</code> +and that the behavior of <code>parse-namestring</code> is completely non-portable, +unless you are using Common Lisp <code>logical-pathname</code>s, +which themselves involve other non-portable behavior +(see <a href="#The-defsystem-grammar">Using logical pathnames</a>, below). +Pathnames made with <code>#.(make-pathname ...)</code> +can usually be done more easily with the string syntax above. +The only case that you really need a pathname object is to override +the component-type default file type for a given component. +Therefore, pathname objects should only rarely be used. +Unhappily, ASDF 1 didn't properly support +parsing component names as strings specifying paths with directories, +and the cumbersome <code>#.(make-pathname ...)</code> syntax had to be used. +An alternative to <code>#.</code> read-time evaluation is to use +<code>(eval `(defsystem ... ,pathname ...))</code>. + + <p>Note that when specifying pathname objects, +ASDF does not do any special interpretation of the pathname +influenced by the component type, unlike the procedure for +pathname-specifying strings. +On the one hand, you have to be careful to provide a pathname that correctly +fulfills whatever constraints are required from that component type +(e.g. naming a directory or a file with appropriate type); +on the other hand, you can circumvent the file type that would otherwise +be forced upon you if you were specifying a string. + +<h4 class="subsection">5.3.7 Version specifiers</h4> + +<p><a name="index-version-specifiers-24"></a><a name="index-g_t_003aversion-25"></a> +Version specifiers are strings to be parsed as period-separated lists of integers. +I.e., in the example, <code>"0.2.1"</code> is to be interpreted, +roughly speaking, as <code>(0 2 1)</code>. +In particular, version <code>"0.2.1"</code> is interpreted the same as <code>"0.0002.1"</code>, +though the latter is not canonical and may lead to a warning being issued. +Also, <code>"1.3"</code> and <code>"1.4"</code> are both strictly <code>uiop:version<</code> to <code>"1.30"</code>, +quite unlike what would have happened +had the version strings been interpreted as decimal fractions. + + <p>System definers are encouraged to use version identifiers of the form +<var>x</var>.<var>y</var>.<var>z</var> for +major version, minor version and patch level, +where significant API incompatibilities are signaled by an increased major number. + + <p>See <a href="#Common-attributes-of-components">Common attributes of components</a>. + +<h4 class="subsection">5.3.8 Using logical pathnames</h4> + +<p><a name="index-logical-pathnames-26"></a> +We do not generally recommend the use of logical pathnames, +especially not so to newcomers to Common Lisp. +However, we do support the use of logical pathnames by old timers, +when such is their preference. + + <p>To use logical pathnames, +you will have to provide a pathname object as a <code>:pathname</code> specifier +to components that use it, using such syntax as +<code>#p"LOGICAL-HOST:absolute;path;to;component.lisp"</code>. + + <p>You only have to specify such logical pathname +for your system or some top-level component. +Sub-components' relative pathnames, +specified using the string syntax for names, +will be properly merged with the pathnames of their parents. +The specification of a logical pathname host however is <em>not</em> +otherwise directly supported in the ASDF syntax +for pathname specifiers as strings. + + <p>The <code>asdf-output-translation</code> layer will +avoid trying to resolve and translate logical pathnames. +The advantage of this is that +you can define yourself what translations you want to use +with the logical pathname facility. +The disadvantage is that if you do not define such translations, +any system that uses logical pathnames will behave differently under +asdf-output-translations than other systems you use. + + <p>If you wish to use logical pathnames you will have to configure the +translations yourself before they may be used. +ASDF currently provides no specific support +for defining logical pathname translations. + + <p>Note that the reasons we do not recommend logical pathnames are that +(1) there is no portable way to set up logical pathnames before they are used, +(2) logical pathnames are limited to only portably use +a single character case, digits and hyphens. +While you can solve the first issue on your own, +describing how to do it on each of fifteen implementations supported by ASDF +is more than we can document. +As for the second issue, mind that the limitation is notably enforced on SBCL, +and that you therefore can't portably violate the limitations +but must instead define some encoding of your own and add individual mappings +to name physical pathnames that do not fit the restrictions. +This can notably be a problem when your Lisp files are part of a larger project +in which it is common to name files or directories in a way that +includes the version numbers of supported protocols, +or in which files are shared with software written +in different programming languages where conventions include the use of +underscores, dots or CamelCase in pathnames. + +<h4 class="subsection">5.3.9 Serial dependencies</h4> + +<p><a name="index-serial-dependencies-27"></a> +If the <code>:serial t</code> option is specified for a module, +ASDF will add dependencies for each child component, +on all the children textually preceding it. +This is done as if by <code>:depends-on</code>. + +<pre class="lisp"> :serial t + :components ((:file "a") (:file "b") (:file "c")) +</pre> + <p>is equivalent to + +<pre class="lisp"> :components ((:file "a") + (:file "b" :depends-on ("a")) + (:file "c" :depends-on ("a" "b"))) +</pre> + <h4 class="subsection">5.3.10 Source location</h4> + +<p>The <code>:pathname</code> option is optional in all cases for systems +defined via <code>defsystem</code>, +and in the usual case the user is recommended not to supply it. + + <p>Instead, ASDF follows a hairy set of rules that are designed so that + <ol type=1 start=1> +<li><code>find-system</code> +will load a system from disk +and have its pathname default to the right place. + + <li>This pathname information will not be overwritten with +<code>*default-pathname-defaults*</code> +(which could be somewhere else altogether) +if the user loads up the <samp><span class="file">.asd</span></samp> file into his editor +and interactively re-evaluates that form. + </ol> + + <p>If a system is being loaded for the first time, +its top-level pathname will be set to: + + <ul> +<li>The host/device/directory parts of <code>*load-truename*</code>, +if it is bound. +<li><code>*default-pathname-defaults*</code>, otherwise. +</ul> + + <p>If a system is being redefined, the top-level pathname will be + + <ul> +<li>changed, if explicitly supplied or obtained from <code>*load-truename*</code> +(so that an updated source location is reflected in the system definition) + + <li>changed if it had previously been set from <code>*default-pathname-defaults*</code> + + <li>left as before, if it had previously been set from <code>*load-truename*</code> +and <code>*load-truename*</code> is currently unbound +(so that a developer can evaluate a <code>defsystem</code> form +from within an editor without clobbering its source location) +</ul> + +<h4 class="subsection">5.3.11 if-feature option</h4> + +<p>This option allows you to specify a feature expression to be evaluated +as if by <code>#+</code> to conditionally include a component in your build. +If the expression is false, the component is dropped +as well as any dependency pointing to it. +As compared to using <code>#+</code> which is expanded at read-time, +this allows you to have an object in your component hierarchy +that can be used for manipulations beside building your project. +This option was added in ASDF 3. + +<h4 class="subsection">5.3.12 if-component-dep-fails option</h4> + +<p>This option was removed in ASDF 3. +Its semantics was limited in purpose and dubious to explain, +and its implementation was breaking a hole into the ASDF object model. +Please use the <code>if-feature</code> option instead. + +<p><a name="Other-code-in-.asd-files"></a> +<a name="Other-code-in-_002easd-files"></a> + +<h3 class="section">5.4 Other code in .asd files</h3> + +<p>Files containing <code>defsystem</code> forms +are regular Lisp files that are executed by <code>load</code>. +Consequently, you can put whatever Lisp code you like into these files. +However, it is recommended to keep such forms to a minimal, +and to instead define <code>defsystem</code> extensions +that you use with <code>:defsystem-depends-on</code>. + + <p>If however, you might insist on including code in the <code>.asd</code> file itself, +e.g., to examine and adjust the compile-time environment, +possibly adding appropriate features to <code>*features*</code>. +If so, here are some conventions we recommend you follow, +so that users can control certain details of execution +of the Lisp in <samp><span class="file">.asd</span></samp> files: + + <ul> +<li>Any informative output +(other than warnings and errors, +which are the condition system's to dispose of) +should be sent to the standard CL stream <code>*standard-output*</code>, +so that users can easily control the disposition +of output from ASDF operations. +</ul> + +<p><a name="The-object-model-of-ASDF"></a> + + +<h2 class="chapter">6 The object model of ASDF</h2> + +<p>ASDF is designed in an object-oriented way from the ground up. +Both a system's structure and the operations that can be performed on systems +follow a extensible protocol. + + <p>This allows the addition of behaviours: +for example, <code>cffi</code> adds support of special FFI description files +to interface with C libraries and of wrapper files to embed C code in Lisp; +<code>abcl-jar</code> supports creating Java JAR archives in ABCL; +and <code>poiu</code> supports for compiling code in parallel using background processes. + + <p>This chapter deals with <code>component</code>s and <code>operation</code>s. + + <p>A <code>component</code> represents an individual source file or a group of source files, +and the things that get transformed into. +A <code>system</code> is a component at the top level of the component hierarchy. +A <code>source-file</code> is a component representing a single source-file +and the successive output files into which it is transformed. +A <code>module</code> is an intermediate component itself grouping several other components, +themselves source-files or further modules. + + <p>An <code>Operation</code> represents a transformation that can be performed on a component, +turning them from source files to intermediate results to final outputs. + + <p>A pair of an <code>operation</code> and a <code>component</code> is called an <code>action</code>. +An <code>action</code> represents a particular build step to be <code>perform</code>ed, +after all its dependencies have been fulfilled. +In the ASDF model, actions depend on other actions. +The term <em>action</em> itself was used by Kent Pitman in his old article, +but was only used by ASDF hackers starting with the ASDF 2; +but the concept is ubiquitous since the very beginning of ASDF 1, +though previously implicit. + + <p>Then, there are many <em>functions</em> available +to users, extenders and implementers of ASDF +to use, define or implement the activities +that are part of building your software. +Though they manipulate <code>action</code>s, +most of these functions do not take as an argument +a reified pair (a <code>cons</code> cell) of an operation and a component; +instead, they usually take two separate arguments, +which allows to take advantage of the power CLOS-style multiple dispatch +for fun and profit. + + <p>There are many <em>hooks</em> in which to add functionality, +by customizing the behavior of existing <em>functions</em>. + + <p>Last but not least is the notion of <em>dependency</em> between two actions. +The structure of dependencies between actions is +a directed <em>dependency graph</em>. +ASDF is invoked by being told to <em>operate</em> +with some <em>operation</em> on some toplevel <em>system</em>; +it will then <em>traverse</em> the graph and build a <em>plan</em> +that follows its structure. +To be successfully buildable, this graph of actions but be acyclic. +If, as a user, extender or implementer of ASDF, you fail +to keep the dependency graph without cycles, +ASDF will fail loudly as it eventually finds one. +To clearly distinguish the direction of dependencies, +ASDF 3 uses the words <em>requiring</em> and <em>required</em> +as applied to an action depending on the other: +the requiring action <code>depends-on</code> the completion of all required actions +before it may itself be <code>perform</code>ed. + + <p>Using the <code>defsystem</code> syntax, users may easily express +direct dependencies along the graph of the object hierarchy: +between a component and its parent, its children, and its siblings. +By defining custom CLOS methods, you can express more elaborate dependencies as you wish. +Most common operations, such as <code>load-op</code>, <code>compile-op</code> or <code>load-source-op</code> +are automatically propagate “downward” the component hierarchy and are “covariant” with it: +to act the operation on the parent module, you must first act it on all the children components, +with the action on the parent being parent of the action on each child. +Other operations, such as <code>prepare-op</code> and <code>prepare-source-op</code> +(introduced in ASDF 3) are automatically propagated “upward” the component hierarchy +and are “contravariant” with it: +to perform the operation of preparing for compilation of a child component, +you must perform the operation of preparing for compilation of its parent component, and so on, +ensuring that all the parent's dependencies are (compiled and) loaded +before the child component may be compiled and loaded. +Yet other operations, such as <code>test-op</code> or <code>load-fasl-op</code> +remain at the system level, and are not propagated along the hierarchy, +but instead do something global on the system. + +<p><a name="Operations"></a> + + +<h3 class="section">6.1 Operations</h3> + +<p><a name="index-operation-28"></a> +An <dfn>operation</dfn> object of the appropriate type is instantiated +whenever the user wants to do something with a system like + + <ul> +<li>compile all its files +<li>load the files into a running lisp environment +<li>copy its source files somewhere else +</ul> + + <p>Operations can be invoked directly, or examined +to see what their effects would be without performing them. +There are a bunch of methods specialised on operation and component type +that actually do the grunt work. + + <p>The operation object contains whatever state is relevant for this purpose +(perhaps a list of visited nodes, for example) +but primarily is a nice thing to specialise operation methods on +and easier than having them all be <code>EQL</code> methods. + + <p>Operations are invoked on systems via <code>operate</code>. +<a name="operate"></a> + +<div class="defun"> +— Generic function: <code>operate</code><var> operation system &rest initargs &key </var><code>force</code> <code>force-not</code> <code>verbose</code><var> &allow-other-keys<a name="index-g_t_0040code_007boperate_007d-29"></a></var><br> +— Generic function: <code>oos</code><var> operation system &rest initargs &key &allow-other-keys<a name="index-g_t_0040code_007boos_007d-30"></a></var><br> +<blockquote><p><code>operate</code> invokes <var>operation</var> on <var>system</var>. +<code>oos</code> is a synonym for <code>operate</code>. + + <p><var>operation</var> is a symbol that is passed, along with the supplied +<var>initargs</var>, to <code>make-instance</code> to create the operation object. +<var>system</var> is a system designator. + + <p>The <var>initargs</var> are passed to the <code>make-instance</code> call +when creating the operation object. +Note that dependencies may cause the operation +to invoke other operations on the system or its components: +the new operations will be created +with the same <var>initargs</var> as the original one. + + <p>If <var>force</var> is <code>:all</code>, then all systems +are forced to be recompiled even if not modified since last compilation. +If <var>force</var> is <code>t</code>, then only the system being loaded +is forced to be recompiled even if not modified since last compilation, +but other systems are not affected. +If <var>force</var> is a list, then it specifies a list of systems that +are forced to be recompiled even if not modified since last compilation. +If <var>force-not</var> is <code>:all</code>, then all systems +are forced not to be recompiled even if modified since last compilation. +If <var>force-not</var> is <code>t</code>, then only the system being loaded +is forced not to be recompiled even if modified since last compilation, +but other systems are not affected. +If <var>force-not</var> is a list, then it specifies a list of systems that +are forced not to be recompiled even if modified since last compilation. +<var>force</var> takes precedences over <var>force-not</var>; +both of them apply to systems that are dependencies and were already compiled. + + <p>To see what <code>operate</code> would do, you can use: + <pre class="example"> (asdf:traverse operation-class system-name) +</pre> + </blockquote></div> + +<p><a name="Predefined-operations-of-ASDF"></a> + + +<h4 class="subsection">6.1.1 Predefined operations of ASDF</h4> + +<p>All the operations described in this section are in the <code>asdf</code> package. +They are invoked via the <code>operate</code> generic function. + +<pre class="lisp"> (asdf:operate 'asdf:<var>operation-name</var> :<var>system-name</var> {<var>operation-options ...</var>}) +</pre> + <div class="defun"> +— Operation: <code>compile-op</code><var><a name="index-g_t_0040code_007bcompile_002dop_007d-31"></a></var><br> +<blockquote> + <p>This operation compiles the specified component. +A <code>cl-source-file</code> will be <code>compile-file</code>'d. +All the children and dependencies of a system or module +will be recursively compiled by <code>compile-op</code>. + + <p><code>compile-op</code> depends on <code>prepare-op</code> which +itself depends on a <code>load-op</code> of all of a component's dependencies, +as well as of its parent's dependencies. +When <code>operate</code> is called on <code>compile-op</code>, +all these dependencies will be loaded as well as compiled; +yet, some parts of the system main remain unloaded, +because nothing depends on them. +Use <code>load-op</code> to load a system. +</p></blockquote></div> + +<div class="defun"> +— Operation: <code>load-op</code><var><a name="index-g_t_0040code_007bload_002dop_007d-32"></a></var><br> +<blockquote> + <p>This operation loads the compiled code for a specified component. +A <code>cl-source-file</code> will have its compiled fasl <code>load</code>ed, +which fasl is the output of <code>compile-op</code> that <code>load-op</code> depends on. +All the children and dependencies of a system or module +will be recursively loaded by <code>load-op</code>. + + <p><code>load-op</code> depends on <code>prepare-op</code> which +itself depends on a <code>load-op</code> of all of a component's dependencies, +as well as of its parent's dependencies. +</p></blockquote></div> + +<div class="defun"> +— Operation: <code>prepare-op</code><var><a name="index-g_t_0040code_007bprepare_002dop_007d-33"></a></var><br> +<blockquote> + <p>This operation ensures that the dependencies of a component +and its recursive parents are loaded (as per <code>load-op</code>), +as a prerequisite before <code>compile-op</code> and <code>load-op</code> operations +may be performed on a given component. +</p></blockquote></div> + +<div class="defun"> +— Operation: <code>load-source-op</code><var>, </var><code>prepare-source-op</code><var><a name="index-g_t_0040code_007bload_002dsource_002dop_007d-34"></a></var><br> +<blockquote> + <p><code>load-source-op</code> will load the source for the files in a module +rather than they compiled fasl output. +It has a <code>prepare-source-op</code> analog to <code>prepare-op</code>, +that ensures the dependencies are themselves loaded via <code>load-source-op</code>. + + <p>There is no provision in ASDF for ensuring that +some components are always loaded as source, while others are always compiled. +While this idea often comes up in discussions, +it actually doesn't play well with either the linking model of ECL +or with various bundle operations (see below), and is eventually not workable; +also the dependency model of ASDF would have to be modified incompatibly +to allow for such trick. +If your code doesn't compile cleanly, fix it. +If compilation makes it slow, use <code>declaim</code> or <code>eval-when</code> +to adjust your compiler settings, +or eschew compilation by <code>eval</code>uating a quoted source form at load-time. +</p></blockquote></div> + + <p><a name="test_002dop"></a> + +<div class="defun"> +— Operation: <code>test-op</code><var><a name="index-g_t_0040code_007btest_002dop_007d-35"></a></var><br> +<blockquote> + <p>This operation will perform some tests on the module. +The default method will do nothing. +The default dependency is to require +<code>load-op</code> to be performed on the module first. +The default <code>operation-done-p</code> is that the operation is <em>never</em> done +— +we assume that if you invoke the <code>test-op</code>, +you want to test the system, even if you have already done so. + + <p>The results of this operation are not defined by ASDF. +It has proven difficult to define how the test operation +should signal its results to the user +in a way that is compatible with all of the various test libraries +and test techniques in use in the community. + + <p>People typically define <code>test-op</code> methods like thus: + <pre class="example"> (defmethod perform ((o asdf:test-op) + (s (eql (asdf:find-system <var>:my-system</var>)))) + (asdf:load-system <var>:my-system-test</var>) + (funcall (read-from-string "my-system-test:test-suite"))) +</pre> + <p>Using <code>load-system</code> in the perform method +rather than an <code>:in-order-to</code> dependency, +is sometimes necessary for backward compatibility with ASDF 2 and older, +to avoid circular dependencies that could arise +because of the way these old versions propagate dependencies. + + <p>If you don't care for compatibility with ASDF 2, +you could use the following options in your <code>defsystem</code> form: + <pre class="example"> :in-order-to ((test-op (load-op :my-system-test))) + :perform (test-op (o c) (symbol-call :my-system-test :test-suite)) +</pre> + </blockquote></div> + +<div class="defun"> +— Operation: <code>fasl-op</code><var>, </var><code>monolithic-fasl-op</code><var>, </var><code>load-fasl-op</code><var>, </var><code>binary-op</code><var>, </var><code>monolithic-binary-op</code><var>, </var><code>lib-op</code><var>, </var><code>monolithic-lib-op</code><var>, </var><code>dll-op</code><var>, </var><code>monolithic-dll-op</code><var>, </var><code>program-op</code><var><a name="index-g_t_0040code_007bfasl_002dop_007d-36"></a></var><br> +<blockquote> + <p>These are “bundle” operations, that can create a single-file “bundle” +for all the contents of each system in an application, +or for the entire application. + + <p><code>fasl-op</code> will create a single fasl file for each of the systems needed, +grouping all its many fasls in one, +so you can deliver each system as a single fasl. +<code>monolithic-fasl-op</code> will create a single fasl file for target system +and all its dependencies, +so you can deliver your entire application as a single fasl. +<code>load-fasl-op</code> will load the output of <code>fasl-op</code> +(though if it the output is not up-to-date, +it will load the intermediate fasls indeed as part of building it); +this matters a lot on ECL, where the dynamic linking involved in loading +tens of individual fasls can be noticeably more expensive +than loading a single one. + + <p>Once you have created a fasl with <code>fasl-op</code>, +you can use <code>precompiled-system</code> to deliver it in a way +that is compatible with clients having dependencies on your system, +whether it is distributed as source or as a single binary; +the <samp><span class="file">.asd</span></samp> file to be delivered with the fasl will look like this: + <pre class="example"> (defsystem :mysystem :class :precompiled-system + :fasl (some expression that will evaluate to a pathname)) +</pre> + <p>Or you can use <code>binary-op</code> to let ASDF create such a system for you +as well as the <code>fasl-op</code> output, or <code>monolithic-binary-op</code>. +This allows you to deliver code for your systems or applications +as a single file. +Of course, if you want to test the result in the current image, +<em>before</em> you try to use any newly created <samp><span class="file">.asd</span></samp> files, +you should not forget to <code>(asdf:clear-configuration)</code> +or at least <code>(asdf:clear-source-registry)</code>, +so it re-populates the source-registry from the filesystem. + + <p>The <code>program-op</code> operation will create an executable program +from the specified system and its dependencies. +You can use UIOP for its pre-image-dump hooks, its post-image-restore hooks, +and its access to command-line arguments. +And you can specify an entry point <code>my-app:main</code> +by specifying in your <code>defsystem</code> +the option <code>:entry-point "my-app:main"</code>. +Depending on your implementation, +running <code>(asdf:operate 'asdf:program-op :my-app)</code> +may quit the current Lisp image upon completion. +See the example in +<samp><span class="file">test/hello-world-example.asd</span></samp> and <samp><span class="file">test/hello.lisp</span></samp>, +as built and tested by +<samp><span class="file">test/test-program.script</span></samp> and <samp><span class="file">test/make-hello-world.lisp</span></samp>. + + <p>There is also <code>lib-op</code> +for building a linkable <samp><span class="file">.a</span></samp> file (Windows: <samp><span class="file">.lib</span></samp>) +from all linkable object dependencies (FFI files, and on ECL, Lisp files too), +and its monolithic equivalent <code>monolithic-lib-op</code>. +And there is also <code>dll-op</code> +(respectively its monolithic equivalent <code>monolithic-lib-op</code>) +for building a linkable <samp><span class="file">.so</span></samp> file +(Windows: <samp><span class="file">.dll</span></samp>, MacOS X: <samp><span class="file">.dynlib</span></samp>) +to create a single dynamic library +for all the extra FFI code to be linked into each of your systems +(respectively your entire application). + + <p>All these “bundle” operations are available since ASDF 3 +on all actively supported Lisp implementations, +but may be unavailable on unmaintained legacy implementations. +This functionality was previously available for select implementations, +as part of a separate system <code>asdf-bundle</code>, +itself descended from the ECL-only <code>asdf-ecl</code>. + + <p>The pathname of the output of bundle operations +is subject to output-translation as usual, +unless the operation is equal to +the <code>:build-operation</code> argument to <code>defsystem</code>. +This behavior is not very satisfactory and may change in the future. +Maybe you have suggestions on how to better configure it? +</p></blockquote></div> + +<div class="defun"> +— Operation: <code>concatenate-source-op</code><var>, </var><code>monolithic-concatenate-source-op</code><var>, </var><code>load-concatenated-source-op</code><var>, </var><code>compile-concatenated-source-op</code><var>, </var><code>load-compiled-concatenated-source-op</code><var>, </var><code>monolithic-load-concatenated-source-op</code><var>, </var><code>monolithic-compile-concatenated-source-op</code><var>, </var><code>monolithic-load-compiled-concatenated-source-op</code><var><a name="index-g_t_0040code_007bconcatenate_002dsource_002dop_007d-37"></a></var><br> +<blockquote> + <p>These operation, as their respective names indicate, +consist in concatenating all <code>cl-source-file</code> source files in a system +(or in a system and all its dependencies, if monolithic), +in the order defined by dependencies, +then loading the result, or compiling then loading the result. + + <p>These operations are useful to deliver a system or application +as a single source file, +and for testing that said file loads properly, or compiles then loads properly. + + <p>ASDF itself is notably delivered as a single source file this way +using <code>monolithic-concatenate-source-op</code>, +transcluding a prelude and the <code>uiop</code> library +before the <code>asdf/defsystem</code> system itself. +</p></blockquote></div> + +<p><a name="Creating-new-operations"></a> + + +<h4 class="subsection">6.1.2 Creating new operations</h4> + +<p>ASDF was designed to be extensible in an object-oriented fashion. +To teach ASDF new tricks, a programmer can implement the behaviour he wants +by creating a subclass of <code>operation</code>. + + <p>ASDF's pre-defined operations are in no way “privileged”, +but it is requested that developers never use the <code>asdf</code> package +for operations they develop themselves. +The rationale for this rule is that we don't want to establish a +“global asdf operation name registry”, +but also want to avoid name clashes. + + <p>Your operation <em>must</em> usually provide methods +for one or more of the following generic functions: + + <ul> +<li><code>perform</code> +Unless your operation, like <code>prepare-op</code>, +is for dependency propagation only, +the most important function for which to define a method +is usually <code>perform</code>, +which will be called to perform the operation on a specified component, +after all dependencies have been performed. + + <p>The <code>perform</code> method must call <code>output-files</code> (see below) +to find out where to put its files, +because the user is allowed to override the method +or tweak the output-translation mechanism. +Perform should only use the primary value returned by <code>output-files</code>. +If one and only one output file is expected, +it can call <code>output-file</code> that checks that this is the case +and returns the first and only list element. + + <li><code>output-files</code> +If your perform method has any output, +you must define a method for this function. +for ASDF to determine where the outputs of performing operation lie. + + <p>Your method may return two values, a list of pathnames, and a boolean. +If the boolean is <code>nil</code> (or you fail to return multiple values), +then enclosing <code>:around</code> methods may translate these pathnames, +e.g. to ensure object files are somehow stored +in some implementation-dependent cache. +If the boolean is <code>t</code> then the pathnames are marked +not be translated by the enclosing <code>:around</code> method. + + <li><code>component-depends-on</code> +If the action of performing the operation on a component has dependencies, +you must define a method on <code>component-depends-on</code>. + + <p>Your method will take as specialized arguments +an operation and a component which together identify an action, +and return a list of entries describing actions that this action depends on. +The format of entries is described below. + + <p>It is <em>strongly</em> advised that +you should always append the results of <code>(call-next-method)</code> +to the results of your method, +or “interesting” failures will likely occur, +unless you're a true specialist of ASDF internals. +It is unhappily too late to compatibly use the <code>append</code> method combination, +but conceptually that's the protocol that is being manually implemented. + + <p>Each entry returned by <code>component-depends-on</code> is itself a list. + + <p>The first element of an entry is an operation designator: +either an operation object designating itself, or +a symbol that names an operation class +(that ASDF will instantiate using <code>make-operation</code>). +For instance, <code>load-op</code>, <code>compile-op</code> and <code>prepare-op</code> +are common such names, denoting the respective operations. + + <p>The rest of each entry is a list of component designators: +either a component object designating itself, +or an identifier to be used with <code>find-component</code>. +<code>find-component</code> will be called with the current component's parent as parent, +and the identifier as second argument. +The identifier is typically a string, +a symbol (to be downcased as per <code>coerce-name</code>), +or a list of strings or symbols. +In particular, the empty list <code>nil</code> denotes the parent itself. + + </ul> + + <p>An operation <em>may</em> provide methods for the following generic functions: + + <ul> +<li><code>input-files</code> +A method for this function is often not needed, +since ASDF has a pretty clever default <code>input-files</code> mechanism. +You only need create a method if there are multiple ultimate input files, +and/or the bottom one doesn't depend +on the <code>component-pathname</code> of the component. + + <li><code>operation-done-p</code> +You only need to define a method on that function +if you can detect conditions that invalidate previous runs of the operation, +even though no filesystem timestamp has changed, +in which case you return <code>nil</code> (the default is <code>t</code>). + + <p>For instance, the method for <code>test-op</code> always returns <code>nil</code>, +so that tests are always run afresh. +Of course, the <code>test-op</code> for your system could depend +on a deterministically repeatable <code>test-report-op</code>, +and just read the results from the report files, +in which case you could have this method return <code>t</code>. + + </ul> + + <p>Operations that print output should send that output to the standard +CL stream <code>*standard-output*</code>, as the Lisp compiler and loader do. + +<p><a name="Components"></a> + + +<h3 class="section">6.2 Components</h3> + +<p><a name="index-component-38"></a><a name="index-system-39"></a><a name="index-system-designator-40"></a><a name="index-component-designator-41"></a><a name="index-g_t_002asystem_002ddefinition_002dsearch_002dfunctions_002a-42"></a> +A <dfn>component</dfn> represents a source file or +(recursively) a collection of components. +A <dfn>system</dfn> is (roughly speaking) a top-level component +that can be found via <code>find-system</code>. + + <p>A <dfn>system designator</dfn> is a system itself, +or a string or symbol that behaves just like any other component name +(including with regard to the case conversion rules for component names). + + <p>A <dfn>component designator</dfn>, relative to a base component, +is either a component itself, +or a string or symbol, +or a list of designators. + +<div class="defun"> +— Function: <b>find-system</b><var> system-designator &optional </var>(<var>error-p t</var>)<var><a name="index-find_002dsystem-43"></a></var><br> +<blockquote> + <p>Given a system designator, <code>find-system</code> finds and returns a system. +If no system is found, an error of type +<code>missing-component</code> is thrown, +or <code>nil</code> is returned if <code>error-p</code> is false. + + <p>To find and update systems, <code>find-system</code> funcalls each element +in the <code>*system-definition-search-functions*</code> list, +expecting a pathname to be returned, or a system object, +from which a pathname may be extracted, and that will be registered. +The resulting pathname (if any) is loaded +if one of the following conditions is true: + + <ul> +<li>there is no system of that name in memory +<li>the pathname is different from that which was previously loaded +<li>the file's <code>last-modified</code> time exceeds the <code>last-modified</code> time +of the system in memory +</ul> + + <p>When system definitions are loaded from <samp><span class="file">.asd</span></samp> files, +a new scratch package is created for them to load into, +so that different systems do not overwrite each others operations. +The user may also wish to (and is recommended to) +include <code>defpackage</code> and <code>in-package</code> forms +in his system definition files, however, +so that they can be loaded manually if need be. + + <p>The default value of <code>*system-definition-search-functions*</code> +is a list of two functions. +The first function looks in each of the directories given +by evaluating members of <code>*central-registry*</code> +for a file whose name is the name of the system and whose type is <samp><span class="file">asd</span></samp>. +The first such file is returned, +whether or not it turns out to actually define the appropriate system. +The second function does something similar, +for the directories specified in the <code>source-registry</code>. +Hence, it is strongly advised to define a system +<var>foo</var> in the corresponding file <var>foo.asd</var>. +</p></blockquote></div> + +<div class="defun"> +— Function: <b>find-component</b><var> base path<a name="index-find_002dcomponent-44"></a></var><br> +<blockquote> + <p>Given a <var>base</var> component (or designator for such), +and a <var>path</var>, find the component designated by the <var>path</var> +starting from the <var>base</var>. + + <p>If <var>path</var> is a component object, it designates itself, +independently from the base. + + <p>If <var>path</var> is a string, or symbol denoting a string via <code>coerce-name</code>, +then <var>base</var> is resolved to a component object, +which must be a system or module, +and the designated component is the child named by the <var>path</var>. + + <p>If <var>path</var> is a <code>cons</code> cell, +<code>find-component</code> with the base and the <code>car</code> of the <var>path</var>, +and the resulting object is used as the base for a tail call +to <code>find-component</code> with the <code>car</code> of the <var>path</var>. + + <p>If <var>base</var> is a component object, it designates itself. + + <p>If <var>base</var> is null, then <var>path</var> is used as the base, with <code>nil</code> as the path. + + <p>If <var>base</var> is a string, or symbol denoting a string via <code>coerce-name</code>, +it designates a system as per <code>find-system</code>. + + <p>If <var>base</var> is a <code>cons</code> cell, it designates the component found by +<code>find-component</code> with its <code>car</code> as base and <code>cdr</code> as path. +</p></blockquote></div> + +<p><a name="Common-attributes-of-components"></a> + + +<h4 class="subsection">6.2.1 Common attributes of components</h4> + +<p>All components, regardless of type, have the following attributes. +All attributes except <code>name</code> are optional. + +<h5 class="subsubsection">6.2.1.1 Name</h5> + +<p>A component name is a string or a symbol. +If a symbol, its name is taken and lowercased. + + <p>Unless overridden by a <code>:pathname</code> attribute, +the name will be interpreted as a pathname specifier according +to a Unix-style syntax. +See <a href="#The-defsystem-grammar">Pathname specifiers</a>. + +<h5 class="subsubsection">6.2.1.2 Version identifier</h5> + +<p><a name="index-version_002dsatisfies-45"></a><a name="index-g_t_003aversion-46"></a> +This optional attribute specifies a version for the current component. +The version should typically be a string of integers separated by dots, +for example ‘<samp><span class="samp">1.0.11</span></samp>’. +For more information on version specifiers, see <a href="#The-defsystem-grammar">The defsystem grammar</a>. + + <p>A version may then be queried by the generic function <code>version-satisfies</code>, +to see if <code>:version</code> dependencies are satisfied, +and when specifying dependencies, a constraint of minimal version to satisfy +can be specified using e.g. <code>(:version "mydepname" "1.0.11")</code>. + + <p>Note that in the wild, we typically see version numbering +only on components of type <code>system</code>. +Presumably it is much less useful within a given system, +wherein the library author is responsible to keep the various files in synch. + +<h5 class="subsubsection">6.2.1.3 Required features</h5> + +<p>Traditionally defsystem users have used <code>#+</code> reader conditionals +to include or exclude specific per-implementation files. +This means that any single implementation cannot read the entire system, +which becomes a problem if it doesn't wish to compile it, +but instead for example to create an archive file containing all the sources, +as it will omit to process the system-dependent sources for other systems. + + <p>Each component in an asdf system may therefore specify using <code>:if-feature</code> +a feature expression using the same syntax as <code>#+</code> does, +such that any reference to the component will be ignored +during compilation, loading and/or linking if the expression evaluates to false. +Since the expression is read by the normal reader, +you must explicitly prefix your symbols with <code>:</code> so they be read as keywords; +this is as contrasted with the <code>#+</code> syntax +that implicitly reads symbols in the keyword package by default. + + <p>For instance, <code>:if-feature (:and :x86 (:or :sbcl :cmu :scl))</code> specifies that +the given component is only to be compiled and loaded +when the implementation is SBCL, CMUCL or Scieneer CL on an x86 machine. +You can not write it as <code>:if-feature (and x86 (or sbcl cmu scl))</code> +since the symbols would presumably fail to be read as keywords. + +<h5 class="subsubsection">6.2.1.4 Dependencies</h5> + +<p>This attribute specifies dependencies of the component on its siblings. +It is optional but often necessary. + + <p>There is an excitingly complicated relationship between the initarg +and the method that you use to ask about dependencies + + <p>Dependencies are between (operation component) pairs. +In your initargs for the component, you can say + +<pre class="lisp"> :in-order-to ((compile-op (load-op "a" "b") (compile-op "c")) + (load-op (load-op "foo"))) +</pre> + <p>This means the following things: + <ul> +<li>before performing compile-op on this component, we must perform +load-op on <var>a</var> and <var>b</var>, and compile-op on <var>c</var>, +<li>before performing <code>load-op</code>, we have to load <var>foo</var> +</ul> + + <p>The syntax is approximately + +<pre class="verbatim">(this-op @{(other-op required-components)@}+) + +simple-component-name := string + | symbol + +required-components := simple-component-name + | (required-components required-components) + +component-name := simple-component-name + | (:version simple-component-name minimum-version-object) +</pre> + + <p>Side note: + + <p>This is on a par with what ACL defsystem does. +mk-defsystem is less general: it has an implied dependency + +<pre class="verbatim"> for all source file x, (load x) depends on (compile x) +</pre> + + <p>and using a <code>:depends-on</code> argument to say that <var>b</var> depends on +<var>a</var> <em>actually</em> means that + +<pre class="verbatim"> (compile b) depends on (load a) +</pre> + + <p>This is insufficient for e.g. the McCLIM system, which requires that +all the files are loaded before any of them can be compiled ] + + <p>End side note + + <p>In ASDF, the dependency information for a given component and operation +can be queried using <code>(component-depends-on operation component)</code>, +which returns a list + +<pre class="lisp"> ((load-op "a") (load-op "b") (compile-op "c") ...) +</pre> + <p><code>component-depends-on</code> can be subclassed for more specific +component/operation types: these need to <code>(call-next-method)</code> +and append the answer to their dependency, unless +they have a good reason for completely overriding the default dependencies. + + <p>If it weren't for CLISP, we'd be using <code>LIST</code> method +combination to do this transparently. +But, we need to support CLISP. +If you have the time for some CLISP hacking, +I'm sure they'd welcome your fixes. + + + <p>A minimal version can be specified for a component you depend on +(typically another system), by specifying <code>(:version "other-system" "1.2.3")</code> +instead of simply <code>"other-system"</code> as the dependency. +See the discussion of the semantics of <code>:version</code> +in the defsystem grammar. + + + + +<h5 class="subsubsection">6.2.1.5 pathname</h5> + +<p>This attribute is optional and if absent (which is the usual case), +the component name will be used. + + <p>See <a href="#The-defsystem-grammar">Pathname specifiers</a>, +for an explanation of how this attribute is interpreted. + + <p>Note that the <code>defsystem</code> macro (used to create a “top-level” system) +does additional processing to set the filesystem location of +the top component in that system. +This is detailed elsewhere. See <a href="#Defining-systems-with-defsystem">Defining systems with defsystem</a>. + +<h5 class="subsubsection">6.2.1.6 properties</h5> + +<p>This attribute is optional. + + <p>Packaging systems often require information about files or systems +in addition to that specified by ASDF's pre-defined component attributes. +Programs that create vendor packages out of ASDF systems therefore +have to create “placeholder” information to satisfy these systems. +Sometimes the creator of an ASDF system may know the additional +information and wish to provide it directly. + + <p><code>(component-property component property-name)</code> and +associated <code>setf</code> method will allow +the programmatic update of this information. +Property names are compared as if by <code>EQL</code>, +so use symbols or keywords or something. + +<p><a name="Pre-defined-subclasses-of-component"></a> +<a name="Pre_002ddefined-subclasses-of-component"></a> + + +<h4 class="subsection">6.2.2 Pre-defined subclasses of component</h4> + +<div class="defun"> +— Component: <b>source-file</b><var><a name="index-source_002dfile-47"></a></var><br> +<blockquote> + <p>A source file is any file that the system does not know how to +generate from other components of the system. + + <p>Note that this is not necessarily the same thing as +“a file containing data that is typically fed to a compiler”. +If a file is generated by some pre-processor stage +(e.g. a <samp><span class="file">.h</span></samp> file from <samp><span class="file">.h.in</span></samp> by autoconf) +then it is not, by this definition, a source file. +Conversely, we might have a graphic file +that cannot be automatically regenerated, +or a proprietary shared library that we received as a binary: +these do count as source files for our purposes. + + <p>Subclasses of source-file exist for various languages. +<em>FIXME: describe these.</em> +</p></blockquote></div> + +<div class="defun"> +— Component: <b>module</b><var><a name="index-module-48"></a></var><br> +<blockquote> + <p>A module is a collection of sub-components. + + <p>A module component has the following extra initargs: + + <ul> +<li><code>:components</code> the components contained in this module + + <li><code>:default-component-class</code> +All children components which don't specify their class explicitly +are inferred to be of this type. + + <li><code>:if-component-dep-fails</code> +This attribute was removed in ASDF 3. Do not use it. +Use <code>:if-feature</code> instead. + + <li><code>:serial</code> When this attribute is set, +each subcomponent of this component is assumed to depend on all subcomponents +before it in the list given to <code>:components</code>, i.e. +all of them are loaded before a compile or load operation is performed on it. + + </ul> + + <p>The default operation knows how to traverse a module, so +most operations will not need to provide methods specialised on modules. + + <p><code>module</code> may be subclassed to represent components such as +foreign-language linked libraries or archive files. +</p></blockquote></div> + +<div class="defun"> +— Component: <b>system</b><var><a name="index-system-49"></a></var><br> +<blockquote> + <p><code>system</code> is a subclass of <code>module</code>. + + <p>A system is a module with a few extra attributes for documentation +purposes; these are given elsewhere. +See <a href="#The-defsystem-grammar">The defsystem grammar</a>. + + <p>Users can create new classes for their systems: +the default <code>defsystem</code> macro takes a <code>:class</code> keyword argument. +</p></blockquote></div> + +<p><a name="Creating-new-component-types"></a> + + +<h4 class="subsection">6.2.3 Creating new component types</h4> + +<p>New component types are defined by subclassing one of the existing +component classes and specializing methods on the new component class. + + <p><em>FIXME: this should perhaps be explained more throughly, +not only by example ...</em> + + <p>As an example, suppose we have some implementation-dependent +functionality that we want to isolate +in one subdirectory per Lisp implementation our system supports. +We create a subclass of +<code>cl-source-file</code>: + +<pre class="lisp"> (defclass unportable-cl-source-file (cl-source-file) + ()) +</pre> + <p>Function <code>asdf:implementation-type</code> (exported since 2.014.14) +gives us the name of the subdirectory. +All that's left is to define how to calculate the pathname +of an <code>unportable-cl-source-file</code>. + +<pre class="lisp"> (defmethod component-pathname ((component unportable-cl-source-file)) + (merge-pathnames* + (parse-unix-namestring (format nil "~(~A~)/" (asdf:implementation-type))) + (call-next-method))) +</pre> + <p>The new component type is used in a <code>defsystem</code> form in this way: + +<pre class="lisp"> (defsystem :foo + :components + ((:file "packages") + ... + (:unportable-cl-source-file "threads" + :depends-on ("packages" ...)) + ... + ) +</pre> + <p><a name="Functions"></a> + + +<h3 class="section">6.3 Functions</h3> + +<p><a name="index-version_002dsatisfies-50"></a> + +<div class="defun"> +— version-satisfies: <var>version</var><var> version-spec<a name="index-g_t_0040var_007bversion_007d-51"></a></var><br> +<blockquote><p>Does <var>version</var> satisfy the <var>version-spec</var>. A generic function. +ASDF provides built-in methods for <var>version</var> being a <code>component</code> or <code>string</code>. +<var>version-spec</var> should be a string. +If it's a component, its version is extracted as a string before further processing. + + <p>A version string satisfies the version-spec if after parsing, +the former is no older than the latter. +Therefore <code>"1.9.1"</code>, <code>"1.9.2"</code> and <code>"1.10"</code> all satisfy <code>"1.9.1"</code>, +but <code>"1.8.4"</code> or <code>"1.9"</code> do not. +For more information about how <code>version-satisfies</code> parses and interprets +version strings and specifications, +see <a href="#The-defsystem-grammar">The defsystem grammar</a> (version specifiers) and +<a href="#Common-attributes-of-components">Common attributes of components</a>. + + <p>Note that in versions of ASDF prior to 3.0.1, +including the entire ASDF 1 and ASDF 2 series, +<code>version-satisfies</code> would also require that the version and the version-spec +have the same major version number (the first integer in the list); +if the major version differed, the version would be considered as not matching the spec. +But that feature was not documented, therefore presumably not relied upon, +whereas it was a nuisance to several users. +Starting with ASDF 3.0.1, +<code>version-satisfies</code> does not treat the major version number specially, +and returns T simply if the first argument designates a version that isn't older +than the one specified as a second argument. +If needs be, the <code>(:version ...)</code> syntax for specifying dependencies +could be in the future extended to specify an exclusive upper bound for compatible versions +as well as an inclusive lower bound. +</p></blockquote></div> + +<p><a name="Controlling-where-ASDF-searches-for-systems"></a> + + +<h2 class="chapter">7 Controlling where ASDF searches for systems</h2> + +<h3 class="section">7.1 Configurations</h3> + +<p>Configurations specify paths where to find system files. + + <ol type=1 start=1> + + <li>The search registry may use some hardcoded wrapping registry specification. +This allows some implementations (notably SBCL) to specify where to find +some special implementation-provided systems that +need to precisely match the version of the implementation itself. + + <li>An application may explicitly initialize the source-registry configuration +using the configuration API +(see <a href="#Controlling-where-ASDF-searches-for-systems">Configuration API</a>, below) +in which case this takes precedence. +It may itself compute this configuration from the command-line, +from a script, from its own configuration file, etc. + + <li>The source registry will be configured from +the environment variable <code>CL_SOURCE_REGISTRY</code> if it exists. + + <li>The source registry will be configured from +user configuration file +<samp><span class="file">$XDG_CONFIG_DIRS/common-lisp/source-registry.conf</span></samp> +(which defaults to +<samp><span class="file">~/.config/common-lisp/source-registry.conf</span></samp>) +if it exists. + + <li>The source registry will be configured from +user configuration directory +<samp><span class="file">$XDG_CONFIG_DIRS/common-lisp/source-registry.conf.d/</span></samp> +(which defaults to +<samp><span class="file">~/.config/common-lisp/source-registry.conf.d/</span></samp>) +if it exists. + + <li>The source registry will be configured from +system configuration file +<samp><span class="file">/etc/common-lisp/source-registry.conf</span></samp> +if it exists/ + + <li>The source registry will be configured from +system configuration directory +<samp><span class="file">/etc/common-lisp/source-registry.conf.d/</span></samp> +if it exists. + + <li>The source registry will be configured from a default configuration. +This configuration may allow for implementation-specific systems +to be found, for systems to be found the current directory +(at the time that the configuration is initialized) as well as +<code>:directory</code> entries for <samp><span class="file">$XDG_DATA_DIRS/common-lisp/systems/</span></samp> and +<code>:tree</code> entries for <samp><span class="file">$XDG_DATA_DIRS/common-lisp/source/</span></samp>. +For instance, SBCL will include directories for its contribs +when it can find them; it will look for them where SBCL was installed, +or at the location specified by the <code>SBCL_HOME</code> environment variable. + + </ol> + + <p>Each of these configurations is specified as an s-expression +in a trivial domain-specific language (defined below). +Additionally, a more shell-friendly syntax is available +for the environment variable (defined yet below). + + <p>Each of these configurations is only used if the previous +configuration explicitly or implicitly specifies that it +includes its inherited configuration. + + <p>Additionally, some implementation-specific directories +may be automatically prepended to whatever directories are specified +in configuration files, no matter if the last one inherits or not. + +<h3 class="section">7.2 Truenames and other dangers</h3> + +<p>One great innovation of the original ASDF was its ability to leverage +<code>CL:TRUENAME</code> to locate where your source code was and where to build it, +allowing for symlink farms as a simple but effective configuration mechanism +that is easy to control programmatically. +ASDF 3 still supports this configuration style, and it is enabled by default; +however we recommend you instead use +our source-registry configuration mechanism described below, +because it is easier to setup in a portable way across users and implementations. + + <p>Addtionally, some people dislike truename, +either because it is very slow on their system, or +because they are using content-addressed storage where the truename of a file +is related to a digest of its individual contents, +and not to other files in the same intended project. +For these people, ASDF 3 allows to eschew the <code>TRUENAME</code> mechanism, +by setting the variable <var>asdf:*resolve-symlinks*</var> to <code>nil</code>. + + <p>PS: Yes, if you haven't read Vernor Vinge's short but great classic +“True Names... and Other Dangers” then you're in for a treat. + +<h3 class="section">7.3 XDG base directory</h3> + +<p>Note that we purport to respect the XDG base directory specification +as to where configuration files are located, +where data files are located, +where output file caches are located. +Mentions of XDG variables refer to that document. + + <p><a href="http://standards.freedesktop.org/basedir-spec/basedir-spec-latest.html">http://standards.freedesktop.org/basedir-spec/basedir-spec-latest.html</a> + + <p>This specification allows the user to specify some environment variables +to customize how applications behave to his preferences. + + <p>On Windows platforms, when not using Cygwin, +instead of the XDG base directory specification, +we try to use folder configuration from the registry regarding +<code>Common AppData</code> and similar directories. +Since support for querying the Windows registry +is not possible to do in reasonable amounts of portable Common Lisp code, +ASDF 3 relies on the environment variables that Windows usually exports. + +<h3 class="section">7.4 Backward Compatibility</h3> + +<p>For backward compatibility as well as to provide a practical backdoor for hackers, +ASDF will first search for <code>.asd</code> files in the directories specified in +<code>asdf:*central-registry*</code> +before it searches in the source registry above. + + <p>See <a href="#Configuring-ASDF">Configuring ASDF to find your systems — old style</a>. + + <p>By default, <code>asdf:*central-registry*</code> will be empty. + + <p>This old mechanism will therefore not affect you if you don't use it, +but will take precedence over the new mechanism if you do use it. + +<h3 class="section">7.5 Configuration DSL</h3> + +<p>Here is the grammar of the s-expression (SEXP) DSL for source-registry +configuration: + + +<pre class="example"> ;; A configuration is a single SEXP starting with keyword :source-registry + ;; followed by a list of directives. + CONFIGURATION := (:source-registry DIRECTIVE ...) + + ;; A directive is one of the following: + DIRECTIVE := + ;; INHERITANCE DIRECTIVE: + ;; Your configuration expression MUST contain + ;; exactly one of either of these: + :inherit-configuration | ; splices inherited configuration (often specified last) + :ignore-inherited-configuration | ; drop inherited configuration (specified anywhere) + + ;; forward compatibility directive (since ASDF 2.011.4), useful when + ;; you want to use new configuration features but have to bootstrap a + ;; the newer required ASDF from an older release that doesn't sport said features: + :ignore-invalid-entries | ; drops subsequent invalid entries instead of erroring out + + ;; add a single directory to be scanned (no recursion) + (:directory DIRECTORY-PATHNAME-DESIGNATOR) | + + ;; add a directory hierarchy, recursing but excluding specified patterns + (:tree DIRECTORY-PATHNAME-DESIGNATOR) | + + ;; override the defaults for exclusion patterns + (:exclude EXCLUSION-PATTERN ...) | + ;; augment the defaults for exclusion patterns + (:also-exclude EXCLUSION-PATTERN ...) | + ;; Note that the scope of a an exclude pattern specification is + ;; the rest of the current configuration expression or file. + + ;; splice the parsed contents of another config file + (:include REGULAR-FILE-PATHNAME-DESIGNATOR) | + + ;; This directive specifies that some default must be spliced. + :default-registry + + REGULAR-FILE-PATHNAME-DESIGNATOR := PATHNAME-DESIGNATOR ;; interpreted as a file + DIRECTORY-PATHNAME-DESIGNATOR := PATHNAME-DESIGNATOR ;; interpreted as a directory name + + PATHNAME-DESIGNATOR := + NIL | ;; Special: skip this entry. + ABSOLUTE-COMPONENT-DESIGNATOR ;; see pathname DSL + + EXCLUSION-PATTERN := a string without wildcards, that will be matched exactly + against the name of a any subdirectory in the directory component + of a path. e.g. <code>"_darcs"</code> will match <samp><span class="file">#p"/foo/bar/_darcs/src/bar.asd"</span></samp> +</pre> + <p>Pathnames are designated using another DSL, +shared with the output-translations configuration DSL below. +The DSL is resolved by the function <code>asdf::resolve-location</code>, +to be documented and exported at some point in the future. + +<pre class="example"> ABSOLUTE-COMPONENT-DESIGNATOR := + (ABSOLUTE-COMPONENT-DESIGNATOR RELATIVE-COMPONENT-DESIGNATOR ...) | + STRING | ;; namestring (better be absolute or bust, directory assumed where applicable). + ;; In output-translations, directory is assumed and **/*.*.* added if it's last. + ;; On MCL, a MacOSX-style POSIX namestring (for MacOS9 style, use #p"..."); + ;; Note that none of the above applies to strings used in *central-registry*, + ;; which doesn't use this DSL: they are processed as normal namestrings. + ;; however, you can compute what you put in the *central-registry* + ;; based on the results of say (asdf::resolve-location "/Users/fare/cl/cl-foo/") + PATHNAME | ;; pathname (better be an absolute path, or bust) + ;; In output-translations, unless followed by relative components, + ;; it better have appropriate wildcards, as in **/*.*.* + :HOME | ;; designates the user-homedir-pathname ~/ + :USER-CACHE | ;; designates the default location for the user cache + :HERE | ;; designates the location of the configuration file + ;; (or *default-pathname-defaults*, if invoked interactively) + :ROOT ;; magic, for output-translations source only: paths that are relative + ;; to the root of the source host and device + ;; Not valid anymore: :SYSTEM-CACHE (was a security hazard) + + RELATIVE-COMPONENT-DESIGNATOR := + (RELATIVE-COMPONENT-DESIGNATOR RELATIVE-COMPONENT-DESIGNATOR ...) | + STRING | ;; relative directory pathname as interpreted by parse-unix-namestring. + ;; In output translations, if last component, **/*.*.* is added + PATHNAME | ;; pathname; unless last component, directory is assumed. + :IMPLEMENTATION | ;; directory based on implementation, e.g. sbcl-1.0.45-linux-x64 + :IMPLEMENTATION-TYPE | ;; a directory based on lisp-implementation-type only, e.g. sbcl + :DEFAULT-DIRECTORY | ;; a relativized version of the default directory + :*/ | ;; any direct subdirectory (since ASDF 2.011.4) + :**/ | ;; any recursively inferior subdirectory (since ASDF 2.011.4) + :*.*.* | ;; any file (since ASDF 2.011.4) + ;; Not supported (anymore): :UID and :USERNAME +</pre> + <p>For instance, as a simple case, my <samp><span class="file">~/.config/common-lisp/source-registry.conf</span></samp>, +which is the default place ASDF looks for this configuration, once contained: +<pre class="example"> (:source-registry + (:tree (:home "cl")) ;; will expand to e.g. "/home/joeluser/cl/" + :inherit-configuration) +</pre> + <h3 class="section">7.6 Configuration Directories</h3> + +<p>Configuration directories consist in files each containing +a list of directives without any enclosing <code>(:source-registry ...)</code> form. +The files will be sorted by namestring as if by <code>string<</code> and +the lists of directives of these files with be concatenated in order. +An implicit <code>:inherit-configuration</code> will be included +at the <em>end</em> of the list. + + <p>This allows for packaging software that has file granularity +(e.g. Debian's <code>dpkg</code> or some future version of <code>clbuild</code>) +to easily include configuration information about distributed software. + + <p>The convention is that, for sorting purposes, +the names of files in such a directory begin with two digits +that determine the order in which these entries will be read. +Also, the type of these files is conventionally <code>"conf"</code> +and as a limitation to some implementations (e.g. GNU clisp), +the type cannot be <code>nil</code>. + + <p>Directories may be included by specifying a directory pathname +or namestring in an <code>:include</code> directive, e.g.: + +<pre class="example"> (:include "/foo/bar/") +</pre> + <p>Hence, to achieve the same effect as +my example <samp><span class="file">~/.config/common-lisp/source-registry.conf</span></samp> above, +I could simply create a file +<samp><span class="file">~/.config/common-lisp/source-registry.conf.d/33-home-fare-cl.conf</span></samp> +alone in its directory with the following contents: +<pre class="example"> (:tree "/home/fare/cl/") +</pre> + <h4 class="subsection">7.6.1 The :here directive</h4> + +<p>The <code>:here</code> directive is an absolute pathname designator that +refers to the directory containing the configuration file currently +being processed. + + <p>The <code>:here</code> directive is intended to simplify the delivery of +complex CL systems, and for easy configuration of projects shared through +revision control systems, in accordance with our design principle that +each participant should be able to provide all and only the information +available to him or her. + + <p>Consider a person X who has set up the source code repository for a +complex project with a master directory <samp><span class="file">dir/</span></samp>. Ordinarily, one +might simply have the user add a directive that would look something +like this: +<pre class="example"> (:tree "path/to/dir") +</pre> + <p>But what if X knows that there are very large subtrees +under dir that are filled with, e.g., Java source code, image files for +icons, etc.? All of the asdf system definitions are contained in the +subdirectories <samp><span class="file">dir/src/lisp/</span></samp> and <samp><span class="file">dir/extlib/lisp/</span></samp>, and +these are the only directories that should be searched. + + <p>In this case, X can put into <samp><span class="file">dir/</span></samp> a file <samp><span class="file">asdf.conf</span></samp> that +contains the following: +<pre class="example"> (:source-registry + (:tree (:here "src/lisp/")) + (:tree (:here "extlib/lisp")) + (:directory (:here "outlier/"))) +</pre> + <p>Then when someone else (call her Y) checks out a copy of this +repository, she need only add +<pre class="example"> (:include "/path/to/my/checkout/directory/asdf.conf") +</pre> + <p>to one of her previously-existing asdf source location configuration +files, or invoke <code>initialize-source-registry</code> with a configuration +form containing that s-expression. ASDF will find the .conf file that X +has provided, and then set up source locations within the working +directory according to X's (relative) instructions. + +<h3 class="section">7.7 Shell-friendly syntax for configuration</h3> + +<p>When considering environment variable <code>CL_SOURCE_REGISTRY</code> +ASDF will skip to next configuration if it's an empty string. +It will <code>READ</code> the string as a SEXP in the DSL +if it begins with a paren <code>(</code> +and it will be interpreted much like <code>TEXINPUTS</code> +list of paths, where + + <p>* paths are separated + by a <code>:</code> (colon) on Unix platforms (including cygwin), + by a <code>;</code> (semicolon) on other platforms (mainly, Windows). + + <p>* each entry is a directory to add to the search path. + + <p>* if the entry ends with a double slash <code>//</code> + then it instead indicates a tree in the subdirectories + of which to recurse. + + <p>* if the entry is the empty string (which may only appear once), + then it indicates that the inherited configuration should be + spliced there. + +<h3 class="section">7.8 Search Algorithm</h3> + +<p><a name="index-g_t_002adefault_002dsource_002dregistry_002dexclusions_002a-52"></a> +In case that isn't clear, the semantics of the configuration is that +when searching for a system of a given name, +directives are processed in order. + + <p>When looking in a directory, if the system is found, the search succeeds, +otherwise it continues. + + <p>When looking in a tree, if one system is found, the search succeeds. +If multiple systems are found, the consequences are unspecified: +the search may succeed with any of the found systems, +or an error may be raised. +ASDF currently returns the first system found, +XCVB currently raised an error. +If none is found, the search continues. + + <p>Exclude statements specify patterns of subdirectories +the systems from which to ignore. +Typically you don't want to use copies of files kept by such +version control systems as Darcs. +Exclude statements are not propagated to further included or inherited +configuration files or expressions; +instead the defaults are reset around every configuration statement +to the default defaults from <code>asdf::*default-source-registry-exclusions*</code>. + + <p>Include statements cause the search to recurse with the path specifications +from the file specified. + + <p>An inherit-configuration statement cause the search to recurse with the path +specifications from the next configuration +(see <a href="#Controlling-where-ASDF-searches-for-systems">Configurations</a> above). + +<h3 class="section">7.9 Caching Results</h3> + +<p>The implementation is allowed to either eagerly compute the information +from the configurations and file system, or to lazily re-compute it +every time, or to cache any part of it as it goes. +To explicitly flush any information cached by the system, use the API below. + +<h3 class="section">7.10 Configuration API</h3> + +<p>The specified functions are exported from your build system's package. +Thus for ASDF the corresponding functions are in package ASDF, +and for XCVB the corresponding functions are in package XCVB. + +<div class="defun"> +— Function: <b>initialize-source-registry</b><var> &optional PARAMETER<a name="index-initialize_002dsource_002dregistry-53"></a></var><br> +<blockquote><p> will read the configuration and initialize all internal variables. + You may extend or override configuration + from the environment and configuration files + with the given <var>PARAMETER</var>, which can be + <code>nil</code> (no configuration override), + or a SEXP (in the SEXP DSL), + a string (as in the string DSL), + a pathname (of a file or directory with configuration), + or a symbol (fbound to function that when called returns one of the above). +</p></blockquote></div> + +<div class="defun"> +— Function: <b>clear-source-registry</b><var><a name="index-clear_002dsource_002dregistry-54"></a></var><br> +<blockquote><p> undoes any source registry configuration + and clears any cache for the search algorithm. + You might want to call this function + (or better, <code>clear-configuration</code>) + before you dump an image that would be resumed + with a different configuration, + and return an empty configuration. + Note that this does not include clearing information about + systems defined in the current image, only about + where to look for systems not yet defined. +</p></blockquote></div> + +<div class="defun"> +— Function: <b>ensure-source-registry</b><var> &optional PARAMETER<a name="index-ensure_002dsource_002dregistry-55"></a></var><br> +<blockquote><p> checks whether a source registry has been initialized. + If not, initialize it with the given <var>PARAMETER</var>. +</p></blockquote></div> + + <p>Every time you use ASDF's <code>find-system</code>, or +anything that uses it (such as <code>operate</code>, <code>load-system</code>, etc.), +<code>ensure-source-registry</code> is called with parameter <code>nil</code>, +which the first time around causes your configuration to be read. +If you change a configuration file, +you need to explicitly <code>initialize-source-registry</code> again, +or maybe simply to <code>clear-source-registry</code> (or <code>clear-configuration</code>) +which will cause the initialization to happen next time around. + +<h3 class="section">7.11 Status</h3> + +<p>This mechanism is vastly successful, and we have declared +that <code>asdf:*central-registry*</code> is not recommended anymore, +though we will continue to support it. +All hooks into implementation-specific search mechanisms +have been integrated in the <code>wrapping-source-registry</code> +that everyone uses implicitly. + +<h3 class="section">7.12 Rejected ideas</h3> + +<p>Alternatives I considered and rejected included: + + <ol type=1 start=1> +<li>Keep <code>asdf:*central-registry*</code> as the master with its current semantics, + and somehow the configuration parser expands the new configuration + language into a expanded series of directories of subdirectories to + lookup, pre-recursing through specified hierarchies. This is kludgy, + and leaves little space of future cleanups and extensions. + + <li>Keep <code>asdf:*central-registry*</code> remains the master but extend its semantics + in completely new ways, so that new kinds of entries may be implemented + as a recursive search, etc. This seems somewhat backwards. + + <li>Completely remove <code>asdf:*central-registry*</code> + and break backwards compatibility. + Hopefully this will happen in a few years after everyone migrate to + a better ASDF and/or to XCVB, but it would be very bad to do it now. + + <li>Replace <code>asdf:*central-registry*</code> by a symbol-macro with appropriate magic + when you dereference it or setf it. Only the new variable with new + semantics is handled by the new search procedure. + Complex and still introduces subtle semantic issues. + </ol> + + <p>I've been suggested the below features, but have rejected them, +for the sake of keeping ASDF no more complex than strictly necessary. + + <ul> +<li> More syntactic sugar: synonyms for the configuration directives, such as + <code>(:add-directory X)</code> for <code>(:directory X)</code>, or <code>(:add-directory-hierarchy X)</code> + or <code>(:add-directory X :recurse t)</code> for <code>(:tree X)</code>. + + <li> The possibility to register individual files instead of directories. + + <li> Integrate Xach Beane's tilde expander into the parser, + or something similar that is shell-friendly or shell-compatible. + I'd rather keep ASDF minimal. But maybe this precisely keeps it + minimal by removing the need for evaluated entries that ASDF has? + i.e. uses of <code>USER-HOMEDIR-PATHNAME</code> and <code>$SBCL_HOME</code> + Hopefully, these are already superseded by the <code>:default-registry</code> + + <li> Using the shell-unfriendly syntax <code>/**</code> instead of <code>//</code> to specify recursion + down a filesystem tree in the environment variable. + It isn't that Lisp friendly either. +</ul> + +<h3 class="section">7.13 TODO</h3> + + <ul> +<li>Add examples +</ul> + +<h3 class="section">7.14 Credits for the source-registry</h3> + +<p>Thanks a lot to Stelian Ionescu for the initial idea. + + <p>Thanks to Rommel Martinez for the initial implementation attempt. + + <p>All bad design ideas and implementation bugs are to mine, not theirs. +But so are good design ideas and elegant implementation tricks. + + <p>— Francois-Rene Rideau <a href="mailto:fare@tunes.org">fare(a)tunes.org</a>, Mon, 22 Feb 2010 00:07:33 -0500 + +<p><a name="Controlling-where-ASDF-saves-compiled-files"></a> + + +<h2 class="chapter">8 Controlling where ASDF saves compiled files</h2> + +<p><a name="index-asdf_002doutput_002dtranslations-56"></a><a name="index-ASDF_005fOUTPUT_005fTRANSLATIONS-57"></a> +Each Common Lisp implementation has its own format +for compiled files (fasls for short, short for “fast loading”). +If you use multiple implementations +(or multiple versions of the same implementation), +you'll soon find your source directories +littered with various <samp><span class="file">fasl</span></samp>s, <samp><span class="file">dfsl</span></samp>s, <samp><span class="file">cfsl</span></samp>s and so on. +Worse yet, some implementations use the same file extension +while changing formats from version to version (or platform to platform) +which means that you'll have to recompile binaries +as you switch from one implementation to the next. + + <p>Since ASDF 2, ASDF includes the <code>asdf-output-translations</code> facility +to mitigate the problem. + +<h3 class="section">8.1 Configurations</h3> + +<p>Configurations specify mappings from input locations to output locations. +Once again we rely on the XDG base directory specification for configuration. +See <a href="#Controlling-where-ASDF-searches-for-systems">XDG base directory</a>. + + <ol type=1 start=1> + + <li>Some hardcoded wrapping output translations configuration may be used. +This allows special output translations (or usually, invariant directories) +to be specified corresponding to the similar special entries in the source registry. + + <li>An application may explicitly initialize the output-translations +configuration using the Configuration API +in which case this takes precedence. +(see <a href="#Controlling-where-ASDF-saves-compiled-files">Configuration API</a>.) +It may itself compute this configuration from the command-line, +from a script, from its own configuration file, etc. + + <li>The source registry will be configured from +the environment variable <code>ASDF_OUTPUT_TRANSLATIONS</code> if it exists. + + <li>The source registry will be configured from +user configuration file +<samp><span class="file">$XDG_CONFIG_DIRS/common-lisp/asdf-output-translations.conf</span></samp> +(which defaults to +<samp><span class="file">~/.config/common-lisp/asdf-output-translations.conf</span></samp>) +if it exists. + + <li>The source registry will be configured from +user configuration directory +<samp><span class="file">$XDG_CONFIG_DIRS/common-lisp/asdf-output-translations.conf.d/</span></samp> +(which defaults to +<samp><span class="file">~/.config/common-lisp/asdf-output-translations.conf.d/</span></samp>) +if it exists. + + <li>The source registry will be configured from +system configuration file +<samp><span class="file">/etc/common-lisp/asdf-output-translations.conf</span></samp> +if it exists. + + <li>The source registry will be configured from +system configuration directory +<samp><span class="file">/etc/common-lisp/asdf-output-translations.conf.d/</span></samp> +if it exists. + + </ol> + + <p>Each of these configurations is specified as a SEXP +in a trival domain-specific language (defined below). +Additionally, a more shell-friendly syntax is available +for the environment variable (defined yet below). + + <p>Each of these configurations is only used if the previous +configuration explicitly or implicitly specifies that it +includes its inherited configuration. + + <p>Note that by default, a per-user cache is used for output files. +This allows the seamless use of shared installations of software +between several users, and takes files out of the way of the developers +when they browse source code, +at the expense of taking a small toll when developers have to clean up +output files and find they need to get familiar with output-translations first. + +<h3 class="section">8.2 Backward Compatibility</h3> + +<p><a name="index-ASDF_002dBINARY_002dLOCATIONS-compatibility-58"></a> + + <p>We purposefully do NOT provide backward compatibility with earlier versions of +<code>ASDF-Binary-Locations</code> (8 Sept 2009), +<code>common-lisp-controller</code> (7.0) or +<code>cl-launch</code> (2.35), +each of which had similar general capabilities. +The previous APIs of these programs were not designed +for configuration by the end-user +in an easy way with configuration files. +Recent versions of same packages use +the new <code>asdf-output-translations</code> API as defined below: +<code>common-lisp-controller</code> (7.2) and <code>cl-launch</code> (3.000). +<code>ASDF-Binary-Locations</code> is fully superseded and not to be used anymore. + + <p>This incompatibility shouldn't inconvenience many people. +Indeed, few people use and customize these packages; +these few people are experts who can trivially adapt to the new configuration. +Most people are not experts, could not properly configure these features +(except inasmuch as the default configuration of +<code>common-lisp-controller</code> and/or <code>cl-launch</code> +might have been doing the right thing for some users), +and yet will experience software that “just works”, +as configured by the system distributor, or by default. + + <p>Nevertheless, if you are a fan of <code>ASDF-Binary-Locations</code>, +we provide a limited emulation mode: + +<div class="defun"> +— Function: <b>enable-asdf-binary-locations-compatibility</b><var> &key centralize-lisp-binaries default-toplevel-directory include-per-user-information map-all-source-files source-to-target-mappings<a name="index-enable_002dasdf_002dbinary_002dlocations_002dcompatibility-59"></a></var><br> +<blockquote><p>This function will initialize the new <code>asdf-output-translations</code> facility in a way +that emulates the behavior of the old <code>ASDF-Binary-Locations</code> facility. +Where you would previously set global variables +<var>*centralize-lisp-binaries*</var>, +<var>*default-toplevel-directory*</var>, +<var>*include-per-user-information*</var>, +<var>*map-all-source-files*</var> or <var>*source-to-target-mappings*</var> +you will now have to pass the same values as keyword arguments to this function. +Note however that as an extension the <code>:source-to-target-mappings</code> keyword argument +will accept any valid pathname designator for <code>asdf-output-translations</code> +instead of just strings and pathnames. +</p></blockquote></div> + + <p>If you insist, you can also keep using the old <code>ASDF-Binary-Locations</code> +(the one available as an extension to load of top of ASDF, +not the one built into a few old versions of ASDF), +but first you must disable <code>asdf-output-translations</code> +with <code>(asdf:disable-output-translations)</code>, +or you might experience “interesting” issues. + + <p>Also, note that output translation is enabled by default. +To disable it, use <code>(asdf:disable-output-translations)</code>. + +<h3 class="section">8.3 Configuration DSL</h3> + +<p>Here is the grammar of the SEXP DSL +for <code>asdf-output-translations</code> configuration: + +<pre class="verbatim">;; A configuration is single SEXP starting with keyword :source-registry +;; followed by a list of directives. +CONFIGURATION := (:output-translations DIRECTIVE ...) + +;; A directive is one of the following: +DIRECTIVE := + ;; INHERITANCE DIRECTIVE: + ;; Your configuration expression MUST contain + ;; exactly one of either of these: + :inherit-configuration | ; splices inherited configuration (often specified last) + :ignore-inherited-configuration | ; drop inherited configuration (specified anywhere) + + ;; forward compatibility directive (since ASDF 2.011.4), useful when + ;; you want to use new configuration features but have to bootstrap a + ;; the newer required ASDF from an older release that doesn't sport said features: + :ignore-invalid-entries | ; drops subsequent invalid entries instead of erroring out + + ;; include a configuration file or directory + (:include PATHNAME-DESIGNATOR) | + + ;; enable global cache in ~/.common-lisp/cache/sbcl-1.0.45-linux-amd64/ or something. + :enable-user-cache | + ;; Disable global cache. Map / to / + :disable-cache | + + ;; add a single directory to be scanned (no recursion) + (DIRECTORY-DESIGNATOR DIRECTORY-DESIGNATOR) + + ;; use a function to return the translation of a directory designator + (DIRECTORY-DESIGNATOR (:function TRANSLATION-FUNCTION)) + +DIRECTORY-DESIGNATOR := + NIL | ;; As source: skip this entry. As destination: same as source + T | ;; as source matches anything, as destination leaves pathname unmapped. + ABSOLUTE-COMPONENT-DESIGNATOR ;; same as in the source-registry language + +TRANSLATION-FUNCTION := + SYMBOL | ;; symbol of a function that takes two arguments, + ;; the pathname to be translated and the matching DIRECTORY-DESIGNATOR + LAMBDA ;; A form which evalutates to a function taking two arguments consisting of + ;; the pathname to be translated and the matching DIRECTORY-DESIGNATOR + +</pre> + + <p>Relative components better be either relative +or subdirectories of the path before them, or bust. + + <p>The last component, if not a pathname, is notionally completed by <samp><span class="file">/**/*.*</span></samp>. +You can specify more fine-grained patterns +by using a pathname object as the last component +e.g. <samp><span class="file">#p"some/path/**/foo*/bar-*.fasl"</span></samp> + + <p>You may use <code>#+features</code> to customize the configuration file. + + <p>The second designator of a mapping may be <code>nil</code>, indicating that files are not mapped +to anything but themselves (same as if the second designator was the same as the first). + + <p>When the first designator is <code>t</code>, +the mapping always matches. +When the first designator starts with <code>:root</code>, +the mapping matches any host and device. +In either of these cases, if the second designator +isn't <code>t</code> and doesn't start with <code>:root</code>, +then strings indicating the host and pathname are somehow copied +in the beginning of the directory component of the source pathname +before it is translated. + + <p>When the second designator is <code>t</code>, the mapping is the identity. +When the second designator starts with <code>:root</code>, +the mapping preserves the host and device of the original pathname. +Notably, this allows you to map files +to a subdirectory of the whichever directory the file is in. +Though the syntax is not quite as easy to use as we'd like, +you can have an (source destination) mapping entry such as follows +in your configuration file, +or you may use <code>enable-asdf-binary-locations-compatibility</code> +with <code>:centralize-lisp-binaries nil</code> +which will do the same thing internally for you: +<pre class="verbatim"> #.(let ((wild-subdir (make-pathname :directory '(:relative :wild-inferiors))) + (wild-file (make-pathname :name :wild :version :wild :type :wild))) + `((:root ,wild-subdir ,wild-file) ;; Or using the implicit wildcard, just :root + (:root ,wild-subdir :implementation ,wild-file))) +</pre> +Starting with ASDF 2.011.4, you can use the simpler: + <code>`(:root (:root :**/ :implementation :*.*.*))</code> + + <p><code>:include</code> statements cause the search to recurse with the path specifications +from the file specified. + + <p>If the <code>translate-pathname</code> mechanism cannot achieve a desired +translation, the user may provide a function which provides the +required algorithim. Such a translation function is specified by +supplying a list as the second <code>directory-designator</code> +the first element of which is the keyword <code>:function</code>, +and the second element of which is +either a symbol which designates a function or a lambda expression. +The function designated by the second argument must take two arguments, +the first being the pathname of the source file, +the second being the wildcard that was matched. +The result of the function invocation should be the translated pathname. + + <p>An <code>:inherit-configuration</code> statement cause the search to recurse with the path +specifications from the next configuration. +See <a href="#Controlling-where-ASDF-saves-compiled-files">Configurations</a>, above. + + <ul> +<li><code>:enable-user-cache</code> is the same as <code>(t :user-cache)</code>. +<li><code>:disable-cache</code> is the same as <code>(t t)</code>. +<li><code>:user-cache</code> uses the contents of variable <code>asdf::*user-cache*</code> +which by default is the same as using +<code>(:home ".cache" "common-lisp" :implementation)</code>. +<li><code>:system-cache</code> uses the contents of variable <code>asdf::*system-cache*</code> +which by default is the same as using +<code>("/var/cache/common-lisp" :uid :implementation-type)</code> +(on Unix and cygwin), or something semi-sensible on Windows. +</ul> + +<h3 class="section">8.4 Configuration Directories</h3> + +<p>Configuration directories consist in files each contains +a list of directives without any enclosing +<code>(:output-translations ...)</code> form. +The files will be sorted by namestring as if by <code>string<</code> and +the lists of directives of these files with be concatenated in order. +An implicit <code>:inherit-configuration</code> will be included +at the <em>end</em> of the list. + + <p>This allows for packaging software that has file granularity +(e.g. Debian's <samp><span class="command">dpkg</span></samp> or some future version of <samp><span class="command">clbuild</span></samp>) +to easily include configuration information about software being distributed. + + <p>The convention is that, for sorting purposes, +the names of files in such a directory begin with two digits +that determine the order in which these entries will be read. +Also, the type of these files is conventionally <code>"conf"</code> +and as a limitation of some implementations, the type cannot be <code>nil</code>. + + <p>Directories may be included by specifying a directory pathname +or namestring in an <code>:include</code> directive, e.g.: +<pre class="verbatim"> (:include "/foo/bar/") +</pre> + +<h3 class="section">8.5 Shell-friendly syntax for configuration</h3> + +<p>When considering environment variable <code>ASDF_OUTPUT_TRANSLATIONS</code> +ASDF will skip to next configuration if it's an empty string. +It will <code>READ</code> the string as an SEXP in the DSL +if it begins with a paren <code>(</code> +and it will be interpreted as a list of directories. +Directories should come by pairs, indicating a mapping directive. +Entries are separated +by a <code>:</code> (colon) on Unix platforms (including cygwin), +by a <code>;</code> (semicolon) on other platforms (mainly, Windows). + + <p>The magic empty entry, +if it comes in what would otherwise be the first entry in a pair, +indicates the splicing of inherited configuration. +If it comes as the second entry in a pair, +it indicates that the directory specified first is to be left untranslated +(which has the same effect as if the directory had been repeated). + +<h3 class="section">8.6 Semantics of Output Translations</h3> + +<p>From the specified configuration, +a list of mappings is extracted in a straightforward way: +mappings are collected in order, recursing through +included or inherited configuration as specified. +To this list is prepended some implementation-specific mappings, +and is appended a global default. + + <p>The list is then compiled to a mapping table as follows: +for each entry, in order, resolve the first designated directory +into an actual directory pathname for source locations. +If no mapping was specified yet for that location, +resolve the second designated directory to an output location directory +add a mapping to the table mapping the source location to the output location, +and add another mapping from the output location to itself +(unless a mapping already exists for the output location). + + <p>Based on the table, a mapping function is defined, +mapping source pathnames to output pathnames: +given a source pathname, locate the longest matching prefix +in the source column of the mapping table. +Replace that prefix by the corresponding output column +in the same row of the table, and return the result. +If no match is found, return the source pathname. +(A global default mapping the filesystem root to itself +may ensure that there will always be a match, +with same fall-through semantics). + +<h3 class="section">8.7 Caching Results</h3> + +<p>The implementation is allowed to either eagerly compute the information +from the configurations and file system, or to lazily re-compute it +every time, or to cache any part of it as it goes. +To explicitly flush any information cached by the system, use the API below. + +<h3 class="section">8.8 Output location API</h3> + +<p>The specified functions are exported from package ASDF. + +<div class="defun"> +— Function: <b>initialize-output-translations</b><var> &optional PARAMETER<a name="index-initialize_002doutput_002dtranslations-60"></a></var><br> +<blockquote><p> will read the configuration and initialize all internal variables. + You may extend or override configuration + from the environment and configuration files + with the given <var>PARAMETER</var>, which can be + <code>nil</code> (no configuration override), + or a SEXP (in the SEXP DSL), + a string (as in the string DSL), + a pathname (of a file or directory with configuration), + or a symbol (fbound to function that when called returns one of the above). +</p></blockquote></div> + +<div class="defun"> +— Function: <b>disable-output-translations</b><var><a name="index-disable_002doutput_002dtranslations-61"></a></var><br> +<blockquote><p> will initialize output translations in a way + that maps every pathname to itself, + effectively disabling the output translation facility. +</p></blockquote></div> + +<div class="defun"> +— Function: <b>clear-output-translations</b><var><a name="index-clear_002doutput_002dtranslations-62"></a></var><br> +<blockquote><p> undoes any output translation configuration + and clears any cache for the mapping algorithm. + You might want to call this function + (or better, <code>clear-configuration</code>) + before you dump an image that would be resumed + with a different configuration, + and return an empty configuration. + Note that this does not include clearing information about + systems defined in the current image, only about + where to look for systems not yet defined. +</p></blockquote></div> + +<div class="defun"> +— Function: <b>ensure-output-translations</b><var> &optional PARAMETER<a name="index-ensure_002doutput_002dtranslations-63"></a></var><br> +<blockquote><p> checks whether output translations have been initialized. + If not, initialize them with the given <var>PARAMETER</var>. + This function will be called before any attempt to operate on a system. +</p></blockquote></div> + +<div class="defun"> +— Function: <b>apply-output-translations</b><var> PATHNAME<a name="index-apply_002doutput_002dtranslations-64"></a></var><br> +<blockquote><p> Applies the configured output location translations to <var>PATHNAME</var> + (calls <code>ensure-output-translations</code> for the translations). +</p></blockquote></div> + + <p>Every time you use ASDF's <code>output-files</code>, or +anything that uses it (that may compile, such as <code>operate</code>, <code>perform</code>, etc.), +<code>ensure-output-translations</code> is called with parameter <code>nil</code>, +which the first time around causes your configuration to be read. +If you change a configuration file, +you need to explicitly <code>initialize-output-translations</code> again, +or maybe <code>clear-output-translations</code> (or <code>clear-configuration</code>), +which will cause the initialization to happen next time around. + +<h3 class="section">8.9 Credits for output translations</h3> + +<p>Thanks a lot to Bjorn Lindberg and Gary King for <code>ASDF-Binary-Locations</code>, +and to Peter van Eynde for <code>Common Lisp Controller</code>. + + <p>All bad design ideas and implementation bugs are to mine, not theirs. +But so are good design ideas and elegant implementation tricks. + + <p>— Francois-Rene Rideau <a href="mailto:fare@tunes.org">fare(a)tunes.org</a> + + + + + + + + + + + + + + + + + + + + + +<p><a name="Error-handling"></a> + + +<h2 class="chapter">9 Error handling</h2> + +<p><a name="index-SYSTEM_002dDEFINITION_002dERROR-65"></a><a name="index-OPERATION_002dERROR-66"></a> + +<h3 class="section">9.1 ASDF errors</h3> + +<p>If ASDF detects an incorrect system definition, it will signal a generalised instance of +<code>SYSTEM-DEFINITION-ERROR</code>. + + <p>Operations may go wrong (for example when source files contain errors). +These are signalled using generalised instances of +<code>OPERATION-ERROR</code>. + +<h3 class="section">9.2 Compilation error and warning handling</h3> + +<p><a name="index-g_t_002acompile_002dfile_002dwarnings_002dbehaviour_002a-67"></a><a name="index-g_t_002acompile_002dfile_002derrors_002dbehavior_002a-68"></a> +ASDF checks for warnings and errors when a file is compiled. +The variables <var>*compile-file-warnings-behaviour*</var> and +<var>*compile-file-errors-behavior*</var> +control the handling of any such events. +The valid values for these variables are +<code>:error</code>, <code>:warn</code>, and <code>:ignore</code>. + +<p><a name="Miscellaneous-additional-functionality"></a> + + +<h2 class="chapter">10 Miscellaneous additional functionality</h2> + +<p>ASDF includes several additional features that are generally +useful for system definition and development. + +<h3 class="section">10.1 Controlling file compilation</h3> + +<p><a name="index-g_t_003aaround_002dcompile-69"></a><a name="index-around_002dcompile-keyword-70"></a><a name="index-compile_002dcheck-keyword-71"></a><a name="index-g_t_003acompile_002dcheck-72"></a><a name="index-compile_002dfile_002a-73"></a> +When declaring a component (system, module, file), +you can specify a keyword argument <code>:around-compile function</code>. +If left unspecified (and therefore unbound), +the value will be inherited from the parent component if any, +or with a default of <code>nil</code> +if no value is specified in any transitive parent. + + <p>The argument must be a either <code>nil</code>, a fbound symbol, +a lambda-expression (e.g. <code>(lambda (thunk) ...(funcall thunk ...) ...)</code>) +a function object (e.g. using <code>#.#'</code> but that's discouraged +because it prevents the introspection done by e.g. asdf-dependency-grovel), +or a string that when <code>read</code> yields a symbol or a lambda-expression. +<code>nil</code> means the normal compile-file function will be called. +A non-nil value designates a function of one argument +that will be called with a function that will +invoke <code>compile-file*</code> with various arguments; +the around-compile hook may supply additional keyword arguments +to pass to that call to <code>compile-file*</code>. + + <p>One notable argument that is heeded by <code>compile-file*</code> is +<code>:compile-check</code>, +a function called when the compilation was otherwise a success, +with the same arguments as <code>compile-file</code>; +the function shall return true if the compilation +and its resulting compiled file respected all system-specific invariants, +and false (<code>nil</code>) if it broke any of those invariants; +it may issue warnings or errors before it returns <code>nil</code>. +(NB: The ability to pass such extra flags +is only available starting with ASDF 2.22.3.) +This feature is notably exercised by asdf-finalizers. + + <p>By using a string, you may reference +a function, symbol and/or package +that will only be created later during the build, but +isn't yet present at the time the defsystem form is evaluated. +However, if your entire system is using such a hook, you may have to +explicitly override the hook with <code>nil</code> for all the modules and files +that are compiled before the hook is defined. + + <p>Using this hook, you may achieve such effects as: +locally renaming packages, +binding <var>*readtables*</var> and other syntax-controlling variables, +handling warnings and other conditions, +proclaiming consistent optimization settings, +saving code coverage information, +maintaining meta-data about compilation timings, +setting gensym counters and PRNG seeds and other sources of non-determinism, +overriding the source-location and/or timestamping systems, +checking that some compile-time side-effects were properly balanced, +etc. + + <p>Note that there is no around-load hook. This is on purpose. +Some implementations such as ECL, GCL or MKCL link object files, +which allows for no such hook. +Other implementations allow for concatenating FASL files, +which doesn't allow for such a hook either. +We aim to discourage something that's not portable, +and has some dubious impact on performance and semantics +even when it is possible. +Things you might want to do with an around-load hook +are better done around-compile, +though it may at times require some creativity +(see e.g. the <code>package-renaming</code> system). + +<h3 class="section">10.2 Controlling source file character encoding</h3> + +<p>Starting with ASDF 2.21, components accept a <code>:encoding</code> option +so authors may specify which character encoding should be used +to read and evaluate their source code. +When left unspecified, the encoding is inherited +from the parent module or system; +if no encoding is specified at any point, +the default <code>:autodetect</code> is assumed. +By default, only <code>:default</code>, <code>:utf-8</code> +and <code>:autodetect</code> are accepted. +<code>:autodetect</code>, the default, calls +<code>*encoding-detection-hook*</code> which by default always returns +<code>*default-encoding*</code> which itself defaults to <code>:default</code>. + + <p>In other words, there now are plenty of extension hooks, but +by default ASDF follows the backwards compatible behavior +of using whichever <code>:default</code> encoding your implementation uses, +which itself may or may not vary based on environment variables +and other locale settings. +In practice this means that only source code that only uses ASCII +is guaranteed to be read the same on all implementations +independently from any user setting. + + <p>Additionally, for backward-compatibility with older versions of ASDF +and/or with implementations that do not support unicode and its many encodings, +you may want to use +the reader conditionals <code>#+asdf-unicode #+asdf-unicode</code> +to protect any <code>:encoding </code><em>encoding</em> statement +as <code>:asdf-unicode</code> will be present in <code>*features*</code> +only if you're using a recent ASDF +on an implementation that supports unicode. +We recommend that you avoid using unprotected <code>:encoding</code> specifications +until after ASDF 2.21 or later becomes widespread, hopefully by the end of 2012. + + <p>While it offers plenty of hooks for extension, +and one such extension is being developed (see below), +ASDF itself only recognizes one encoding beside <code>:default</code>, +and that is <code>:utf-8</code>, which is the <em>de facto</em> standard, +already used by the vast majority of libraries that use more than ASCII. +On implementations that do not support unicode, +the feature <code>:asdf-unicode</code> is absent, and +the <code>:default</code> external-format is used +to read even source files declared as <code>:utf-8</code>. +On these implementations, non-ASCII characters +intended to be read as one CL character +may thus end up being read as multiple CL characters. +In most cases, this shouldn't affect the software's semantics: +comments will be skipped just the same, strings with be read and printed +with slightly different lengths, symbol names will be accordingly longer, +but none of it should matter. +But a few systems that actually depend on unicode characters +may fail to work properly, or may work in a subtly different way. +See for instance <code>lambda-reader</code>. + + <p>We invite you to embrace UTF-8 +as the encoding for non-ASCII characters starting today, +even without any explicit specification in your <code>.asd</code> files. +Indeed, on some implementations and configurations, +UTF-8 is already the <code>:default</code>, +and loading your code may cause errors if it is encoded in anything but UTF-8. +Therefore, even with the legacy behavior, +non-UTF-8 is guaranteed to break for some users, +whereas UTF-8 is pretty much guaranteed not to break anywhere +(provided you do <em>not</em> use a BOM), +although it might be read incorrectly on some implementations. +In the future, we intend to make <code>:utf-8</code> +the default value of <code>*default-encoding*</code>, +to be enforced everywhere, so at least the code is guaranteed +to be read correctly everywhere it can be. + + <p>If you need non-standard character encodings for your source code, +use the extension system <code>asdf-encodings</code>, by specifying +<code>:defsystem-depends-on (:asdf-encodings)</code> in your <code>defsystem</code>. +This extension system will register support for more encodings using the +<code>*encoding-external-format-hook*</code> facility, +so you can explicitly specify <code>:encoding :latin1</code> +in your <code>.asd</code> file. +Using the <code>*encoding-detection-hook*</code> it will also +eventually implement some autodetection of a file's encoding +from an emacs-style <code>-*- mode: lisp ; coding: latin1 -*-</code> declaration, +or otherwise based on an analysis of octet patterns in the file. +At this point, asdf-encoding only supports the encodings +that are supported as part of your implementation. +Since the list varies depending on implementations, +we once again recommend you use <code>:utf-8</code> everywhere, +which is the most portable (next is <code>:latin1</code>). + + <p>If you're not using a version of Quicklisp that has it, +you may get the source for <code>asdf-encodings</code> using git: +<kbd>git clone git://common-lisp.net/projects/asdf/asdf-encodings.git</kbd> +or +<kbd>git clone ssh://common-lisp.net/project/asdf/git/asdf-encodings.git</kbd>. +You can also browse the repository on +<a href="http://common-lisp.net/gitweb?p=projects/asdf/asdf-encodings.git">http://common-lisp.net/gitweb?p=projects/asdf/asdf-encodings.git</a>. + + <p>In the future, we intend to change the default <code>*default-encoding*</code> +to <code>:utf-8</code>, which is already the de facto standard +for most libraries that use non-ASCII characters: +utf-8 works everywhere and was backhandedly enforced by +a lot of people using SBCL and utf-8 and sending reports to authors +so they make their packages compatible. +A survey showed only about a handful few libraries +are incompatible with non-UTF-8, and then, only in comments, +and we believe that authors will adopt UTF-8 when prompted. +See the April 2012 discussion on the asdf-devel mailing-list. +For backwards compatibility with users who insist on a non-UTF-8 encoding, +but cannot immediately transition to using <code>asdf-encodings</code> +(maybe because it isn't ready), it will still be possible to use +the <code>:encoding :default</code> option in your <code>defsystem</code> form +to restore the behavior of ASDF 2.20 and earlier. +This shouldn't be required in libraries, +because user pressure as mentioned above will already have pushed +library authors towards using UTF-8; +but authors of end-user programs might care. + + <p>When you use <code>asdf-encodings</code>, any further loaded <code>.asd</code> file +will use the autodetection algorithm to determine its encoding; +yet if you depend on this detection happening, +you may want to explicitly load <code>asdf-encodings</code> early in your build, +for by the time you can use <code>:defsystem-depends-on</code>, +it is already too late to load it. +In practice, this means that the <code>*default-encoding*</code> +is usually used for <code>.asd</code> files. +Currently, this defaults to <code>:default</code> for backwards compatibility, +and that means that you shouldn't rely on non-ASCII characters in a .asd file. +Since component (path)names are the only real data in these files, +and non-ASCII characters are not very portable for file names, +this isn't too much of an issue. +We still encourage you to use either plain ASCII or UTF-8 +in <code>.asd</code> files, +as we intend to make <code>:utf-8</code> the default encoding in the future. +This might matter, for instance, in meta-data about author's names. + +<h3 class="section">10.3 Miscellaneous Functions</h3> + +<p>These functions are exported by ASDF for your convenience. + +<div class="defun"> +— Function: <b>system-relative-pathname</b><var> system name &key type<a name="index-system_002drelative_002dpathname-74"></a></var><br> +<blockquote> + <p>It's often handy to locate a file relative to some system. +The <code>system-relative-pathname</code> function meets this need. + + <p>It takes two mandatory arguments <var>system</var> and <var>name</var> +and a keyword argument <var>type</var>: +<var>system</var> is name of a system, whereas <var>name</var> and optionally <var>type</var> +specify a relative pathname, interpreted like a component pathname specifier +by <code>coerce-pathname</code>. See <a href="#The-defsystem-grammar">Pathname specifiers</a>. + + <p>It returns a pathname built from the location of the system's +source directory and the relative pathname. For example: + + <pre class="lisp"> > (asdf:system-relative-pathname 'cl-ppcre "regex.data") + #P"/repository/other/cl-ppcre/regex.data" +</pre> + </blockquote></div> + +<div class="defun"> +— Function: <b>system-source-directory</b><var> system-designator<a name="index-system_002dsource_002ddirectory-75"></a></var><br> +<blockquote> + <p>ASDF does not provide a turnkey solution for locating +data (or other miscellaneous) files +that are distributed together with the source code of a system. +Programmers can use <code>system-source-directory</code> to find such files. +Returns a pathname object. +The <var>system-designator</var> may be a string, symbol, or ASDF system object. +</p></blockquote></div> + +<div class="defun"> +— Function: <b>clear-system</b><var> system-designator<a name="index-clear_002dsystem-76"></a></var><br> +<blockquote> + <p>It is sometimes useful to force recompilation of a previously loaded system. +In these cases, it may be useful to <code>(asdf:clear-system :foo)</code> +to remove the system from the table of currently loaded systems; +the next time the system <code>foo</code> or one that depends on it is re-loaded, +<code>foo</code> will then be loaded again. +Alternatively, you could touch <code>foo.asd</code> or +remove the corresponding fasls from the output file cache. +(It was once conceived that one should provide +a list of systems the recompilation of which to force +as the <code>:force</code> keyword argument to <code>load-system</code>; +but this has never worked, and though the feature was fixed in ASDF 2.000, +it remains <code>cerror</code>'ed out as nobody ever used it.) + + <p>Note that this does not and cannot by itself undo the previous loading +of the system. Common Lisp has no provision for such an operation, +and its reliance on irreversible side-effects to global datastructures +makes such a thing impossible in the general case. +If the software being re-loaded is not conceived with hot upgrade in mind, +this re-loading may cause many errors, warnings or subtle silent problems, +as packages, generic function signatures, structures, types, macros, constants, etc. +are being redefined incompatibly. +It is up to the user to make sure that reloading is possible and has the desired effect. +In some cases, extreme measures such as recursively deleting packages, +unregistering symbols, defining methods on <code>update-instance-for-redefined-class</code> +and much more are necessary for reloading to happen smoothly. +ASDF itself goes through notable pains to make such a hot upgrade possible +with respect to its own code, and what it does is ridiculously complex; +look at the beginning of <samp><span class="file">asdf.lisp</span></samp> to see what it does. +</p></blockquote></div> + +<div class="defun"> +— Function: <b>register-preloaded-system</b><var> name &rest keys<a name="index-register_002dpreloaded_002dsystem-77"></a></var><br> +<blockquote><p>A system with name <var>name</var>, +created by <code>make-instance</code> with extra keys <var>keys</var> +(e.g. <code>:version</code>), +is registered as <em>preloaded</em>. +That is, its code has already been loaded into the current image, +and if at some point some other system <code>:depends-on</code> it yet no source code is found, +it is considered as already provided, +and ASDF will not raise a <code>missing-component</code> error. + + <p>This function is particularly useful if you distribute your code +as fasls with either <code>fasl-op</code> or <code>monolithic-fasl-op</code>, +and want to register systems so that dependencies will work uniformly +whether you're using your software from source or from fasl. +</p></blockquote></div> + +<div class="defun"> +— Function: <b>run-shell-command</b><var> control-string &rest args<a name="index-run_002dshell_002dcommand-78"></a></var><br> +<blockquote> + <p>This function is obsolete and present only for the sake of backwards-compatibility: +“If it's not backwards, it's not compatible”. We <em>strongly</em> discourage its use. +Its current behavior is only well-defined on Unix platforms +(which include MacOS X and cygwin). On Windows, anything goes. +The following documentation is only for the purpose of your migrating away from it +in a way that preserves semantics. + + <p>Instead we recommend the use <code>run-program</code>, described in the next section, and +available as part of ASDF since ASDF 3. + + <p><code>run-shell-command</code> takes as arguments a format <code>control-string</code> +and arguments to be passed to <code>format</code> after this control-string +to produce a string. +This string is a command that will be evaluated with a POSIX shell if possible; +yet, on Windows, some implementations will use CMD.EXE, +while others (like SBCL) will make an attempt at invoking a POSIX shell +(and fail if it is not present). +</p></blockquote></div> + +<h3 class="section">10.4 Some Utility Functions</h3> + +<p>The below functions are not exported by ASDF itself, but by UIOP, available since ASDF 3. +Some of them have precursors in ASDF 2, but we recommend +you rely on ASDF 3 for active developments. +UIOP provides many, many more utility functions, and we recommend +you read its README and sources for more information. + +<div class="defun"> +— Function: <b>parse-unix-namestring</b><var> name &key type defaults dot-dot ensure-directory &allow-other-keys<a name="index-parse_002dunix_002dnamestring-79"></a></var><br> +<blockquote><p>Coerce NAME into a PATHNAME using standard Unix syntax. + + <p>Unix syntax is used whether or not the underlying system is Unix; +on such non-Unix systems it is only usable but for relative pathnames; +but especially to manipulate relative pathnames portably, it is of crucial +to possess a portable pathname syntax independent of the underlying OS. +This is what <code>parse-unix-namestring</code> provides, and why we use it in ASDF. + + <p>When given a <code>pathname</code> object, just return it untouched. +When given <code>nil</code>, just return <code>nil</code>. +When given a non-null <code>symbol</code>, first downcase its name and treat it as a string. +When given a <code>string</code>, portably decompose it into a pathname as below. + + <p><code>#\/</code> separates directory components. + + <p>The last <code>#\/</code>-separated substring is interpreted as follows: +1- If <var>type</var> is <code>:directory</code> or <var>ensure-directory</var> is true, + the string is made the last directory component, and its <code>name</code> and <code>type</code> are <code>nil</code>. + if the string is empty, it's the empty pathname with all slots <code>nil</code>. +2- If <var>type</var> is <code>nil</code>, the substring is a file-namestring, + and its <code>name</code> and <code>type</code> are separated by <code>split-name-type</code>. +3- If <var>type</var> is a string, it is the given <code>type</code>, and the whole string is the <code>name</code>. + + <p>Directory components with an empty name the name <code>.</code> are removed. +Any directory named <code>..</code> is read as <var>dot-dot</var>, +which must be one of <code>:back</code> or <code>:up</code> and defaults to <code>:back</code>. + + <p><code>host</code>, <code>device</code> and <code>version</code> components are taken from <var>defaults</var>, +which itself defaults to <code>*nil-pathname*</code>, also used if <var>defaults</var> is <code>nil</code>. +No host or device can be specified in the string itself, +which makes it unsuitable for absolute pathnames outside Unix. + + <p>For relative pathnames, these components (and hence the defaults) won't matter +if you use <code>merge-pathnames*</code> but will matter if you use <code>merge-pathnames</code>, +which is an important reason to always use <code>merge-pathnames*</code>. + + <p>Arbitrary keys are accepted, and the parse result is passed to <code>ensure-pathname</code> +with those keys, removing <var>type</var>, <var>defaults</var> and <var>dot-dot</var>. +When you're manipulating pathnames that are supposed to make sense portably +even though the OS may not be Unixish, we recommend you use <code>:want-relative t</code> +to throw an error if the pathname is absolute +</p></blockquote></div> + +<div class="defun"> +— Function: <b>merge-pathnames*</b><var> specified &optional defaults<a name="index-merge_002dpathnames_002a-80"></a></var><br> +<blockquote> + <p>This function is a replacement for <code>merge-pathnames</code> that uses the host and device +from the <var>defaults</var> rather than the <var>specified</var> pathname when the latter +is a relative pathname. This allows ASDF and its users to create and use relative pathnames +without having to know beforehand what are the host and device +of the absolute pathnames they are relative to. + + </blockquote></div> + +<div class="defun"> +— Function: <b>subpathname</b><var> pathname subpath &key type<a name="index-subpathname-81"></a></var><br> +<blockquote> + <p>This function takes a <var>pathname</var> and a <var>subpath</var> and a <var>type</var>. +If <var>subpath</var> is already a <code>pathname</code> object (not namestring), +and is an absolute pathname at that, it is returned unchanged; +otherwise, <var>subpath</var> is turned into a relative pathname with given <var>type</var> +as per <code>parse-unix-namestring</code> with <code>:want-relative t :type </code><var>type</var>, +then it is merged with the <code>pathname-directory-pathname</code> of <var>pathname</var>, +as per <code>merge-pathnames*</code>. + + <p>We strongly encourage the use of this function +for portably resolving relative pathnames in your code base. +</p></blockquote></div> + +<div class="defun"> +— Function: <b>subpathname*</b><var> pathname subpath &key type<a name="index-subpathname_002a-82"></a></var><br> +<blockquote> + <p>This function returns <code>nil</code> if the base <var>pathname</var> is <code>nil</code>, +otherwise acts like <code>subpathname</code>. +</p></blockquote></div> + +<div class="defun"> +— Function: <b>run-program</b><var> command &key ignore-error-status force-shell input output error-output<a name="index-run_002dprogram-83"></a></var><br> +<blockquote><p> if-input-does-not-exist if-output-exists if-error-output-exists + element-type external-format &allow-other-keys + + <p><code>run-program</code> takes a <var>command</var> argument that is either +a list of a program name or path and its arguments, +or a string to be executed by a shell. +It spawns the command, waits for it to return, +verifies that it exited cleanly (unless told not too below), +and optionally captures and processes its output. +It accepts many keyword arguments to configure its behavior. + + <p><code>run-program</code> returns three values: the first for the output, +the second for the error-output, and the third for the return value. +(Beware that before ASDF 3.0.2.11, it didn't handle input or error-output, +and returned only one value, +the one for the output if any handler was specified, or else the exit code; +please upgrade ASDF, or at least UIOP, to rely on the new enhanced behavior.) + + <p><var>output</var> is its most important argument; +it specifies how the output is captured and processed. +If it is <code>nil</code>, then the output is redirected to the null device, +that will discard it. +If it is <code>:interactive</code>, then it is inherited from the current process +(beware: this may be different from your <var>*standard-output*</var>, +and under SLIME will be on your <code>*inferior-lisp*</code> buffer). +If it is <code>t</code>, output goes to your current <var>*standard-output*</var> stream. +Otherwise, <var>output</var> should be a value that is a suitable first argument to +<code>slurp-input-stream</code> (see below), or +a list of such a value and keyword arguments. +In this case, <code>run-program</code> will +create a temporary stream for the program output; +the program output, in that stream, +will be processed by a call to <code>slurp-input-stream</code>, +using <var>output</var> as the first argument +(or if it's a list the first element of <var>output</var> and the rest as keywords). +The primary value resulting from that call +(or <code>nil</code> if no call was needed) +will be the first value returned by <code>run-program</code>. +E.g., using <code>:output :string</code> +will have it return the entire output stream as a string. +And using <code>:output '(:string :stripped t)</code> +will have it return the same string stripped of any ending newline. + + <p><var>error-output</var> is similar to <var>output</var>, except that +the resulting value is returned as the second value of <code>run-program</code>. +<code>t</code> designates the <var>*error-output*</var>. +Also <code>:output</code> means redirecting the error output to the output stream, +in which case <code>nil</code> is returned. + + <p><var>input</var> is similar to <var>output</var>, except that +<code>vomit-output-stream</code> is used, no value is returned, +and <code>t</code> designates the <var>*standard-input*</var>. + + <p><code>element-type</code> and <code>external-format</code> are passed on +to your Lisp implementation, when applicable, for creation of the output stream. + + <p>One and only one of the stream slurping or vomiting may or may not happen +in parallel in parallel with the subprocess, +depending on options and implementation, +and with priority being given to output processing. +Other streams are completely produced or consumed +before or after the subprocess is spawned, using temporary files. + + <p><code>force-shell</code> forces evaluation of the command through a shell, +even if it was passed as a list rather than a string. +If a shell is used, it is <samp><span class="file">/bin/sh</span></samp> on Unix or <samp><span class="file">CMD.EXE</span></samp> on Windows, +except on implementations that (erroneously, IMNSHO) +insist on consulting <code>$SHELL</code> like clisp. + + <p><code>ignore-error-status</code> causes <code>run-program</code> +to not raise an error if the spawned program exits in error. +Following POSIX convention, an error is anything but +a normal exit with status code zero. +By default, an error of type <code>subprocess-error</code> is raised in this case. + + <p><code>run-program</code> works on all platforms supported by ASDF, except Genera. +See the source code for more documentation. + + </blockquote></div> + +<div class="defun"> +— Function: <b>slurp-input-stream</b><var> processor input-stream &key<a name="index-slurp_002dinput_002dstream-84"></a></var><br> +<blockquote> + <p>It's a generic function of two arguments, a target object and an input stream, +and accepting keyword arguments. +Predefined methods based on the target object are as follow: + + <p>If the object is a function, the function is called with the stream as argument. + + <p>If the object is a cons, its first element is applied to its rest appended by +a list of the input stream. + + <p>If the object is an output stream, the contents of the input stream are copied to it. +If the <var>linewise</var> keyword argument is provided, copying happens line by line, +and an optional <var>prefix</var> is printed before each line. +Otherwise, copying happen based on a buffer of size <var>buffer-size</var>, +using the specified <var>element-type</var>. + + <p>If the object is <code>'string</code> or <code>:string</code>, the content is captured into a string. +Accepted keywords include the <var>element-type</var> and a flag <var>stripped</var>, +which when true causes any single line ending to be removed as per <code>uiop:stripln</code>. + + <p>If the object is <code>:lines</code>, the content is captured as a list of strings, +one per line, without line ending. If the <var>count</var> keyword argument is provided, +it is a maximum count of lines to be read. + + <p>If the object is <code>:line</code>, the content is capture as with <code>:lines</code> above, +and then its sub-object is extracted with the <var>at</var> argument, +which defaults to <code>0</code>, extracting the first line. +A number will extract the corresponding line. +See the documentation for <code>uiop:access-at</code>. + + <p>If the object is <code>:forms</code>, the content is captured as a list of S-expressions, +as read by the Lisp reader. +If the <var>count</var> argument is provided, +it is a maximum count of lines to be read. +We recommend you control the syntax with such macro as +<code>uiop:with-safe-io-syntax</code>. + + <p>If the object is <code>:form</code>, the content is capture as with <code>:forms</code> above, +and then its sub-object is extracted with the <var>at</var> argument, +which defaults to <code>0</code>, extracting the first form. +A number will extract the corresponding form. +See the documentation for <code>uiop:access-at</code>. +We recommend you control the syntax with such macro as +<code>uiop:with-safe-io-syntax</code>. + + </blockquote></div> + +<p><a name="Getting-the-latest-version"></a> + + +<h2 class="chapter">11 Getting the latest version</h2> + +<p>Decide which version you want. +The <code>master</code> branch is where development happens; +its <code>HEAD</code> is usually OK, including the latest fixes and portability tweaks, +but an occasional regression may happen despite our (limited) test suite. + + <p>The <code>release</code> branch is what cautious people should be using; +it has usually been tested more, and releases are cut at a point +where there isn't any known unresolved issue. + + <p>You may get the ASDF source repository using git: +<kbd>git clone git://common-lisp.net/projects/asdf/asdf.git</kbd> + + <p>You will find the above referenced tags in this repository. +You can also browse the repository on +<a href="http://common-lisp.net/gitweb?p=projects/asdf/asdf.git">http://common-lisp.net/gitweb?p=projects/asdf/asdf.git</a>. + + <p>Discussion of ASDF development is conducted on the +mailing list +<kbd>asdf-devel(a)common-lisp.net</kbd>. +<a href="http://common-lisp.net/cgi-bin/mailman/listinfo/asdf-devel">http://common-lisp.net/cgi-bin/mailman/listinfo/asdf-devel</a> + +<p><a name="FAQ"></a> + + +<h2 class="chapter">12 FAQ</h2> + +<h3 class="section">12.1 “Where do I report a bug?”</h3> + +<p>ASDF bugs are tracked on launchpad: <a href="https://launchpad.net/asdf">https://launchpad.net/asdf</a>. + + <p>If you're unsure about whether something is a bug, or for general discussion, +use the <a href="http://common-lisp.net/cgi-bin/mailman/listinfo/asdf-devel">asdf-devel mailing list</a> + +<h3 class="section">12.2 “What has changed between ASDF 1 and ASDF 2?”</h3> + +<h4 class="subsection">12.2.1 What are ASDF 1 and ASDF 2?</h4> + +<p>On May 31st 2010, we have released ASDF 2. +ASDF 2 refers to release 2.000 and later. +(Releases between 1.656 and 1.728 were development releases for ASDF 2.) +ASDF 1 to any release earlier than 1.369 or so. +If your ASDF doesn't sport a version, it's an old ASDF 1. + + <p>ASDF 2 and its release candidates push +<code>:asdf2</code> onto <code>*features*</code> so that if you are writing +ASDF-dependent code you may check for this feature +to see if the new API is present. +<em>All</em> versions of ASDF should have the <code>:asdf</code> feature. + + <p>Additionally, all versions of ASDF 2 +define a function <code>(asdf:asdf-version)</code> you may use to query the version; +and the source code of recent versions of ASDF 2 features the version number +prominently on the second line of its source code. + + <p>If you are experiencing problems or limitations of any sort with ASDF 1, +we recommend that you should upgrade to ASDF 2, +or whatever is the latest release. + +<h4 class="subsection">12.2.2 ASDF can portably name files in subdirectories</h4> + +<p>Common Lisp namestrings are not portable, +except maybe for logical pathnamestrings, +that themselves have various limitations and require a lot of setup +that is itself ultimately non-portable. + + <p>In ASDF 1, the only portable ways to refer to pathnames inside systems and components +were very awkward, using <code>#.(make-pathname ...)</code> and +<code>#.(merge-pathnames ...)</code>. +Even the above were themselves were inadequate in the general case +due to host and device issues, unless horribly complex patterns were used. +Plenty of simple cases that looked portable actually weren't, +leading to much confusion and greavance. + + <p>ASDF 2 implements its own portable syntax for strings as pathname specifiers. +Naming files within a system definition becomes easy and portable again. +See <a href="#Miscellaneous-additional-functionality">asdf:system-relative-pathname</a>, +<code>merge-pathnames*</code>, +<code>coerce-pathname</code>. + + <p>On the other hand, there are places where systems used to accept namestrings +where you must now use an explicit pathname object: +<code>(defsystem ... :pathname "LOGICAL-HOST:PATH;TO;SYSTEM;" ...)</code> +must now be written with the <code>#p</code> syntax: +<code>(defsystem ... :pathname #p"LOGICAL-HOST:PATH;TO;SYSTEM;" ...)</code> + + <p>See <a href="#The-defsystem-grammar">Pathname specifiers</a>. + +<h4 class="subsection">12.2.3 Output translations</h4> + +<p>A popular feature added to ASDF was output pathname translation: +<code>asdf-binary-locations</code>, <code>common-lisp-controller</code>, +<code>cl-launch</code> and other hacks were all implementing it in ways +both mutually incompatible and difficult to configure. + + <p>Output pathname translation is essential to share +source directories of portable systems across multiple implementations +or variants thereof, +or source directories of shared installations of systems across multiple users, +or combinations of the above. + + <p>In ASDF 2, a standard mechanism is provided for that, +<code>asdf-output-translations</code>, +with sensible defaults, adequate configuration languages, +a coherent set of configuration files and hooks, +and support for non-Unix platforms. + + <p>See <a href="#Controlling-where-ASDF-saves-compiled-files">Controlling where ASDF saves compiled files</a>. + +<h4 class="subsection">12.2.4 Source Registry Configuration</h4> + +<p>Configuring ASDF used to require special magic +to be applied just at the right moment, +between the moment ASDF is loaded and the moment it is used, +in a way that is specific to the user, +the implementation he is using and the application he is building. + + <p>This made for awkward configuration files and startup scripts +that could not be shared between users, managed by administrators +or packaged by distributions. + + <p>ASDF 2 provides a well-documented way to configure ASDF, +with sensible defaults, adequate configuration languages, +and a coherent set of configuration files and hooks. + + <p>We believe it's a vast improvement because it decouples +application distribution from library distribution. +The application writer can avoid thinking where the libraries are, +and the library distributor (dpkg, clbuild, advanced user, etc.) +can configure them once and for every application. +Yet settings can be easily overridden where needed, +so whoever needs control has exactly as much as required. + + <p>At the same time, ASDF 2 remains compatible +with the old magic you may have in your build scripts +(using <code>*central-registry*</code> and +<code>*system-definition-search-functions*</code>) +to tailor the ASDF configuration to your build automation needs, +and also allows for new magic, simpler and more powerful magic. + + <p>See <a href="#Controlling-where-ASDF-searches-for-systems">Controlling where ASDF searches for systems</a>. + +<h4 class="subsection">12.2.5 Usual operations are made easier to the user</h4> + +<p>In ASDF 1, you had to use the awkward syntax +<code>(asdf:oos 'asdf:load-op :foo)</code> +to load a system, +and similarly for <code>compile-op</code>, <code>test-op</code>. + + <p>In ASDF 2, you can use shortcuts for the usual operations: +<code>(asdf:load-system :foo)</code>, and +similarly for <code>compile-system</code>, <code>test-system</code>. + +<h4 class="subsection">12.2.6 Many bugs have been fixed</h4> + +<p>The following issues and many others have been fixed: + + <ul> +<li>The infamous TRAVERSE function has been revamped completely +between ASDF 1 and ASDF 2, with many bugs squashed. +In particular, dependencies were not correctly propagated +across modules but now are. +It has been completely rewritten many times over +between ASDF 2.000 and ASDF 3, +with fundamental issues in the original model being fixed. +Timestamps were not propagated at all, and now are. +The internal model of how actions depend on each other +is now both consistent and complete. +The :version and +the :force (system1 .. systemN) feature have been fixed. + + <li>Performance has been notably improved for large systems +(say with thousands of components) by using +hash-tables instead of linear search, +and linear-time list accumulation +instead of quadratic-time recursive appends. + + <li>Many features used to not be portable, +especially where pathnames were involved. +Windows support was notably quirky because of such non-portability. + + <li>The internal test suite used to massively fail on many implementations. +While still incomplete, it now fully passes +on all implementations supported by the test suite, +except for GCL (due to GCL bugs). + + <li>Support was lacking for some implementations. +ABCL and GCL were notably wholly broken. +ECL extensions were not integrated with ASDF release. + + <li>The documentation was grossly out of date. + + </ul> + +<h4 class="subsection">12.2.7 ASDF itself is versioned</h4> + +<p>Between new features, old bugs fixed, and new bugs introduced, +there were various releases of ASDF in the wild, +and no simple way to check which release had which feature set. +People using or writing systems had to either make worst-case assumptions +as to what features were available and worked, +or take great pains to have the correct version of ASDF installed. + + <p>With ASDF 2, we provide a new stable set of working features +that everyone can rely on from now on. +Use <code>#+asdf2</code> to detect presence of ASDF 2, +<code>(asdf:version-satisfies (asdf:asdf-version) "2.345.67")</code> +to check the availability of a version no earlier than required. + +<h4 class="subsection">12.2.8 ASDF can be upgraded</h4> + +<p>When an old version of ASDF was loaded, +it was very hard to upgrade ASDF in your current image +without breaking everything. +Instead you had to exit the Lisp process and +somehow arrange to start a new one from a simpler image. +Something that can't be done from within Lisp, +making automation of it difficult, +which compounded with difficulty in configuration, +made the task quite hard. +Yet as we saw before, the task would have been required +to not have to live with the worst case or non-portable +subset of ASDF features. + + <p>With ASDF 2, it is easy to upgrade +from ASDF 2 to later versions from within Lisp, +and not too hard to upgrade from ASDF 1 to ASDF 2 from within Lisp. +We support hot upgrade of ASDF and any breakage is a bug +that we will do our best to fix. +There are still limitations on upgrade, though, +most notably the fact that after you upgrade ASDF, +you must also reload or upgrade all ASDF extensions. + +<h4 class="subsection">12.2.9 Decoupled release cycle</h4> + +<p>When vendors were releasing their Lisp implementations with ASDF, +they had to basically never change version +because neither upgrade nor downgrade was possible +without breaking something for someone, +and no obvious upgrade path was visible and recommendable. + + <p>With ASDF 2, upgrade is possible, easy and can be recommended. +This means that vendors can safely ship a recent version of ASDF, +confident that if a user isn't fully satisfied, +he can easily upgrade ASDF and deal +with a supported recent version of it. +This means that release cycles will be causally decoupled, +the practical consequence of which will mean faster convergence +towards the latest version for everyone. + +<h4 class="subsection">12.2.10 Pitfalls of the transition to ASDF 2</h4> + +<p>The main pitfalls in upgrading to ASDF 2 seem to be related +to the output translation mechanism. + + <ul> +<li>Output translations is enabled by default. This may surprise some users, +most of them in pleasant way (we hope), a few of them in an unpleasant way. +It is trivial to disable output translations. +See <a href="#FAQ">“How can I wholly disable the compiler output cache?”</a>. + + <li>Some systems in the large have been known +not to play well with output translations. +They were relatively easy to fix. +Once again, it is also easy to disable output translations, +or to override its configuration. + + <li>The new ASDF output translations are incompatible with ASDF-Binary-Locations. +They replace A-B-L, and there is compatibility mode to emulate +your previous A-B-L configuration. +See <code>enable-asdf-binary-locations-compatibility</code> in +see <a href="#Controlling-where-ASDF-saves-compiled-files">Backward Compatibility</a>. +But thou shalt not load ABL on top of ASDF 2. + + </ul> + + <p>Other issues include the following: + + <ul> +<li>ASDF pathname designators are now specified +in places where they were unspecified, +and a few small adjustments have to be made to some non-portable defsystems. +Notably, in the <code>:pathname</code> argument +to a <code>defsystem</code> and its components, +a logical pathname (or implementation-dependent hierarchical pathname) +must now be specified with <code>#p</code> syntax +where the namestring might have previously sufficed; +moreover when evaluation is desired <code>#.</code> must be used, +where it wasn't necessary in the toplevel <code>:pathname</code> argument +(but necessary in other <code>:pathname</code> arguments). + + <li>There is a slight performance bug, notably on SBCL, +when initially searching for <samp><span class="file">asd</span></samp> files, +the implicit <code>(directory "/configured/path/**/*.asd")</code> +for every configured path <code>(:tree "/configured/path/")</code> +in your <code>source-registry</code> configuration can cause a slight pause. +Try to <code>(time (asdf:initialize-source-registry))</code> +to see how bad it is or isn't on your system. +If you insist on not having this pause, +you can avoid the pause by overriding the default source-registry configuration +and not use any deep <code>:tree</code> entry but only <code>:directory</code> entries +or shallow <code>:tree</code> entries. +Or you can fix your implementation to not be quite that slow +when recursing through directories. +<em>Update</em>: This performance bug fixed the hard way in 2.010. + + <li>On Windows, only LispWorks supports proper default configuration pathnames +based on the Windows registry. +Other implementations make do with environment variables, +that you may have to define yourself +if you're using an older version of Windows. +Windows support is somewhat less tested than Unix support. +Please help report and fix bugs. +<em>Update</em>: As of ASDF 2.21, all implementations +should now use the same proper default configuration pathnames +and they should actually work, though they haven't all been tested. + + <li>The mechanism by which one customizes a system so that Lisp files +may use a different extension from the default <samp><span class="file">.lisp</span></samp> has changed. +Previously, the pathname for a component +was lazily computed when operating on a system, +and you would +<code>(defmethod source-file-type ((component cl-source-file) (system (eql (find-system 'foo)))) + (declare (ignorable component system)) "lis")</code>. +Now, the pathname for a component is eagerly computed when defining the system, +and instead you will <code>(defclass cl-source-file.lis (cl-source-file) ((type :initform "lis")))</code> +and use <code>:default-component-class cl-source-file.lis</code> +as argument to <code>defsystem</code>, +as detailed in a see <a href="#FAQ">How do I create a system definition where all the source files have a .cl extension?</a> below. + + <p><a name="index-source_002dfile_002dtype-85"></a> + + </ul> + +<h3 class="section">12.3 Issues with installing the proper version of ASDF</h3> + +<h4 class="subsection">12.3.1 “My Common Lisp implementation comes with an outdated version of ASDF. What to do?”</h4> + +<p>We recommend you upgrade ASDF. +See <a href="#Loading-ASDF">Upgrading ASDF</a>. + + <p>If this does not work, it is a bug, and you should report it. +See <a href="#FAQ">report-bugs</a>. +In the meantime, you can load <samp><span class="file">asdf.lisp</span></samp> directly. +See <a href="#Loading-ASDF">Loading an otherwise installed ASDF</a>. + +<h4 class="subsection">12.3.2 “I'm a Common Lisp implementation vendor. When and how should I upgrade ASDF?”</h4> + +<p>Since ASDF 2, +it should always be a good time to upgrade to a recent version of ASDF. +You may consult with the maintainer for which specific version they recommend, +but the latest <code>release</code> should be correct. +We trust you to thoroughly test it with your implementation +before you release it. +If there are any issues with the current release, +it's a bug that you should report upstream and that we will fix ASAP. + + <p>As to how to include ASDF, we recommend the following: + + <ul> +<li>If ASDF isn't loaded yet, then <code>(require "asdf")</code> +should load the version of ASDF that is bundled with your system. +If possible so should <code>(require "ASDF")</code>. +You may have it load some other version configured by the user, +if you allow such configuration. + + <li>If your system provides a mechanism to hook into <code>CL:REQUIRE</code>, +then it would be nice to add ASDF to this hook the same way that +ABCL, CCL, CLISP, CMUCL, ECL, SBCL and SCL do it. +Please send us appropriate code to this end. + + <li>You may, like SBCL, have ASDF be implicitly used to require systems +that are bundled with your Lisp distribution. +If you do have a few magic systems that come with your implementation +in a precompiled way such that one should only use the binary version +that goes with your distribution, like SBCL does, +then you should add them in the beginning of <code>wrapping-source-registry</code>. + + <li>If you have magic systems as above, like SBCL does, +then we explicitly ask you to <em>NOT</em> distribute +<samp><span class="file">asdf.asd</span></samp> as part of those magic systems. +You should still include the file <samp><span class="file">asdf.lisp</span></samp> in your source distribution +and precompile it in your binary distribution, +but <samp><span class="file">asdf.asd</span></samp> if included at all, +should be secluded from the magic systems, +in a separate file hierarchy. +Alternatively, you may provide the system +after renaming it and its <samp><span class="file">.asd</span></samp> file to e.g. +<code>asdf-ecl</code> and <samp><span class="file">asdf-ecl.asd</span></samp>, or +<code>sb-asdf</code> and <samp><span class="file">sb-asdf.asd</span></samp>. +Indeed, if you made <samp><span class="file">asdf.asd</span></samp> a magic system, +then users would no longer be able to upgrade ASDF using ASDF itself +to some version of their preference that +they maintain independently from your Lisp distribution. + + <li>If you do not have any such magic systems, or have other non-magic systems +that you want to bundle with your implementation, +then you may add them to the <code>wrapping-source-registry</code>, +and you are welcome to include <samp><span class="file">asdf.asd</span></samp> amongst them. +Non-magic systems should be at the back of the <code>wrapping-source-registry</code> +while magic systems are at the front. + + <li>Please send us upstream any patches you make to ASDF itself, +so we can merge them back in for the benefit of your users +when they upgrade to the upstream version. + + </ul> + +<h3 class="section">12.4 Issues with configuring ASDF</h3> + +<h4 class="subsection">12.4.1 “How can I customize where fasl files are stored?”</h4> + +<p>See <a href="#Controlling-where-ASDF-saves-compiled-files">Controlling where ASDF saves compiled files</a>. + + <p>Note that in the past there was an add-on to ASDF called +<code>ASDF-binary-locations</code>, developed by Gary King. +That add-on has been merged into ASDF proper, +then superseded by the <code>asdf-output-translations</code> facility. + + <p>Note that use of <code>asdf-output-translations</code> +can interfere with one aspect of your systems +— if your system uses <code>*load-truename*</code> to find files +(e.g., if you have some data files stored with your program), +then the relocation that this ASDF customization performs +is likely to interfere. +Use <code>asdf:system-relative-pathname</code> to locate a file +in the source directory of some system, and +use <code>asdf:apply-output-translations</code> to locate a file +whose pathname has been translated by the facility. + +<h4 class="subsection">12.4.2 “How can I wholly disable the compiler output cache?”</h4> + +<p>To permanently disable the compiler output cache +for all future runs of ASDF, you can: + +<pre class="example"> mkdir -p ~/.config/common-lisp/asdf-output-translations.conf.d/ + echo ':disable-cache' > ~/.config/common-lisp/asdf-output-translations.conf.d/99-disable-cache.conf +</pre> + <p>This assumes that you didn't otherwise configure the ASDF files +(if you did, edit them again), +and don't somehow override the configuration at runtime +with a shell variable (see below) or some other runtime command +(e.g. some call to <code>asdf:initialize-output-translations</code>). + + <p>To disable the compiler output cache in Lisp processes +run by your current shell, try (assuming <code>bash</code> or <code>zsh</code>) +(on Unix and cygwin only): + +<pre class="example"> export ASDF_OUTPUT_TRANSLATIONS=/: +</pre> + <p>To disable the compiler output cache just in the current Lisp process, +use (after loading ASDF but before using it): + +<pre class="example"> (asdf:disable-output-translations) +</pre> + <h3 class="section">12.5 Issues with using and extending ASDF to define systems</h3> + +<h4 class="subsection">12.5.1 “How can I cater for unit-testing in my system?”</h4> + +<p>ASDF provides a predefined test operation, <code>test-op</code>. +See <a href="#Predefined-operations-of-ASDF">test-op</a>. +The test operation, however, is largely left to the system definer to specify. +<code>test-op</code> has been +a topic of considerable discussion on the +<a href="http://common-lisp.net/cgi-bin/mailman/listinfo/asdf-devel">asdf-devel mailing list</a>, +and on the +<a href="https://launchpad.net/asdf">launchpad bug-tracker</a>. + + <p>Here are some guidelines: + + <ul> +<li>For a given system, <var>foo</var>, you will want to define a corresponding +test system, such as <var>foo-test</var>. The reason that you will want this +separate system is that ASDF does not out of the box supply components +that are conditionally loaded. So if you want to have source files +(with the test definitions) that will not be loaded except when testing, +they should be put elsewhere. + + <li>The <var>foo-test</var> system can be defined in an asd file of its own or +together with <var>foo</var>. An aesthetic preference against cluttering up +the filesystem with extra asd files should be balanced against the +question of whether one might want to directly load <var>foo-test</var>. +Typically one would not want to do this except in early stages of +debugging. + + <li>Record that testing is implemented by <var>foo-test</var>. For example: + <pre class="example"> (defsystem <var>foo</var> + :in-order-to ((test-op (test-op <var>foo-test</var>))) + ....) + + (defsystem <var>foo-test</var> + :depends-on (<var>foo</var> <var>my-test-library</var> ...) + ....) +</pre> + </ul> + + <p>This procedure will allow you to support users who do not wish to +install your test framework. + + <p>One oddity of ASDF is that <code>operate</code> (see <a href="#Operations">operate</a>) +does not return a value. So in current versions of ASDF there is no +reliable programmatic means of determining whether or not a set of tests +has passed, or which tests have failed. The user must simply read the +console output. This limitation has been the subject of much +discussion. + +<h4 class="subsection">12.5.2 “How can I cater for documentation generation in my system?”</h4> + +<p>The ASDF developers are currently working to add a <code>doc-op</code> +to the set of predefined ASDF operations. +See <a href="#Predefined-operations-of-ASDF">Predefined operations of ASDF</a>. +See also <a href="https://bugs.launchpad.net/asdf/+bug/479470">https://bugs.launchpad.net/asdf/+bug/479470</a>. + +<h4 class="subsection">12.5.3 “How can I maintain non-Lisp (e.g. C) source files?”</h4> + +<p>See <code>cffi</code>'s <code>cffi-grovel</code>. + + <p><a name="report_002dbugs"></a> + +<h4 class="subsection">12.5.4 “I want to put my module's files at the top level. How do I do this?”</h4> + +<p>By default, the files contained in an asdf module go +in a subdirectory with the same name as the module. +However, this can be overridden by adding a <code>:pathname ""</code> argument +to the module description. +For example, here is how it could be done +in the spatial-trees ASDF system definition for ASDF 2: + +<pre class="example"> (asdf:defsystem :spatial-trees + :components + ((:module base + :pathname "" + :components + ((:file "package") + (:file "basedefs" :depends-on ("package")) + (:file "rectangles" :depends-on ("package")))) + (:module tree-impls + :depends-on (base) + :pathname "" + :components + ((:file "r-trees") + (:file "greene-trees" :depends-on ("r-trees")) + (:file "rstar-trees" :depends-on ("r-trees")) + (:file "rplus-trees" :depends-on ("r-trees")) + (:file "x-trees" :depends-on ("r-trees" "rstar-trees")))) + (:module viz + :depends-on (base) + :pathname "" + :components + ((:static-file "spatial-tree-viz.lisp"))) + (:module tests + :depends-on (base) + :pathname "" + :components + ((:static-file "spatial-tree-test.lisp"))) + (:static-file "LICENCE") + (:static-file "TODO"))) +</pre> + <p>All of the files in the <code>tree-impls</code> module are at the top level, +instead of in a <samp><span class="file">tree-impls/</span></samp> subdirectory. + + <p>Note that the argument to <code>:pathname</code> can be either a pathname object or a string. +A pathname object can be constructed with the <samp><span class="file">#p"foo/bar/"</span></samp> syntax, +but this is discouraged because the results of parsing a namestring are not portable. +A pathname can only be portably constructed with such syntax as +<code>#.(make-pathname :directory '(:relative "foo" "bar"))</code>, +and similarly the current directory can only be portably specified as +<code>#.(make-pathname :directory '(:relative))</code>. +However, as of ASDF 2, you can portably use a string to denote a pathname. +The string will be parsed as a <code>/</code>-separated path from the current directory, +such that the empty string <code>""</code> denotes the current directory, and +<code>"foo/bar"</code> (no trailing <code>/</code> required in the case of modules) +portably denotes the same subdirectory as above. +When files are specified, the last <code>/</code>-separated component is interpreted +either as the name component of a pathname +(if the component class specifies a pathname type), +or as a name component plus optional dot-separated type component +(if the component class doesn't specifies a pathname type). + +<h4 class="subsection">12.5.5 How do I create a system definition where all the source files have a .cl extension?</h4> + +<p>Starting with ASDF 2.014.14, you may just pass +the builtin class <code>cl-source-file.cl</code> as +the <code>:default-component-class</code> argument to <code>defsystem</code>: + +<pre class="lisp"> (defsystem my-cl-system + :default-component-class cl-source-file.cl + ...) +</pre> + <p>Another builtin class <code>cl-source-file.lsp</code> is offered +for files ending in <samp><span class="file">.lsp</span></samp>. + + <p>If you want to use a different extension +for which ASDF doesn't provide builtin support, +or want to support versions of ASDF +earlier than 2.014.14 (but later than 2.000), +you can define a class as follows: + +<pre class="lisp"> ;; Prologue: make sure we're using a sane package. + (defpackage :my-asdf-extension + (:use :asdf :common-lisp) + (:export #:cl-source-file.lis)) + (in-package :my-asdf-extension) + + (defclass cl-source-file.lis (cl-source-file) + ((type :initform "lis"))) +</pre> + <p>Then you can use it as follows: +<pre class="lisp"> (defsystem my-cl-system + :default-component-class my-asdf-extension:cl-source-file.lis + ...) +</pre> + <p>Of course, if you're in the same package, e.g. in the same file, +you won't need to use the package qualifier before <code>cl-source-file.lis</code>. +Actually, if all you're doing is defining this class +and using it in the same file without other fancy definitions, +you might skip package complications: + +<pre class="lisp"> (in-package :asdf) + (defclass cl-source-file.lis (cl-source-file) + ((type :initform "lis"))) + (defsystem my-cl-system + :default-component-class cl-source-file.lis + ...) +</pre> + <p>It is possible to achieve the same effect +in a way that supports both ASDF 1 and ASDF 2, +but really, friends don't let friends use ASDF 1. +Please upgrade to ASDF 3. +In short, though: do same as above, but +<em>before</em> you use the class in a <code>defsystem</code>, +you also define the following method: + +<pre class="lisp"> (defmethod source-file-type ((f cl-source-file.lis) (s system)) + (declare (ignorable f s)) + "lis") +</pre> +  +<p><a name="TODO-list"></a> + + +<h2 class="chapter">13 TODO list</h2> + +<p>Here is an old list of things to do, +in addition to the bugs that are now tracked on launchpad: +<a href="https://launchpad.net/asdf">https://launchpad.net/asdf</a>. + +<h3 class="section">13.1 Outstanding spec questions, things to add</h3> + +<p>** packaging systems + + <p>*** manual page component? + + <p>** style guide for .asd files + + <p>You should either use keywords or be careful +with the package that you evaluate defsystem forms in. +Otherwise <code>(defsystem partition ...)</code> +being read in the <code>cl-user</code> package +will intern a <code>cl-user:partition</code> symbol, +which will then collide with the <code>partition:partition</code> symbol. + + <p>Actually there's a hairier packages problem to think about too. +<code>in-order-to</code> is not a keyword: +if you read <code>defsystem</code> forms in a package that doesn't use ASDF, +odd things might happen. + + <p>** extending defsystem with new options + + <p>You might not want to write a whole parser, +but just to add options to the existing syntax. +Reinstate <code>parse-option</code> or something akin. + + <p>** Diagnostics + + <p>A “dry run” of an operation can be made with the following form: + +<pre class="lisp"> (let ((asdf::*verbose-out* *standard-output*)) + (loop :for (op . comp) :in + (asdf::traverse (make-instance '<operation-name> :force t) + (asdf:find-system <system-name>)) + :do (asdf:explain op comp))) +</pre> + <p>This uses unexported symbols. +What would be a nice interface for this functionality? + +<h3 class="section">13.2 Missing bits in implementation</h3> + +<p>** reuse the same scratch package whenever a system is reloaded from disk + + <p>Have a package ASDF-USER instead of all these temporary packages? + + <p>** proclamations probably aren't + + <p>** A revert function + + <p>Other possible interface: have a “revert” function akin to <code>make clean</code>. + +<pre class="lisp"> (asdf:revert 'asdf:compile-op 'araneida) +</pre> + <p>would delete any files produced by <code>(compile-system :araneida)</code>. +Of course, it wouldn't be able to do much about stuff in the image itself. + + <p>How would this work? + + <p><code>traverse</code> + + <p>There's a difference between a module's dependencies (peers) +and its components (children). +Perhaps there's a similar difference in operations? +For example, <code>(load "use") depends-on (load "macros")</code> is a peer, +whereas <code>(load "use") depends-on (compile "use")</code> +is more of a “subservient” relationship. + +<p><a name="Inspiration"></a> + + +<h2 class="chapter">14 Inspiration</h2> + +<h3 class="section">14.1 mk-defsystem (defsystem-3.x)</h3> + +<p>We aim to solve basically the same problems as <code>mk-defsystem</code> does. +However, our architecture for extensibility +better exploits CL language features (and is documented), +and we intend to be portable rather than just widely-ported. +No slight on the <code>mk-defsystem</code> authors and maintainers is intended here; +that implementation has the unenviable task +of supporting pre-ANSI implementations, which is no longer necessary. + + <p>The surface defsystem syntax of asdf is more-or-less compatible with +<code>mk-defsystem</code>, except that we do not support +the <code>source-foo</code> and <code>binary-foo</code> prefixes +for separating source and binary files, and +we advise the removal of all options to specify pathnames. + + <p>The <code>mk-defsystem</code> code for topologically sorting +a module's dependency list was very useful. + +<h3 class="section">14.2 defsystem-4 proposal</h3> + +<p>Marco and Peter's proposal for defsystem 4 served as the driver for +many of the features in here. Notable differences are: + + <ul> +<li>We don't specify output files or output file extensions +as part of the system. + + <p>If you want to find out what files an operation would create, +ask the operation. + + <li>We don't deal with CL packages + + <p>If you want to compile in a particular package, use an <code>in-package</code> form +in that file (ilisp / SLIME will like you more if you do this anyway) + + <li>There is no proposal here that <code>defsystem</code> does version control. + + <p>A system has a given version which can be used to check dependencies, +but that's all. +</ul> + + <p>The defsystem 4 proposal tends to look more at the external features, +whereas this one centres on a protocol for system introspection. + +<h3 class="section">14.3 kmp's “The Description of Large Systems”, MIT AI Memo 801</h3> + +<p>Available in updated-for-CL form on the web at +<a href="http://nhplace.com/kent/Papers/Large-Systems.html">http://nhplace.com/kent/Papers/Large-Systems.html</a> + + <p>In our implementation we borrow kmp's overall <code>PROCESS-OPTIONS</code> +and concept to deal with creating component trees +from <code>defsystem</code> surface syntax. +[ this is not true right now, though it used to be and +probably will be again soon ] + + +<p><a name="Concept-Index"></a> + +<h2 class="unnumbered">Concept Index</h2> + +<ul class="index-cp" compact> +<li><a href="#index-g_t_003aaround_002dcompile-69">:around-compile</a>: <a href="#Miscellaneous-additional-functionality">Miscellaneous additional functionality</a></li> +<li><a href="#index-g_t_003aasdf-5">:asdf</a>: <a href="#Introduction">Introduction</a></li> +<li><a href="#index-g_t_003aasdf2-6">:asdf2</a>: <a href="#Introduction">Introduction</a></li> +<li><a href="#index-g_t_003aasdf3-7">:asdf3</a>: <a href="#Introduction">Introduction</a></li> +<li><a href="#index-g_t_003acompile_002dcheck-72">:compile-check</a>: <a href="#Miscellaneous-additional-functionality">Miscellaneous additional functionality</a></li> +<li><a href="#index-g_t_003adefsystem_002ddepends_002don-21">:defsystem-depends-on</a>: <a href="#The-defsystem-grammar">The defsystem grammar</a></li> +<li><a href="#index-g_t_003aversion-25">:version</a>: <a href="#The-defsystem-grammar">The defsystem grammar</a></li> +<li><a href="#index-g_t_003aversion-46">:version</a>: <a href="#Common-attributes-of-components">Common attributes of components</a></li> +<li><a href="#index-g_t_003aversion-20">:version</a>: <a href="#The-defsystem-form">The defsystem form</a></li> +<li><a href="#index-g_t_003aweakly_002ddepends_002don-22">:weakly-depends-on</a>: <a href="#The-defsystem-grammar">The defsystem grammar</a></li> +<li><a href="#index-around_002dcompile-keyword-70">around-compile keyword</a>: <a href="#Miscellaneous-additional-functionality">Miscellaneous additional functionality</a></li> +<li><a href="#index-ASDF-versions-4">ASDF versions</a>: <a href="#Introduction">Introduction</a></li> +<li><a href="#index-ASDF_002dBINARY_002dLOCATIONS-compatibility-58">ASDF-BINARY-LOCATIONS compatibility</a>: <a href="#Controlling-where-ASDF-saves-compiled-files">Controlling where ASDF saves compiled files</a></li> +<li><a href="#index-asdf_002doutput_002dtranslations-56">asdf-output-translations</a>: <a href="#Controlling-where-ASDF-saves-compiled-files">Controlling where ASDF saves compiled files</a></li> +<li><a href="#index-ASDF_002drelated-features-1">ASDF-related features</a>: <a href="#Introduction">Introduction</a></li> +<li><a href="#index-compile_002dcheck-keyword-71">compile-check keyword</a>: <a href="#Miscellaneous-additional-functionality">Miscellaneous additional functionality</a></li> +<li><a href="#index-component-38">component</a>: <a href="#Components">Components</a></li> +<li><a href="#index-component-designator-41">component designator</a>: <a href="#Components">Components</a></li> +<li><a href="#index-link-farm-9">link farm</a>: <a href="#Loading-ASDF">Loading ASDF</a></li> +<li><a href="#index-logical-pathnames-26">logical pathnames</a>: <a href="#The-defsystem-grammar">The defsystem grammar</a></li> +<li><a href="#index-operation-28">operation</a>: <a href="#Operations">Operations</a></li> +<li><a href="#index-pathname-specifiers-23">pathname specifiers</a>: <a href="#The-defsystem-grammar">The defsystem grammar</a></li> +<li><a href="#index-serial-dependencies-27">serial dependencies</a>: <a href="#The-defsystem-grammar">The defsystem grammar</a></li> +<li><a href="#index-system-39">system</a>: <a href="#Components">Components</a></li> +<li><a href="#index-system-designator-40">system designator</a>: <a href="#Components">Components</a></li> +<li><a href="#index-system-directory-designator-14">system directory designator</a>: <a href="#Loading-ASDF">Loading ASDF</a></li> +<li><a href="#index-Testing-for-ASDF-3">Testing for ASDF</a>: <a href="#Introduction">Introduction</a></li> +<li><a href="#index-version-specifiers-24">version specifiers</a>: <a href="#The-defsystem-grammar">The defsystem grammar</a></li> + </ul><p><a name="Function-and-Class-Index"></a> + +<h2 class="unnumbered">Function and Class Index</h2> + + + +<ul class="index-fn" compact> +<li><a href="#index-already_002dloaded_002dsystems-19"><code>already-loaded-systems</code></a>: <a href="#Using-ASDF">Using ASDF</a></li> +<li><a href="#index-apply_002doutput_002dtranslations-64"><code>apply-output-translations</code></a>: <a href="#Controlling-where-ASDF-saves-compiled-files">Controlling where ASDF saves compiled files</a></li> +<li><a href="#index-clear_002dconfiguration-18"><code>clear-configuration</code></a>: <a href="#Using-ASDF">Using ASDF</a></li> +<li><a href="#index-clear_002doutput_002dtranslations-17"><code>clear-output-translations</code></a>: <a href="#Configuring-ASDF">Configuring ASDF</a></li> +<li><a href="#index-clear_002doutput_002dtranslations-62"><code>clear-output-translations</code></a>: <a href="#Controlling-where-ASDF-saves-compiled-files">Controlling where ASDF saves compiled files</a></li> +<li><a href="#index-clear_002dsource_002dregistry-54"><code>clear-source-registry</code></a>: <a href="#Controlling-where-ASDF-searches-for-systems">Controlling where ASDF searches for systems</a></li> +<li><a href="#index-clear_002dsystem-76"><code>clear-system</code></a>: <a href="#Miscellaneous-additional-functionality">Miscellaneous additional functionality</a></li> +<li><a href="#index-compile_002dfile_002a-73"><code>compile-file*</code></a>: <a href="#Miscellaneous-additional-functionality">Miscellaneous additional functionality</a></li> +<li><a href="#index-g_t_0040code_007bcompile_002dop_007d-31"><code>compile-op</code></a>: <a href="#Predefined-operations-of-ASDF">Predefined operations of ASDF</a></li> +<li><a href="#index-compile_002dsystem-12"><code>compile-system</code></a>: <a href="#Loading-ASDF">Loading ASDF</a></li> +<li><a href="#index-g_t_0040code_007bconcatenate_002dsource_002dop_007d-37"><code>concatenate-source-op</code></a>: <a href="#Predefined-operations-of-ASDF">Predefined operations of ASDF</a></li> +<li><a href="#index-disable_002doutput_002dtranslations-61"><code>disable-output-translations</code></a>: <a href="#Controlling-where-ASDF-saves-compiled-files">Controlling where ASDF saves compiled files</a></li> +<li><a href="#index-enable_002dasdf_002dbinary_002dlocations_002dcompatibility-59"><code>enable-asdf-binary-locations-compatibility</code></a>: <a href="#Controlling-where-ASDF-saves-compiled-files">Controlling where ASDF saves compiled files</a></li> +<li><a href="#index-ensure_002doutput_002dtranslations-63"><code>ensure-output-translations</code></a>: <a href="#Controlling-where-ASDF-saves-compiled-files">Controlling where ASDF saves compiled files</a></li> +<li><a href="#index-ensure_002dsource_002dregistry-55"><code>ensure-source-registry</code></a>: <a href="#Controlling-where-ASDF-searches-for-systems">Controlling where ASDF searches for systems</a></li> +<li><a href="#index-g_t_0040code_007bfasl_002dop_007d-36"><code>fasl-op</code></a>: <a href="#Predefined-operations-of-ASDF">Predefined operations of ASDF</a></li> +<li><a href="#index-find_002dcomponent-44"><code>find-component</code></a>: <a href="#Components">Components</a></li> +<li><a href="#index-find_002dsystem-43"><code>find-system</code></a>: <a href="#Components">Components</a></li> +<li><a href="#index-initialize_002doutput_002dtranslations-60"><code>initialize-output-translations</code></a>: <a href="#Controlling-where-ASDF-saves-compiled-files">Controlling where ASDF saves compiled files</a></li> +<li><a href="#index-initialize_002dsource_002dregistry-53"><code>initialize-source-registry</code></a>: <a href="#Controlling-where-ASDF-searches-for-systems">Controlling where ASDF searches for systems</a></li> +<li><a href="#index-g_t_0040code_007bload_002dop_007d-32"><code>load-op</code></a>: <a href="#Predefined-operations-of-ASDF">Predefined operations of ASDF</a></li> +<li><a href="#index-g_t_0040code_007bload_002dsource_002dop_007d-34"><code>load-source-op</code></a>: <a href="#Predefined-operations-of-ASDF">Predefined operations of ASDF</a></li> +<li><a href="#index-load_002dsystem-10"><code>load-system</code></a>: <a href="#Loading-ASDF">Loading ASDF</a></li> +<li><a href="#index-merge_002dpathnames_002a-80"><code>merge-pathnames*</code></a>: <a href="#Miscellaneous-additional-functionality">Miscellaneous additional functionality</a></li> +<li><a href="#index-module-48"><code>module</code></a>: <a href="#Pre_002ddefined-subclasses-of-component">Pre-defined subclasses of component</a></li> +<li><a href="#index-g_t_0040code_007boos_007d-30"><code>oos</code></a>: <a href="#Operations">Operations</a></li> +<li><a href="#index-oos-16"><code>oos</code></a>: <a href="#Loading-ASDF">Loading ASDF</a></li> +<li><a href="#index-g_t_0040code_007boperate_007d-29"><code>operate</code></a>: <a href="#Operations">Operations</a></li> +<li><a href="#index-operate-15"><code>operate</code></a>: <a href="#Loading-ASDF">Loading ASDF</a></li> +<li><a href="#index-OPERATION_002dERROR-66"><code>OPERATION-ERROR</code></a>: <a href="#Error-handling">Error handling</a></li> +<li><a href="#index-parse_002dunix_002dnamestring-79"><code>parse-unix-namestring</code></a>: <a href="#Miscellaneous-additional-functionality">Miscellaneous additional functionality</a></li> +<li><a href="#index-g_t_0040code_007bprepare_002dop_007d-33"><code>prepare-op</code></a>: <a href="#Predefined-operations-of-ASDF">Predefined operations of ASDF</a></li> +<li><a href="#index-register_002dpreloaded_002dsystem-77"><code>register-preloaded-system</code></a>: <a href="#Miscellaneous-additional-functionality">Miscellaneous additional functionality</a></li> +<li><a href="#index-require_002dsystem-11"><code>require-system</code></a>: <a href="#Loading-ASDF">Loading ASDF</a></li> +<li><a href="#index-run_002dprogram-83"><code>run-program</code></a>: <a href="#Miscellaneous-additional-functionality">Miscellaneous additional functionality</a></li> +<li><a href="#index-run_002dshell_002dcommand-78"><code>run-shell-command</code></a>: <a href="#Miscellaneous-additional-functionality">Miscellaneous additional functionality</a></li> +<li><a href="#index-slurp_002dinput_002dstream-84"><code>slurp-input-stream</code></a>: <a href="#Miscellaneous-additional-functionality">Miscellaneous additional functionality</a></li> +<li><a href="#index-source_002dfile-47"><code>source-file</code></a>: <a href="#Pre_002ddefined-subclasses-of-component">Pre-defined subclasses of component</a></li> +<li><a href="#index-source_002dfile_002dtype-85"><code>source-file-type</code></a>: <a href="#FAQ">FAQ</a></li> +<li><a href="#index-subpathname-81"><code>subpathname</code></a>: <a href="#Miscellaneous-additional-functionality">Miscellaneous additional functionality</a></li> +<li><a href="#index-subpathname_002a-82"><code>subpathname*</code></a>: <a href="#Miscellaneous-additional-functionality">Miscellaneous additional functionality</a></li> +<li><a href="#index-system-49"><code>system</code></a>: <a href="#Pre_002ddefined-subclasses-of-component">Pre-defined subclasses of component</a></li> +<li><a href="#index-SYSTEM_002dDEFINITION_002dERROR-65"><code>SYSTEM-DEFINITION-ERROR</code></a>: <a href="#Error-handling">Error handling</a></li> +<li><a href="#index-system_002drelative_002dpathname-74"><code>system-relative-pathname</code></a>: <a href="#Miscellaneous-additional-functionality">Miscellaneous additional functionality</a></li> +<li><a href="#index-system_002dsource_002ddirectory-75"><code>system-source-directory</code></a>: <a href="#Miscellaneous-additional-functionality">Miscellaneous additional functionality</a></li> +<li><a href="#index-g_t_0040code_007btest_002dop_007d-35"><code>test-op</code></a>: <a href="#Predefined-operations-of-ASDF">Predefined operations of ASDF</a></li> +<li><a href="#index-test_002dsystem-13"><code>test-system</code></a>: <a href="#Loading-ASDF">Loading ASDF</a></li> +<li><a href="#index-g_t_0040var_007bversion_007d-51"><var>version</var></a>: <a href="#Functions">Functions</a></li> +<li><a href="#index-version_002dsatisfies-50"><code>version-satisfies</code></a>: <a href="#Functions">Functions</a></li> +<li><a href="#index-version_002dsatisfies-45"><code>version-satisfies</code></a>: <a href="#Common-attributes-of-components">Common attributes of components</a></li> + </ul><p><a name="Variable-Index"></a> + +<h2 class="unnumbered">Variable Index</h2> + + + +<ul class="index-vr" compact> +<li><a href="#index-g_t_002acentral_002dregistry_002a-8"><code>*central-registry*</code></a>: <a href="#Loading-ASDF">Loading ASDF</a></li> +<li><a href="#index-g_t_002acompile_002dfile_002derrors_002dbehavior_002a-68"><code>*compile-file-errors-behavior*</code></a>: <a href="#Error-handling">Error handling</a></li> +<li><a href="#index-g_t_002acompile_002dfile_002dwarnings_002dbehaviour_002a-67"><code>*compile-file-warnings-behaviour*</code></a>: <a href="#Error-handling">Error handling</a></li> +<li><a href="#index-g_t_002adefault_002dsource_002dregistry_002dexclusions_002a-52"><code>*default-source-registry-exclusions*</code></a>: <a href="#Controlling-where-ASDF-searches-for-systems">Controlling where ASDF searches for systems</a></li> +<li><a href="#index-g_t_002afeatures_002a-2"><code>*features*</code></a>: <a href="#Introduction">Introduction</a></li> +<li><a href="#index-g_t_002asystem_002ddefinition_002dsearch_002dfunctions_002a-42"><code>*system-definition-search-functions*</code></a>: <a href="#Components">Components</a></li> +<li><a href="#index-ASDF_005fOUTPUT_005fTRANSLATIONS-57"><code>ASDF_OUTPUT_TRANSLATIONS</code></a>: <a href="#Controlling-where-ASDF-saves-compiled-files">Controlling where ASDF saves compiled files</a></li> + </ul><div class="footnote"> +<hr> +<a name="texinfo-footnotes-in-document"></a><h4>Footnotes</h4><p class="footnote"><small>[<a name="fn-1" href="#fnd-1">1</a>]</small> +It is possible to further customize +the system definition file search. +That's considered advanced use, and covered later: +search forward for +<code>*system-definition-search-functions*</code>. +See <a href="#Defining-systems-with-defsystem">Defining systems with defsystem</a>.</p> + + <p class="footnote"><small>[<a name="fn-2" href="#fnd-2">2</a>]</small> +ASDF will indeed call <code>eval</code> on each entry. +It will also skip entries that evaluate to <code>nil</code>. + + <p>Strings and pathname objects are self-evaluating, +in which case the <code>eval</code> step does nothing; +but you may push arbitrary SEXP onto the central registry, +that will be evaluated to compute e.g. things that depend +on the value of shell variables or the identity of the user. + + <p>The variable <code>asdf:*central-registry*</code> is thus a list of +“system directory designators”. +A <dfn>system directory designator</dfn> is a form +which will be evaluated whenever a system is to be found, +and must evaluate to a directory to look in. +By “directory” here, we mean +“designator for a pathname with a supplied DIRECTORY component”. +</p> + + <p class="footnote"><small>[<a name="fn-3" href="#fnd-3">3</a>]</small> +It is possible, though almost never necessary, to override this behaviour.</p> + + <hr></div> + +</body></html> + ===================================== src/contrib/asdf/doc/asdf.info ===================================== --- /dev/null +++ b/src/contrib/asdf/doc/asdf.info @@ -0,0 +1,4260 @@ +This is asdf.info, produced by makeinfo version 4.13 from asdf.texinfo. + +INFO-DIR-SECTION Software development +START-INFO-DIR-ENTRY +* asdf: (asdf). Another System Definition Facility (for Common Lisp) +END-INFO-DIR-ENTRY + + This manual describes ASDF, a system definition facility for Common +Lisp programs and libraries. + + You can find the latest version of this manual at +`http://common-lisp.net/project/asdf/asdf.html'. + + ASDF Copyright (C) 2001-2013 Daniel Barlow and contributors. + + This manual Copyright (C) 2001-2013 Daniel Barlow and contributors. + + This manual revised (C) 2009-2013 Robert P. Goldman and +Francois-Rene Rideau. + + Permission is hereby granted, free of charge, to any person obtaining +a copy of this software and associated documentation files (the +"Software"), to deal in the Software without restriction, including +without limitation the rights to use, copy, modify, merge, publish, +distribute, sublicense, and/or sell copies of the Software, and to +permit persons to whom the Software is furnished to do so, subject to +the following conditions: + + The above copyright notice and this permission notice shall be +included in all copies or substantial portions of the Software. + + THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. +IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY +CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, +TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE +SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. + + +File: asdf.info, Node: Top, Next: Introduction, Prev: (dir), Up: (dir) + +asdf: another system definition facility +**************************************** + +This manual describes ASDF, a system definition facility for Common +Lisp programs and libraries. + + You can find the latest version of this manual at +`http://common-lisp.net/project/asdf/asdf.html'. + + ASDF Copyright (C) 2001-2013 Daniel Barlow and contributors. + + This manual Copyright (C) 2001-2013 Daniel Barlow and contributors. + + This manual revised (C) 2009-2013 Robert P. Goldman and +Francois-Rene Rideau. + + Permission is hereby granted, free of charge, to any person obtaining +a copy of this software and associated documentation files (the +"Software"), to deal in the Software without restriction, including +without limitation the rights to use, copy, modify, merge, publish, +distribute, sublicense, and/or sell copies of the Software, and to +permit persons to whom the Software is furnished to do so, subject to +the following conditions: + + The above copyright notice and this permission notice shall be +included in all copies or substantial portions of the Software. + + THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. +IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY +CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, +TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE +SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. + +* Menu: + +* Introduction:: +* Loading ASDF:: +* Configuring ASDF:: +* Using ASDF:: +* Defining systems with defsystem:: +* The object model of ASDF:: +* Controlling where ASDF searches for systems:: +* Controlling where ASDF saves compiled files:: +* Error handling:: +* Miscellaneous additional functionality:: +* Getting the latest version:: +* FAQ:: +* TODO list:: +* Inspiration:: +* Concept Index:: +* Function and Class Index:: +* Variable Index:: + + +File: asdf.info, Node: Introduction, Next: Loading ASDF, Prev: Top, Up: Top + +1 Introduction +************** + +ASDF is Another System Definition Facility: a tool for specifying how +systems of Common Lisp software are comprised of components +(sub-systems and files), and how to operate on these components in the +right order so that they can be compiled, loaded, tested, etc. + + ASDF presents three faces: one for users of Common Lisp software who +want to reuse other people's code, one for writers of Common Lisp +software who want to specify how to build their systems, one for +implementers of Common Lisp extensions who want to extend the build +system. *Note Loading a system: Using ASDF, to learn how to use ASDF +to load a system. *Note Defining systems with defsystem::, to learn +how to define a system of your own. *Note The object model of ASDF::, +for a description of the ASDF internals and how to extend ASDF. + + _Nota Bene_: We have released ASDF 2.000 on May 31st 2010, and ASDF +3.0 on January 31st 2013. Releases of ASDF 2 and later have since then +been included in all actively maintained CL implementations that used +to bundle ASDF 1, plus some implementations that didn't use to, and has +been made to work with all actively used CL implementations and a few +more. *Note "What has changed between ASDF 1 and ASDF 2?": FAQ. +Furthermore, it is possible to upgrade from ASDF 1 to ASDF 2 or ASDF 3 +on the fly. For this reason, we have stopped supporting ASDF 1 and +ASDF 2. If you are using ASDF 1 or ASDF 2 and are experiencing any +kind of issues or limitations, we recommend you upgrade to ASDF 3 -- +and we explain how to do that. *Note Loading ASDF::. + + Also note that ASDF is not to be confused with ASDF-Install. +ASDF-Install is not part of ASDF, but a separate piece of software. +ASDF-Install is also unmaintained and obsolete. We recommend you use +Quicklisp instead, which works great and is being actively maintained. +If you want to download software from version control instead of +tarballs, so you may more easily modify it, we recommend clbuild. + + +File: asdf.info, Node: Loading ASDF, Next: Configuring ASDF, Prev: Introduction, Up: Top + +2 Loading ASDF +************** + +2.1 Loading a pre-installed ASDF +================================ + +Most recent Lisp implementations include a copy of ASDF 2, and soon +ASDF 3. You can usually load this copy using Common Lisp's `require' +function: + + (require "asdf") + + As of the writing of this manual, the following implementations +provide ASDF 2 this way: abcl allegro ccl clisp cmucl ecl lispworks +mkcl sbcl xcl. The following implementation doesn't provide it yet but +will in an upcoming release: scl. The following implementations are +obsolete, not actively maintained, and most probably will never bundle +it: cormanlisp gcl genera mcl. + + If the implementation you are using doesn't provide ASDF 2 or ASDF 3, +see *note Loading an otherwise installed ASDF: Loading ASDF. below. If +that implementation is still actively maintained, you may also send a +bug report to your Lisp vendor and complain about their failing to +provide ASDF. + + NB: all implementations except clisp also accept `(require "ASDF")', +`(require 'asdf)' and `(require :asdf)'. For portability's sake, you +probably want to use `(require "asdf")'. + +2.2 Checking whether ASDF is loaded +=================================== + +To check whether ASDF is properly loaded in your current Lisp image, +you can run this form: + + (asdf:asdf-version) + + If it returns a string, that is the version of ASDF that is +currently installed. + + If it raises an error, then either ASDF is not loaded, or you are +using an old version of ASDF. + + You can check whether an old version is loaded by checking if the +ASDF package is present. The form below will allow you to +programmatically determine whether a recent version is loaded, an old +version is loaded, or none at all: + + (when (find-package :asdf) + (let ((ver (symbol-value (or (find-symbol (string :*asdf-version*) :asdf) + (find-symbol (string :*asdf-revision*) :asdf))))) + (etypecase ver + (string ver) + (cons (with-output-to-string (s) + (loop for (n . m) on ver do (princ n s) (when m (princ "." s))))) + (null "1.0")))) + + If it returns `nil' then ASDF is not installed. Otherwise it should +return a string. If it returns `"1.0"', then it can actually be any +version before 1.77 or so, or some buggy variant of 1.x. + + If you are experiencing problems with ASDF, please try upgrading to +the latest released version, using the method below, before you contact +us and raise an issue. + +2.3 Upgrading ASDF +================== + +If your implementation provides ASDF 3 or later, you only need to +`(require "asdf")': ASDF will automatically look whether an updated +version of itself is available amongst the regularly configured +systems, before it compiles anything else. See *note Configuring +ASDF:: below. + + If your implementation does provide ASDF 2 or later, but not ASDF 3 +or later, and you want to upgrade to a more recent version, you need to +install and configure your ASDF as above, and additionally, you need to +explicitly tell ASDF to load itself, right after you require your +implementation's old ASDF 2: + + (require "asdf") + (asdf:load-system :asdf) + + If on the other hand, your implementation only provides an old ASDF, +you will require a special configuration step and an old-style loading. +Take special attention to not omit the trailing directory separator `/' +at the end of your pathname: + + (require "asdf") + (push #p"/PATH/TO/NEW/ASDF/" asdf:*central-registry*) + (asdf:oos 'asdf:load-op :asdf) + + Note that ASDF 1 won't redirect its output files, or at least won't +do it according to your usual ASDF 2 configuration. You therefore need +write access on the directory where you install the new ASDF, and make +sure you're not using it for multiple mutually incompatible +implementations. At worst, you may have to have multiple copies of the +new ASDF, e.g. one per implementation installation, to avoid clashes. +Note that to our knowledge all implementations that provide ASDF +provide ASDF 2 in their latest release, so you may want to upgrade your +implementation rather than go through that hoop. + + Finally, if you are using an unmaintained implementation that does +not provide ASDF at all, see *note Loading an otherwise installed ASDF: +Loading ASDF. below. + + Note that there are some limitations to upgrading ASDF: + * Previously loaded ASDF extension becomes invalid, and will need to + be reloaded. This applies to e.g. CFFI-Grovel, or to hacks used + by ironclad, etc. Since it isn't possible to automatically detect + what extensions are present that need to be invalidated, ASDF will + actually invalidate all previously loaded systems when it is + loaded on top of a different ASDF version, starting with ASDF + 2.014.8 (as far as releases go, 2.015); and it will automatically + attempt this self-upgrade as its very first step starting with + ASDF 3. + + * For this an many other reasons, it important reason to load, + configure and upgrade ASDF (if needed) as one of the very first + things done by your build and startup scripts. Until all + implementations provide ASDF 3 or later, it is safer if you + upgrade ASDF and its extensions as a special step at the very + beginning of whatever script you are running, before you start + using ASDF to load anything else; even afterwards, it is still a + good idea, to avoid having to load and reload code twice as it + gets invalidated. + + * Until all implementations provide ASDF 3 or later, it is unsafe to + upgrade ASDF as part of loading a system that depends on a more + recent version of ASDF, since the new one might shadow the old one + while the old one is running, and the running old one will be + confused when extensions are loaded into the new one. In the + meantime, we recommend that your systems should _not_ specify + `:depends-on (:asdf)', or `:depends-on ((:version :asdf "2.010"))', + but instead that they check that a recent enough ASDF is installed, + with such code as: + (unless (or #+asdf2 (asdf:version-satisfies + (asdf:asdf-version) *required-asdf-version*)) + (error "FOO requires ASDF ~A or later." *required-asdf-version*)) + + * Until all implementations provide ASDF 3 or later, it is unsafe + for a system to transitively depend on ASDF and not directly + depend on ASDF; if any of the system you use either depends-on + asdf, system-depends-on asdf, or transitively does, you should + also do as well. + +2.4 Loading an otherwise installed ASDF +======================================= + +If your implementation doesn't include ASDF, if for some reason the +upgrade somehow fails, does not or cannot apply to your case, you will +have to install the file `asdf.lisp' somewhere and load it with: + + (load "/path/to/your/installed/asdf.lisp") + + The single file `asdf.lisp' is all you normally need to use ASDF. + + You can extract this file from latest release tarball on the ASDF +website (http://common-lisp.net/project/asdf/). If you are daring and +willing to report bugs, you can get the latest and greatest version of +ASDF from its git repository. *Note Getting the latest version::. + + For maximum convenience you might want to have ASDF loaded whenever +you start your Lisp implementation, for example by loading it from the +startup script or dumping a custom core -- check your Lisp +implementation's manual for details. + + +File: asdf.info, Node: Configuring ASDF, Next: Using ASDF, Prev: Loading ASDF, Up: Top + +3 Configuring ASDF +****************** + +3.1 Configuring ASDF to find your systems +========================================= + +So it may compile and load your systems, ASDF must be configured to find +the `.asd' files that contain system definitions. + + Since ASDF 2, the preferred way to configure where ASDF finds your +systems is the `source-registry' facility, fully described in its own +chapter of this manual. *Note Controlling where ASDF searches for +systems::. + + The default location for a user to install Common Lisp software is +under `~/.local/share/common-lisp/source/'. If you install software +there (it can be a symlink), you don't need further configuration. If +you're installing software yourself at a location that isn't standard, +you have to tell ASDF where you installed it. See below. If you're +using some tool to install software (e.g. Quicklisp), the authors of +that tool should already have configured ASDF. + + The simplest way to add a path to your search path, say +`/home/luser/.asd-link-farm/' is to create the directory +`~/.config/common-lisp/source-registry.conf.d/' and there create a file +with any name of your choice, and with the type `conf', for instance +`42-asd-link-farm.conf' containing the line: + + `(:directory "/home/luser/.asd-link-farm/")' + + If you want all the subdirectories under `/home/luser/lisp/' to be +recursively scanned for `.asd' files, instead use: + + `(:tree "/home/luser/lisp/")' + + Note that your Operating System distribution or your system +administrator may already have configured system-managed libraries for +you. + + The required `.conf' extension allows you to have disabled files or +editor backups (ending in `~'), and works portably (for instance, it is +a pain to allow both empty and non-empty extension on CLISP). Excluded +are files the name of which start with a `.' character. It is +customary to start the filename with two digits that specify the order +in which the directories will be scanned. + + ASDF will automatically read your configuration the first time you +try to find a system. You can reset the source-registry configuration +with: + + (asdf:clear-source-registry) + + And you probably should do so before you dump your Lisp image, if +the configuration may change between the machine where you save it at +the time you save it and the machine you resume it at the time you +resume it. Actually, you should use `(asdf:clear-configuration)' +before you dump your Lisp image, which includes the above. + +3.2 Configuring ASDF to find your systems -- old style +====================================================== + +The old way to configure ASDF to find your systems is by `push'ing +directory pathnames onto the variable `asdf:*central-registry*'. + + You must configure this variable between the time you load ASDF and +the time you first try to use it. Loading and configuring ASDF +presumably happen as part of some initialization script that builds or +starts your Common Lisp software system. (For instance, some SBCL +users used to put it in their `~/.sbclrc'.) + + The `asdf:*central-registry*' is empty by default in ASDF 2 or ASDF +3, but is still supported for compatibility with ASDF 1. When used, it +takes precedence over the above source-registry(1). + + For instance, if you wanted ASDF to find the `.asd' file +`/home/me/src/foo/foo.asd' your initialization script could after it +loads ASDF with `(require "asdf")' configure it with: + + (push "/home/me/src/foo/" asdf:*central-registry*) + + Note the trailing slash: when searching for a system, ASDF will +evaluate each entry of the central registry and coerce the result to a +pathname(2) at which point the presence of the trailing directory name +separator is necessary to tell Lisp that you're discussing a directory +rather than a file. + + Typically, however, there are a lot of `.asd' files, and a common +idiom was to have to put a bunch of _symbolic links_ to `.asd' files in +a common directory and push _that_ directory (the "link farm") to the +`asdf:*central-registry*' instead of pushing each of the many involved +directories to the `asdf:*central-registry*'. ASDF knows how to follow +such _symlinks_ to the actual file location when resolving the paths of +system components (on Windows, you can use Windows shortcuts instead of +POSIX symlinks; if you try aliases under MacOS, we are curious to hear +about your experience). + + For example, if `#p"/home/me/cl/systems/"' (note the trailing slash) +is a member of `*central-registry*', you could set up the system FOO +for loading with asdf with the following commands at the shell: + + $ cd /home/me/cl/systems/ + $ ln -s ~/src/foo/foo.asd . + + This old style for configuring ASDF is not recommended for new users, +but it is supported for old users, and for users who want to +programmatically control what directories are added to the ASDF search +path. + +3.3 Configuring where ASDF stores object files +============================================== + +ASDF lets you configure where object files will be stored. Sensible +defaults are provided and you shouldn't normally have to worry about it. + + This allows the same source code repository may be shared between +several versions of several Common Lisp implementations, between +several users using different compilation options and without write +privileges on shared source directories, etc. This also allows to keep +source directories uncluttered by plenty of object files. + + Starting with ASDF 2, the `asdf-output-translations' facility was +added to ASDF itself, that controls where object files will be stored. +This facility is fully described in a chapter of this manual, *note +Controlling where ASDF saves compiled files::. + + The simplest way to add a translation to your search path, say from +`/foo/bar/baz/quux/' to `/where/i/want/my/fasls/' is to create the +directory `~/.config/common-lisp/asdf-output-translations.conf.d/' and +there create a file with any name of your choice and the type `conf', +for instance `42-bazquux.conf' containing the line: + + `("/foo/bar/baz/quux/" "/where/i/want/my/fasls/")' + + To disable output translations for source under a given directory, +say `/toto/tata/' you can create a file `40-disable-toto.conf' with the +line: + + `("/toto/tata/")' + + To wholly disable output translations for all directories, you can +create a file `00-disable.conf' with the line: + + `(t t)' + + Note that your Operating System distribution or your system +administrator may already have configured translations for you. In +absence of any configuration, the default is to redirect everything +under an implementation-dependent subdirectory of +`~/.cache/common-lisp/'. *Note Controlling where ASDF searches for +systems::, for full details. + + The required `.conf' extension allows you to have disabled files or +editor backups (ending in `~'), and works portably (for instance, it is +a pain to allow both empty and non-empty extension on CLISP). Excluded +are files the name of which start with a `.' character. It is +customary to start the filename with two digits that specify the order +in which the directories will be scanned. + + ASDF will automatically read your configuration the first time you +try to find a system. You can reset the source-registry configuration +with: + + (asdf:clear-output-translations) + + And you probably should do so before you dump your Lisp image, if +the configuration may change between the machine where you save it at +the time you save it and the machine you resume it at the time you +resume it. (Once again, you should use `(asdf:clear-configuration)' +before you dump your Lisp image, which includes the above.) + + Finally note that before ASDF 2, other ASDF add-ons offered the same +functionality, each in subtly different and incompatible ways: +ASDF-Binary-Locations, cl-launch, common-lisp-controller. +ASDF-Binary-Locations is now not needed anymore and should not be used. +cl-launch 3.000 and common-lisp-controller 7.2 have been updated to +just delegate this functionality to ASDF. + + ---------- Footnotes ---------- + + (1) It is possible to further customize the system definition file +search. That's considered advanced use, and covered later: search +forward for `*system-definition-search-functions*'. *Note Defining +systems with defsystem::. + + (2) ASDF will indeed call `eval' on each entry. It will also skip +entries that evaluate to `nil'. + + Strings and pathname objects are self-evaluating, in which case the +`eval' step does nothing; but you may push arbitrary SEXP onto the +central registry, that will be evaluated to compute e.g. things that +depend on the value of shell variables or the identity of the user. + + The variable `asdf:*central-registry*' is thus a list of "system +directory designators". A "system directory designator" is a form +which will be evaluated whenever a system is to be found, and must +evaluate to a directory to look in. By "directory" here, we mean +"designator for a pathname with a supplied DIRECTORY component". + + +File: asdf.info, Node: Using ASDF, Next: Defining systems with defsystem, Prev: Configuring ASDF, Up: Top + +3.4 Resetting Configuration +=========================== + +When you dump and restore an image, or when you tweak your +configuration, you may want to reset the ASDF configuration. For that +you may use the following function: + + -- Function: clear-configuration + undoes any ASDF configuration, regarding source-registry or + output-translations. + + If you use SBCL, CMUCL or SCL, you may use this snippet so that the +ASDF configuration be cleared automatically as you dump an image: + + #+(or cmu sbcl scl) + (pushnew 'clear-configuration + #+(or cmu scl) ext:*before-save-initializations* + #+sbcl sb-ext:*save-hooks*) + + For compatibility with all Lisp implementations, however, you might +want instead your build script to explicitly call +`(asdf:clear-configuration)' at an appropriate moment before dumping. + +4 Using ASDF +************ + +4.1 Loading a system +==================== + +The system FOO is loaded (and compiled, if necessary) by evaluating the +following Lisp form: + + (asdf:load-system :FOO) + + On some implementations (namely recent versions of ABCL, Allegro CL, +Clozure CL, CMUCL, ECL, GNU CLISP, LispWorks, MKCL, SBCL and XCL), ASDF +hooks into the `CL:REQUIRE' facility and you can just use: + + (require :FOO) + + In older versions of ASDF, you needed to use `(asdf:oos +'asdf:load-op :FOO)'. If your ASDF is too old to provide +`asdf:load-system' though we recommend that you upgrade to ASDF 3. +*Note Loading an otherwise installed ASDF: Loading ASDF. + + Note the name of a system is specified as a string or a symbol, +typically a keyword. If a symbol (including a keyword), its name is +taken and lowercased. The name must be a suitable value for the +`:name' initarg to `make-pathname' in whatever filesystem the system is +to be found. The lower-casing-symbols behaviour is unconventional, but +was selected after some consideration. Observations suggest that the +type of systems we want to support either have lowercase as customary +case (unix, mac, windows) or silently convert lowercase to uppercase +(lpns), so this makes more sense than attempting to use `:case :common', +which is reported not to work on some implementations + +4.2 Other Operations +==================== + +ASDF provides three commands for the most common system operations: +`load-system', `compile-system' or `test-system'. It also provides +`require-system', a version of `load-system' that skips trying to +update systems that are already loaded. + + Because ASDF is an extensible system for defining _operations_ on +_components_, it also provides a generic function `operate' (which is +usually abbreviated by `oos'). You'll use `oos' whenever you want to +do something beyond compiling, loading and testing. + + Output from ASDF and ASDF extensions are supposed to be sent to the +CL stream `*standard-output*', and so rebinding that stream around +calls to `asdf:operate' should redirect all output from ASDF operations. + + Reminder: before ASDF can operate on a system, however, it must be +able to find and load that system's definition. *Note Configuring ASDF +to find your systems: Configuring ASDF. + + For the advanced users, note that `require-system' calls +`load-system' with keyword arguments `:force-not +(already-loaded-systems)'. `already-loaded-systems' returns a list of +the names of loaded systems. `load-system' applies `operate' with the +operation from `*load-system-operation*', which by default is `load-op', +the system, and any provided keyword arguments. + +4.3 Summary +=========== + +To use ASDF: + + * Load ASDF itself into your Lisp image, either through `(require + "asdf")' or else through `(load "/path/to/asdf.lisp")'. + + * Make sure ASDF can find system definitions thanks to proper + source-registry configuration. + + * Load a system with `(asdf:load-system :my-system)' or use some + other operation on some system of your choice. + + +4.4 Moving on +============= + +That's all you need to know to use ASDF to load systems written by +others. The rest of this manual deals with writing system definitions +for Common Lisp software you write yourself, including how to extend +ASDF to define new operation and component types. + + +File: asdf.info, Node: Defining systems with defsystem, Next: The object model of ASDF, Prev: Using ASDF, Up: Top + +5 Defining systems with defsystem +********************************* + +This chapter describes how to use asdf to define systems and develop +software. + +* Menu: + +* The defsystem form:: +* A more involved example:: +* The defsystem grammar:: +* Other code in .asd files:: + + +File: asdf.info, Node: The defsystem form, Next: A more involved example, Prev: Defining systems with defsystem, Up: Defining systems with defsystem + +5.1 The defsystem form +====================== + +Systems can be constructed programmatically by instantiating components +using `make-instance'. Most of the time, however, it is much more +practical to use a static `defsystem' form. This section begins with +an example of a system definition, then gives the full grammar of +`defsystem'. + + Let's look at a simple system. This is a complete file that would +usually be saved as `hello-lisp.asd': + + (in-package :asdf) + + (defsystem "hello-lisp" + :description "hello-lisp: a sample Lisp system." + :version "0.2.1" + :author "Joe User <joe(a)example.com>" + :licence "Public Domain" + :components ((:file "packages") + (:file "macros" :depends-on ("packages")) + (:file "hello" :depends-on ("macros")))) + + Some notes about this example: + + * The file starts with an `in-package' form to use package `asdf'. + You could instead start your definition by using a qualified name + `asdf:defsystem'. + + * If in addition to simply using `defsystem', you are going to + define functions, create ASDF extension, globally bind symbols, + etc., it is recommended that to avoid namespace pollution between + systems, you should create your own package for that purpose, for + instance replacing the above `(in-package :asdf)' with: + + (defpackage :foo-system + (:use :cl :asdf)) + + (in-package :foo-system) + + * The `defsystem' form defines a system named `hello-lisp' that + contains three source files: `packages', `macros' and `hello'. + + * The file `macros' depends on `packages' (presumably because the + package it's in is defined in `packages'), and the file `hello' + depends on `macros' (and hence, transitively on `packages'). This + means that ASDF will compile and load `packages' and `macros' + before starting the compilation of file `hello'. + + * The files are located in the same directory as the file with the + system definition. ASDF resolves symbolic links (or Windows + shortcuts) before loading the system definition file and stores + its location in the resulting system(1). This is a good thing + because the user can move the system sources without having to + edit the system definition. + + * Make sure you know how the `:version' numbers will be parsed! + They are parsed as period-separated lists of integers. I.e., in + the example, `0.2.1' is to be interpreted, roughly speaking, as + `(0 2 1)'. In particular, version `0.2.1' is interpreted the same + as `0.0002.1' and is strictly version-less-than version `0.20.1', + even though the two are the same when interpreted as decimal + fractions. Instead of a string representing the version, the + `:version' argument can be an expression that is resolved to such + a string using the following trivial domain-specific language: in + addition to being a literal string, it can be an expression of the + form `(:read-file-form <pathname-or-string> :at + <access-at-specifier>)', which will be resolved by reading a form + in the specified pathname (read as a subpathname of the current + system if relative or a unix-namestring). You may use a + `uiop:access-at' specifier with the (optional) `:at' keyword, by + default the specifier is `0', meaning the first form is returned. + + + ---------- Footnotes ---------- + + (1) It is possible, though almost never necessary, to override this +behaviour. + + +File: asdf.info, Node: A more involved example, Next: The defsystem grammar, Prev: The defsystem form, Up: Defining systems with defsystem + +5.2 A more involved example +=========================== + +Let's illustrate some more involved uses of `defsystem' via a slightly +convoluted example: + + (defsystem "foo" + :version "1.0.0" + :components ((:module "mod" + :components ((:file "bar") + (:file"baz") + (:file "quux")) + :perform (compile-op :after (op c) + (do-something c)) + :explain (compile-op :after (op c) + (explain-something c))) + (:file "blah"))) + + The `:module' component named `"mod"' is a collection of three files, +which will be located in a subdirectory of the main code directory named +`mod' (this location can be overridden; see the discussion of the +`:pathname' option in *note The defsystem grammar::). + + The method-form tokens provide a shorthand for defining methods on +particular components. This part + + :perform (compile-op :after (op c) + (do-something c)) + :explain (compile-op :after (op c) + (explain-something c)) + + has the effect of + + (defmethod perform :after ((op compile-op) (c (eql ...))) + (do-something c)) + (defmethod explain :after ((op compile-op) (c (eql ...))) + (explain-something c)) + + where `...' is the component in question. In this case `...' would +expand to something like + + (find-component "foo" "mod") + + For more details on the syntax of such forms, see *note The +defsystem grammar::. For more details on what these methods do, *note +Operations:: in *note The object model of ASDF::. + + +File: asdf.info, Node: The defsystem grammar, Next: Other code in .asd files, Prev: A more involved example, Up: Defining systems with defsystem + +5.3 The defsystem grammar +========================= + + system-definition := ( defsystem system-designator SYSTEM-OPTION* ) + + system-option := :defsystem-depends-on system-list + | :weakly-depends-on SYSTEM-LIST + | :class class-name (see discussion below) + | module-option + | option + + module-option := :components component-list + | :serial [ t | nil ] + + option := + | :pathname pathname-specifier + | :default-component-class class-name + | :perform method-form + | :explain method-form + | :output-files method-form + | :operation-done-p method-form + | :if-feature feature-expression + | :depends-on ( DEPENDENCY-DEF* ) + | :in-order-to ( DEPENDENCY+ ) + + + system-list := ( SIMPLE-COMPONENT-NAME* ) + + component-list := ( COMPONENT-DEF* ) + + component-def := ( component-type simple-component-name OPTION* ) + + component-type := :module | :file | :static-file | other-component-type + + other-component-type := symbol-by-name (*note Component types: The defsystem grammar.) + + # This is used in :depends-on, as opposed to ``dependency,'' + # which is used in :in-order-to + dependency-def := simple-component-name + | (feature FEATURE-NAME) + | ( :version simple-component-name version-specifier) + + # ``dependency'' is used in :in-order-to, as opposed to + # ``dependency-def'' + dependency := (dependent-op REQUIREMENT+) + requirement := (required-op REQUIRED-COMPONENT+) + | (:feature FEATURE-NAME) + dependent-op := operation-name + required-op := operation-name + + simple-component-name := string + | symbol + + pathname-specifier := pathname | string | symbol + + method-form := (operation-name qual lambda-list &rest body) + qual := method qualifier + + component-dep-fail-option := :fail | :try-next | :ignore + + feature-expression := keyword | (:and FEATURE-EXPRESSION*) + | (:or FEATURE-EXPRESSION*) | (:not FEATURE-EXPRESSION) + +5.3.1 Component names +--------------------- + +Component names (`simple-component-name') may be either strings or +symbols. + +5.3.2 Component types +--------------------- + +Component type names, even if expressed as keywords, will be looked up +by name in the current package and in the asdf package, if not found in +the current package. So a component type `my-component-type', in the +current package `my-system-asd' can be specified as +`:my-component-type', or `my-component-type'. + + `system' and its subclasses are _not_ allowed as component types for +such children components. + +5.3.3 System class names +------------------------ + +A system class name will be looked up in the same way as a Component +type (see above), except that only `system' and its subclasses are +allowed. Typically, one will not need to specify a system class name, +unless using a non-standard system class defined in some ASDF +extension, typically loaded through `DEFSYSTEM-DEPENDS-ON', see below. +For such class names in the ASDF package, we recommend that the +`:class' option be specified using a keyword symbol, such as + + :class :MY-NEW-SYSTEM-SUBCLASS + + This practice will ensure that package name conflicts are avoided. +Otherwise, the symbol `MY-NEW-SYSTEM-SUBCLASS' will be read into the +current package _before_ it has been exported from the ASDF extension +loaded by `:defsystem-depends-on', causing a name conflict in the +current package. + +5.3.4 Defsystem depends on +-------------------------- + +The `:defsystem-depends-on' option to `defsystem' allows the programmer +to specify another ASDF-defined system or set of systems that must be +loaded _before_ the system definition is processed. Typically this is +used to load an ASDF extension that is used in the system definition. + +5.3.5 Weakly depends on +----------------------- + +We do _NOT_ recommend you use this feature. If you are tempted to +write a system FOO that weakly-depends-on a system BAR, we recommend +that you should instead write system FOO in a parametric way, and offer +some special variable and/or some hook to specialize its behavior; then +you should write a system FOO+BAR that does the hooking of things +together. + + The (deprecated) `:weakly-depends-on' option to `defsystem' allows +the programmer to specify another ASDF-defined system or set of systems +that ASDF should _try_ to load, but need not load in order to be +successful. Typically this is used if there are a number of systems +that, if present, could provide additional functionality, but which are +not necessary for basic function. + + Currently, although it is specified to be an option only to +`defsystem', this option is accepted at any component, but it probably +only makes sense at the `defsystem' level. Programmers are cautioned +not to use this component option except at the `defsystem' level, as +this anomalous behavior may be removed without warning. + + Finally, you might look into the `asdf-system-connections' extension, +that will let you define additional code to be loaded when two systems +are simultaneously loaded. It may or may not be considered good style, +but at least it can be used in a way that has deterministic behavior +independent of load order, unlike `weakly-depends-on'. + +5.3.6 Pathname specifiers +------------------------- + +A pathname specifier (`pathname-specifier') may be a pathname, a string +or a symbol. When no pathname specifier is given for a component, +which is the usual case, the component name itself is used. + + If a string is given, which is the usual case, the string will be +interpreted as a Unix-style pathname where `/' characters will be +interpreted as directory separators. Usually, Unix-style relative +pathnames are used (i.e. not starting with `/', as opposed to absolute +pathnames); they are relative to the path of the parent component. +Finally, depending on the `component-type', the pathname may be +interpreted as either a file or a directory, and if it's a file, a file +type may be added corresponding to the `component-type', or else it +will be extracted from the string itself (if applicable). + + For instance, the `component-type' `:module' wants a directory +pathname, and so a string `"foo/bar"' will be interpreted as the +pathname `#p"foo/bar/"'. On the other hand, the `component-type' +`:file' wants a file of type `lisp', and so a string `"foo/bar"' will +be interpreted as the pathname `#p"foo/bar.lisp"', and a string +`"foo/bar.quux"' will be interpreted as the pathname +`#p"foo/bar.quux.lisp"'. Finally, the `component-type' `:static-file' +wants a file without specifying a type, and so a string `"foo/bar"' +will be interpreted as the pathname `#p"foo/bar"', and a string +`"foo/bar.quux"' will be interpreted as the pathname `#p"foo/bar.quux"'. + + ASDF does not interpret the string `".."' to designate the parent +directory. This string will be passed through to the underlying +operating system for interpretation. We _believe_ that this will work +on all platforms where ASDF is deployed, but do not guarantee this +behavior. A pathname object with a relative directory component of +`:up' or `:back' is the only guaranteed way to specify a parent +directory. + + If a symbol is given, it will be translated into a string, and +downcased in the process. The downcasing of symbols is unconventional, +but was selected after some consideration. Observations suggest that +the type of systems we want to support either have lowercase as +customary case (Unix, Mac, windows) or silently convert lowercase to +uppercase (lpns), so this makes more sense than attempting to use +`:case :common' as argument to `make-pathname', which is reported not +to work on some implementations. + + Pathname objects may be given to override the path for a component. +Such objects are typically specified using reader macros such as `#p' +or `#.(make-pathname ...)'. Note however, that `#p...' is a shorthand +for `#.(parse-namestring ...)' and that the behavior of +`parse-namestring' is completely non-portable, unless you are using +Common Lisp `logical-pathname's, which themselves involve other +non-portable behavior (*note Using logical pathnames: The defsystem +grammar, below). Pathnames made with `#.(make-pathname ...)' can +usually be done more easily with the string syntax above. The only +case that you really need a pathname object is to override the +component-type default file type for a given component. Therefore, +pathname objects should only rarely be used. Unhappily, ASDF 1 didn't +properly support parsing component names as strings specifying paths +with directories, and the cumbersome `#.(make-pathname ...)' syntax had +to be used. An alternative to `#.' read-time evaluation is to use +`(eval `(defsystem ... ,pathname ...))'. + + Note that when specifying pathname objects, ASDF does not do any +special interpretation of the pathname influenced by the component +type, unlike the procedure for pathname-specifying strings. On the one +hand, you have to be careful to provide a pathname that correctly +fulfills whatever constraints are required from that component type +(e.g. naming a directory or a file with appropriate type); on the other +hand, you can circumvent the file type that would otherwise be forced +upon you if you were specifying a string. + +5.3.7 Version specifiers +------------------------ + +Version specifiers are strings to be parsed as period-separated lists +of integers. I.e., in the example, `"0.2.1"' is to be interpreted, +roughly speaking, as `(0 2 1)'. In particular, version `"0.2.1"' is +interpreted the same as `"0.0002.1"', though the latter is not +canonical and may lead to a warning being issued. Also, `"1.3"' and +`"1.4"' are both strictly `uiop:version<' to `"1.30"', quite unlike +what would have happened had the version strings been interpreted as +decimal fractions. + + System definers are encouraged to use version identifiers of the form +X.Y.Z for major version, minor version and patch level, where +significant API incompatibilities are signaled by an increased major +number. + + *Note Common attributes of components::. + +5.3.8 Using logical pathnames +----------------------------- + +We do not generally recommend the use of logical pathnames, especially +not so to newcomers to Common Lisp. However, we do support the use of +logical pathnames by old timers, when such is their preference. + + To use logical pathnames, you will have to provide a pathname object +as a `:pathname' specifier to components that use it, using such syntax +as `#p"LOGICAL-HOST:absolute;path;to;component.lisp"'. + + You only have to specify such logical pathname for your system or +some top-level component. Sub-components' relative pathnames, +specified using the string syntax for names, will be properly merged +with the pathnames of their parents. The specification of a logical +pathname host however is _not_ otherwise directly supported in the ASDF +syntax for pathname specifiers as strings. + + The `asdf-output-translation' layer will avoid trying to resolve and +translate logical pathnames. The advantage of this is that you can +define yourself what translations you want to use with the logical +pathname facility. The disadvantage is that if you do not define such +translations, any system that uses logical pathnames will behave +differently under asdf-output-translations than other systems you use. + + If you wish to use logical pathnames you will have to configure the +translations yourself before they may be used. ASDF currently provides +no specific support for defining logical pathname translations. + + Note that the reasons we do not recommend logical pathnames are that +(1) there is no portable way to set up logical pathnames before they +are used, (2) logical pathnames are limited to only portably use a +single character case, digits and hyphens. While you can solve the +first issue on your own, describing how to do it on each of fifteen +implementations supported by ASDF is more than we can document. As for +the second issue, mind that the limitation is notably enforced on SBCL, +and that you therefore can't portably violate the limitations but must +instead define some encoding of your own and add individual mappings to +name physical pathnames that do not fit the restrictions. This can +notably be a problem when your Lisp files are part of a larger project +in which it is common to name files or directories in a way that +includes the version numbers of supported protocols, or in which files +are shared with software written in different programming languages +where conventions include the use of underscores, dots or CamelCase in +pathnames. + +5.3.9 Serial dependencies +------------------------- + +If the `:serial t' option is specified for a module, ASDF will add +dependencies for each child component, on all the children textually +preceding it. This is done as if by `:depends-on'. + + :serial t + :components ((:file "a") (:file "b") (:file "c")) + + is equivalent to + + :components ((:file "a") + (:file "b" :depends-on ("a")) + (:file "c" :depends-on ("a" "b"))) + +5.3.10 Source location +---------------------- + +The `:pathname' option is optional in all cases for systems defined via +`defsystem', and in the usual case the user is recommended not to +supply it. + + Instead, ASDF follows a hairy set of rules that are designed so that + 1. `find-system' will load a system from disk and have its pathname + default to the right place. + + 2. This pathname information will not be overwritten with + `*default-pathname-defaults*' (which could be somewhere else + altogether) if the user loads up the `.asd' file into his editor + and interactively re-evaluates that form. + + If a system is being loaded for the first time, its top-level +pathname will be set to: + + * The host/device/directory parts of `*load-truename*', if it is + bound. + + * `*default-pathname-defaults*', otherwise. + + If a system is being redefined, the top-level pathname will be + + * changed, if explicitly supplied or obtained from `*load-truename*' + (so that an updated source location is reflected in the system + definition) + + * changed if it had previously been set from + `*default-pathname-defaults*' + + * left as before, if it had previously been set from + `*load-truename*' and `*load-truename*' is currently unbound (so + that a developer can evaluate a `defsystem' form from within an + editor without clobbering its source location) + +5.3.11 if-feature option +------------------------ + +This option allows you to specify a feature expression to be evaluated +as if by `#+' to conditionally include a component in your build. If +the expression is false, the component is dropped as well as any +dependency pointing to it. As compared to using `#+' which is expanded +at read-time, this allows you to have an object in your component +hierarchy that can be used for manipulations beside building your +project. This option was added in ASDF 3. + +5.3.12 if-component-dep-fails option +------------------------------------ + +This option was removed in ASDF 3. Its semantics was limited in +purpose and dubious to explain, and its implementation was breaking a +hole into the ASDF object model. Please use the `if-feature' option +instead. + + +File: asdf.info, Node: Other code in .asd files, Prev: The defsystem grammar, Up: Defining systems with defsystem + +5.4 Other code in .asd files +============================ + +Files containing `defsystem' forms are regular Lisp files that are +executed by `load'. Consequently, you can put whatever Lisp code you +like into these files. However, it is recommended to keep such forms +to a minimal, and to instead define `defsystem' extensions that you use +with `:defsystem-depends-on'. + + If however, you might insist on including code in the `.asd' file +itself, e.g., to examine and adjust the compile-time environment, +possibly adding appropriate features to `*features*'. If so, here are +some conventions we recommend you follow, so that users can control +certain details of execution of the Lisp in `.asd' files: + + * Any informative output (other than warnings and errors, which are + the condition system's to dispose of) should be sent to the + standard CL stream `*standard-output*', so that users can easily + control the disposition of output from ASDF operations. + + +File: asdf.info, Node: The object model of ASDF, Next: Controlling where ASDF searches for systems, Prev: Defining systems with defsystem, Up: Top + +6 The object model of ASDF +************************** + +ASDF is designed in an object-oriented way from the ground up. Both a +system's structure and the operations that can be performed on systems +follow a extensible protocol. + + This allows the addition of behaviours: for example, `cffi' adds +support of special FFI description files to interface with C libraries +and of wrapper files to embed C code in Lisp; `abcl-jar' supports +creating Java JAR archives in ABCL; and `poiu' supports for compiling +code in parallel using background processes. + + This chapter deals with `component's and `operation's. + + A `component' represents an individual source file or a group of +source files, and the things that get transformed into. A `system' is +a component at the top level of the component hierarchy. A +`source-file' is a component representing a single source-file and the +successive output files into which it is transformed. A `module' is an +intermediate component itself grouping several other components, +themselves source-files or further modules. + + An `Operation' represents a transformation that can be performed on +a component, turning them from source files to intermediate results to +final outputs. + + A pair of an `operation' and a `component' is called an `action'. +An `action' represents a particular build step to be `perform'ed, after +all its dependencies have been fulfilled. In the ASDF model, actions +depend on other actions. The term _action_ itself was used by Kent +Pitman in his old article, but was only used by ASDF hackers starting +with the ASDF 2; but the concept is ubiquitous since the very beginning +of ASDF 1, though previously implicit. + + Then, there are many _functions_ available to users, extenders and +implementers of ASDF to use, define or implement the activities that +are part of building your software. Though they manipulate `action's, +most of these functions do not take as an argument a reified pair (a +`cons' cell) of an operation and a component; instead, they usually +take two separate arguments, which allows to take advantage of the +power CLOS-style multiple dispatch for fun and profit. + + There are many _hooks_ in which to add functionality, by customizing +the behavior of existing _functions_. + + Last but not least is the notion of _dependency_ between two actions. +The structure of dependencies between actions is a directed _dependency +graph_. ASDF is invoked by being told to _operate_ with some +_operation_ on some toplevel _system_; it will then _traverse_ the +graph and build a _plan_ that follows its structure. To be +successfully buildable, this graph of actions but be acyclic. If, as a +user, extender or implementer of ASDF, you fail to keep the dependency +graph without cycles, ASDF will fail loudly as it eventually finds one. +To clearly distinguish the direction of dependencies, ASDF 3 uses the +words _requiring_ and _required_ as applied to an action depending on +the other: the requiring action `depends-on' the completion of all +required actions before it may itself be `perform'ed. + + Using the `defsystem' syntax, users may easily express direct +dependencies along the graph of the object hierarchy: between a +component and its parent, its children, and its siblings. By defining +custom CLOS methods, you can express more elaborate dependencies as you +wish. Most common operations, such as `load-op', `compile-op' or +`load-source-op' are automatically propagate "downward" the component +hierarchy and are "covariant" with it: to act the operation on the +parent module, you must first act it on all the children components, +with the action on the parent being parent of the action on each child. +Other operations, such as `prepare-op' and `prepare-source-op' +(introduced in ASDF 3) are automatically propagated "upward" the +component hierarchy and are "contravariant" with it: to perform the +operation of preparing for compilation of a child component, you must +perform the operation of preparing for compilation of its parent +component, and so on, ensuring that all the parent's dependencies are +(compiled and) loaded before the child component may be compiled and +loaded. Yet other operations, such as `test-op' or `load-fasl-op' +remain at the system level, and are not propagated along the hierarchy, +but instead do something global on the system. + +* Menu: + +* Operations:: +* Components:: +* Functions:: + + +File: asdf.info, Node: Operations, Next: Components, Prev: The object model of ASDF, Up: The object model of ASDF + +6.1 Operations +============== + +An "operation" object of the appropriate type is instantiated whenever +the user wants to do something with a system like + + * compile all its files + + * load the files into a running lisp environment + + * copy its source files somewhere else + + Operations can be invoked directly, or examined to see what their +effects would be without performing them. There are a bunch of methods +specialised on operation and component type that actually do the grunt +work. + + The operation object contains whatever state is relevant for this +purpose (perhaps a list of visited nodes, for example) but primarily is +a nice thing to specialise operation methods on and easier than having +them all be `EQL' methods. + + Operations are invoked on systems via `operate'. + + -- Generic function: `operate' OPERATION SYSTEM &rest INITARGS &key + `force' `force-not' `verbose' &allow-other-keys + -- Generic function: `oos' OPERATION SYSTEM &rest INITARGS &key + &allow-other-keys + `operate' invokes OPERATION on SYSTEM. `oos' is a synonym for + `operate'. + + OPERATION is a symbol that is passed, along with the supplied + INITARGS, to `make-instance' to create the operation object. + SYSTEM is a system designator. + + The INITARGS are passed to the `make-instance' call when creating + the operation object. Note that dependencies may cause the + operation to invoke other operations on the system or its + components: the new operations will be created with the same + INITARGS as the original one. + + If FORCE is `:all', then all systems are forced to be recompiled + even if not modified since last compilation. If FORCE is `t', + then only the system being loaded is forced to be recompiled even + if not modified since last compilation, but other systems are not + affected. If FORCE is a list, then it specifies a list of systems + that are forced to be recompiled even if not modified since last + compilation. If FORCE-NOT is `:all', then all systems are forced + not to be recompiled even if modified since last compilation. If + FORCE-NOT is `t', then only the system being loaded is forced not + to be recompiled even if modified since last compilation, but + other systems are not affected. If FORCE-NOT is a list, then it + specifies a list of systems that are forced not to be recompiled + even if modified since last compilation. FORCE takes precedences + over FORCE-NOT; both of them apply to systems that are + dependencies and were already compiled. + + To see what `operate' would do, you can use: + (asdf:traverse operation-class system-name) + + +* Menu: + +* Predefined operations of ASDF:: +* Creating new operations:: + + +File: asdf.info, Node: Predefined operations of ASDF, Next: Creating new operations, Prev: Operations, Up: Operations + +6.1.1 Predefined operations of ASDF +----------------------------------- + +All the operations described in this section are in the `asdf' package. +They are invoked via the `operate' generic function. + + (asdf:operate 'asdf:OPERATION-NAME :SYSTEM-NAME {OPERATION-OPTIONS ...}) + + -- Operation: `compile-op' + This operation compiles the specified component. A + `cl-source-file' will be `compile-file''d. All the children and + dependencies of a system or module will be recursively compiled by + `compile-op'. + + `compile-op' depends on `prepare-op' which itself depends on a + `load-op' of all of a component's dependencies, as well as of its + parent's dependencies. When `operate' is called on `compile-op', + all these dependencies will be loaded as well as compiled; yet, + some parts of the system main remain unloaded, because nothing + depends on them. Use `load-op' to load a system. + + -- Operation: `load-op' + This operation loads the compiled code for a specified component. + A `cl-source-file' will have its compiled fasl `load'ed, which + fasl is the output of `compile-op' that `load-op' depends on. All + the children and dependencies of a system or module will be + recursively loaded by `load-op'. + + `load-op' depends on `prepare-op' which itself depends on a + `load-op' of all of a component's dependencies, as well as of its + parent's dependencies. + + -- Operation: `prepare-op' + This operation ensures that the dependencies of a component and + its recursive parents are loaded (as per `load-op'), as a + prerequisite before `compile-op' and `load-op' operations may be + performed on a given component. + + -- Operation: `load-source-op', `prepare-source-op' + `load-source-op' will load the source for the files in a module + rather than they compiled fasl output. It has a + `prepare-source-op' analog to `prepare-op', that ensures the + dependencies are themselves loaded via `load-source-op'. + + There is no provision in ASDF for ensuring that some components + are always loaded as source, while others are always compiled. + While this idea often comes up in discussions, it actually doesn't + play well with either the linking model of ECL or with various + bundle operations (see below), and is eventually not workable; + also the dependency model of ASDF would have to be modified + incompatibly to allow for such trick. If your code doesn't + compile cleanly, fix it. If compilation makes it slow, use + `declaim' or `eval-when' to adjust your compiler settings, or + eschew compilation by `eval'uating a quoted source form at + load-time. + + -- Operation: `test-op' + This operation will perform some tests on the module. The default + method will do nothing. The default dependency is to require + `load-op' to be performed on the module first. The default + `operation-done-p' is that the operation is _never_ done -- we + assume that if you invoke the `test-op', you want to test the + system, even if you have already done so. + + The results of this operation are not defined by ASDF. It has + proven difficult to define how the test operation should signal + its results to the user in a way that is compatible with all of + the various test libraries and test techniques in use in the + community. + + People typically define `test-op' methods like thus: + (defmethod perform ((o asdf:test-op) + (s (eql (asdf:find-system :MY-SYSTEM)))) + (asdf:load-system :MY-SYSTEM-TEST) + (funcall (read-from-string "my-system-test:test-suite"))) + + Using `load-system' in the perform method rather than an + `:in-order-to' dependency, is sometimes necessary for backward + compatibility with ASDF 2 and older, to avoid circular + dependencies that could arise because of the way these old + versions propagate dependencies. + + If you don't care for compatibility with ASDF 2, you could use the + following options in your `defsystem' form: + :in-order-to ((test-op (load-op :my-system-test))) + :perform (test-op (o c) (symbol-call :my-system-test :test-suite)) + + -- Operation: `fasl-op', `monolithic-fasl-op', `load-fasl-op', + `binary-op', `monolithic-binary-op', `lib-op', + `monolithic-lib-op', `dll-op', `monolithic-dll-op', + `program-op' + These are "bundle" operations, that can create a single-file + "bundle" for all the contents of each system in an application, or + for the entire application. + + `fasl-op' will create a single fasl file for each of the systems + needed, grouping all its many fasls in one, so you can deliver + each system as a single fasl. `monolithic-fasl-op' will create a + single fasl file for target system and all its dependencies, so + you can deliver your entire application as a single fasl. + `load-fasl-op' will load the output of `fasl-op' (though if it the + output is not up-to-date, it will load the intermediate fasls + indeed as part of building it); this matters a lot on ECL, where + the dynamic linking involved in loading tens of individual fasls + can be noticeably more expensive than loading a single one. + + Once you have created a fasl with `fasl-op', you can use + `precompiled-system' to deliver it in a way that is compatible + with clients having dependencies on your system, whether it is + distributed as source or as a single binary; the `.asd' file to be + delivered with the fasl will look like this: + (defsystem :mysystem :class :precompiled-system + :fasl (some expression that will evaluate to a pathname)) + Or you can use `binary-op' to let ASDF create such a system for you + as well as the `fasl-op' output, or `monolithic-binary-op'. This + allows you to deliver code for your systems or applications as a + single file. Of course, if you want to test the result in the + current image, _before_ you try to use any newly created `.asd' + files, you should not forget to `(asdf:clear-configuration)' or at + least `(asdf:clear-source-registry)', so it re-populates the + source-registry from the filesystem. + + The `program-op' operation will create an executable program from + the specified system and its dependencies. You can use UIOP for + its pre-image-dump hooks, its post-image-restore hooks, and its + access to command-line arguments. And you can specify an entry + point `my-app:main' by specifying in your `defsystem' the option + `:entry-point "my-app:main"'. Depending on your implementation, + running `(asdf:operate 'asdf:program-op :my-app)' may quit the + current Lisp image upon completion. See the example in + `test/hello-world-example.asd' and `test/hello.lisp', as built and + tested by `test/test-program.script' and + `test/make-hello-world.lisp'. + + There is also `lib-op' for building a linkable `.a' file (Windows: + `.lib') from all linkable object dependencies (FFI files, and on + ECL, Lisp files too), and its monolithic equivalent + `monolithic-lib-op'. And there is also `dll-op' (respectively its + monolithic equivalent `monolithic-lib-op') for building a linkable + `.so' file (Windows: `.dll', MacOS X: `.dynlib') to create a + single dynamic library for all the extra FFI code to be linked + into each of your systems (respectively your entire application). + + All these "bundle" operations are available since ASDF 3 on all + actively supported Lisp implementations, but may be unavailable on + unmaintained legacy implementations. This functionality was + previously available for select implementations, as part of a + separate system `asdf-bundle', itself descended from the ECL-only + `asdf-ecl'. + + The pathname of the output of bundle operations is subject to + output-translation as usual, unless the operation is equal to the + `:build-operation' argument to `defsystem'. This behavior is not + very satisfactory and may change in the future. Maybe you have + suggestions on how to better configure it? + + -- Operation: `concatenate-source-op', + `monolithic-concatenate-source-op', + `load-concatenated-source-op', + `compile-concatenated-source-op', + `load-compiled-concatenated-source-op', + `monolithic-load-concatenated-source-op', + `monolithic-compile-concatenated-source-op', + `monolithic-load-compiled-concatenated-source-op' + These operation, as their respective names indicate, consist in + concatenating all `cl-source-file' source files in a system (or in + a system and all its dependencies, if monolithic), in the order + defined by dependencies, then loading the result, or compiling + then loading the result. + + These operations are useful to deliver a system or application as + a single source file, and for testing that said file loads + properly, or compiles then loads properly. + + ASDF itself is notably delivered as a single source file this way + using `monolithic-concatenate-source-op', transcluding a prelude + and the `uiop' library before the `asdf/defsystem' system itself. + + +File: asdf.info, Node: Creating new operations, Prev: Predefined operations of ASDF, Up: Operations + +6.1.2 Creating new operations +----------------------------- + +ASDF was designed to be extensible in an object-oriented fashion. To +teach ASDF new tricks, a programmer can implement the behaviour he wants +by creating a subclass of `operation'. + + ASDF's pre-defined operations are in no way "privileged", but it is +requested that developers never use the `asdf' package for operations +they develop themselves. The rationale for this rule is that we don't +want to establish a "global asdf operation name registry", but also +want to avoid name clashes. + + Your operation _must_ usually provide methods for one or more of the +following generic functions: + + * `perform' Unless your operation, like `prepare-op', is for + dependency propagation only, the most important function for which + to define a method is usually `perform', which will be called to + perform the operation on a specified component, after all + dependencies have been performed. + + The `perform' method must call `output-files' (see below) to find + out where to put its files, because the user is allowed to + override the method or tweak the output-translation mechanism. + Perform should only use the primary value returned by + `output-files'. If one and only one output file is expected, it + can call `output-file' that checks that this is the case and + returns the first and only list element. + + * `output-files' If your perform method has any output, you must + define a method for this function. for ASDF to determine where + the outputs of performing operation lie. + + Your method may return two values, a list of pathnames, and a + boolean. If the boolean is `nil' (or you fail to return multiple + values), then enclosing `:around' methods may translate these + pathnames, e.g. to ensure object files are somehow stored in some + implementation-dependent cache. If the boolean is `t' then the + pathnames are marked not be translated by the enclosing `:around' + method. + + * `component-depends-on' If the action of performing the operation + on a component has dependencies, you must define a method on + `component-depends-on'. + + Your method will take as specialized arguments an operation and a + component which together identify an action, and return a list of + entries describing actions that this action depends on. The + format of entries is described below. + + It is _strongly_ advised that you should always append the results + of `(call-next-method)' to the results of your method, or + "interesting" failures will likely occur, unless you're a true + specialist of ASDF internals. It is unhappily too late to + compatibly use the `append' method combination, but conceptually + that's the protocol that is being manually implemented. + + Each entry returned by `component-depends-on' is itself a list. + + The first element of an entry is an operation designator: either + an operation object designating itself, or a symbol that names an + operation class (that ASDF will instantiate using + `make-operation'). For instance, `load-op', `compile-op' and + `prepare-op' are common such names, denoting the respective + operations. + + The rest of each entry is a list of component designators: either + a component object designating itself, or an identifier to be used + with `find-component'. `find-component' will be called with the + current component's parent as parent, and the identifier as second + argument. The identifier is typically a string, a symbol (to be + downcased as per `coerce-name'), or a list of strings or symbols. + In particular, the empty list `nil' denotes the parent itself. + + + An operation _may_ provide methods for the following generic +functions: + + * `input-files' A method for this function is often not needed, + since ASDF has a pretty clever default `input-files' mechanism. + You only need create a method if there are multiple ultimate input + files, and/or the bottom one doesn't depend on the + `component-pathname' of the component. + + * `operation-done-p' You only need to define a method on that + function if you can detect conditions that invalidate previous + runs of the operation, even though no filesystem timestamp has + changed, in which case you return `nil' (the default is `t'). + + For instance, the method for `test-op' always returns `nil', so + that tests are always run afresh. Of course, the `test-op' for + your system could depend on a deterministically repeatable + `test-report-op', and just read the results from the report files, + in which case you could have this method return `t'. + + + Operations that print output should send that output to the standard +CL stream `*standard-output*', as the Lisp compiler and loader do. + + +File: asdf.info, Node: Components, Next: Functions, Prev: Operations, Up: The object model of ASDF + +6.2 Components +============== + +A "component" represents a source file or (recursively) a collection of +components. A "system" is (roughly speaking) a top-level component +that can be found via `find-system'. + + A "system designator" is a system itself, or a string or symbol that +behaves just like any other component name (including with regard to +the case conversion rules for component names). + + A "component designator", relative to a base component, is either a +component itself, or a string or symbol, or a list of designators. + + -- Function: find-system system-designator &optional (error-p t) + Given a system designator, `find-system' finds and returns a + system. If no system is found, an error of type + `missing-component' is thrown, or `nil' is returned if `error-p' + is false. + + To find and update systems, `find-system' funcalls each element in + the `*system-definition-search-functions*' list, expecting a + pathname to be returned, or a system object, from which a pathname + may be extracted, and that will be registered. The resulting + pathname (if any) is loaded if one of the following conditions is + true: + + * there is no system of that name in memory + + * the pathname is different from that which was previously + loaded + + * the file's `last-modified' time exceeds the `last-modified' + time of the system in memory + + When system definitions are loaded from `.asd' files, a new + scratch package is created for them to load into, so that + different systems do not overwrite each others operations. The + user may also wish to (and is recommended to) include `defpackage' + and `in-package' forms in his system definition files, however, so + that they can be loaded manually if need be. + + The default value of `*system-definition-search-functions*' is a + list of two functions. The first function looks in each of the + directories given by evaluating members of `*central-registry*' + for a file whose name is the name of the system and whose type is + `asd'. The first such file is returned, whether or not it turns + out to actually define the appropriate system. The second + function does something similar, for the directories specified in + the `source-registry'. Hence, it is strongly advised to define a + system FOO in the corresponding file FOO.ASD. + + -- Function: find-component base path + Given a BASE component (or designator for such), and a PATH, find + the component designated by the PATH starting from the BASE. + + If PATH is a component object, it designates itself, independently + from the base. + + If PATH is a string, or symbol denoting a string via `coerce-name', + then BASE is resolved to a component object, which must be a + system or module, and the designated component is the child named + by the PATH. + + If PATH is a `cons' cell, `find-component' with the base and the + `car' of the PATH, and the resulting object is used as the base + for a tail call to `find-component' with the `car' of the PATH. + + If BASE is a component object, it designates itself. + + If BASE is null, then PATH is used as the base, with `nil' as the + path. + + If BASE is a string, or symbol denoting a string via `coerce-name', + it designates a system as per `find-system'. + + If BASE is a `cons' cell, it designates the component found by + `find-component' with its `car' as base and `cdr' as path. + +* Menu: + +* Common attributes of components:: +* Pre-defined subclasses of component:: +* Creating new component types:: + + +File: asdf.info, Node: Common attributes of components, Next: Pre-defined subclasses of component, Prev: Components, Up: Components + +6.2.1 Common attributes of components +------------------------------------- + +All components, regardless of type, have the following attributes. All +attributes except `name' are optional. + +6.2.1.1 Name +............ + +A component name is a string or a symbol. If a symbol, its name is +taken and lowercased. + + Unless overridden by a `:pathname' attribute, the name will be +interpreted as a pathname specifier according to a Unix-style syntax. +*Note Pathname specifiers: The defsystem grammar. + +6.2.1.2 Version identifier +.......................... + +This optional attribute specifies a version for the current component. +The version should typically be a string of integers separated by dots, +for example `1.0.11'. For more information on version specifiers, see +*note The defsystem grammar::. + + A version may then be queried by the generic function +`version-satisfies', to see if `:version' dependencies are satisfied, +and when specifying dependencies, a constraint of minimal version to +satisfy can be specified using e.g. `(:version "mydepname" "1.0.11")'. + + Note that in the wild, we typically see version numbering only on +components of type `system'. Presumably it is much less useful within +a given system, wherein the library author is responsible to keep the +various files in synch. + +6.2.1.3 Required features +......................... + +Traditionally defsystem users have used `#+' reader conditionals to +include or exclude specific per-implementation files. This means that +any single implementation cannot read the entire system, which becomes +a problem if it doesn't wish to compile it, but instead for example to +create an archive file containing all the sources, as it will omit to +process the system-dependent sources for other systems. + + Each component in an asdf system may therefore specify using +`:if-feature' a feature expression using the same syntax as `#+' does, +such that any reference to the component will be ignored during +compilation, loading and/or linking if the expression evaluates to +false. Since the expression is read by the normal reader, you must +explicitly prefix your symbols with `:' so they be read as keywords; +this is as contrasted with the `#+' syntax that implicitly reads +symbols in the keyword package by default. + + For instance, `:if-feature (:and :x86 (:or :sbcl :cmu :scl))' +specifies that the given component is only to be compiled and loaded +when the implementation is SBCL, CMUCL or Scieneer CL on an x86 machine. +You can not write it as `:if-feature (and x86 (or sbcl cmu scl))' since +the symbols would presumably fail to be read as keywords. + +6.2.1.4 Dependencies +.................... + +This attribute specifies dependencies of the component on its siblings. +It is optional but often necessary. + + There is an excitingly complicated relationship between the initarg +and the method that you use to ask about dependencies + + Dependencies are between (operation component) pairs. In your +initargs for the component, you can say + + :in-order-to ((compile-op (load-op "a" "b") (compile-op "c")) + (load-op (load-op "foo"))) + + This means the following things: + * before performing compile-op on this component, we must perform + load-op on A and B, and compile-op on C, + + * before performing `load-op', we have to load FOO + + The syntax is approximately + +(this-op @{(other-op required-components)@}+) + +simple-component-name := string + | symbol + +required-components := simple-component-name + | (required-components required-components) + +component-name := simple-component-name + | (:version simple-component-name minimum-version-object) + + Side note: + + This is on a par with what ACL defsystem does. mk-defsystem is less +general: it has an implied dependency + + for all source file x, (load x) depends on (compile x) + + and using a `:depends-on' argument to say that B depends on A +_actually_ means that + + (compile b) depends on (load a) + + This is insufficient for e.g. the McCLIM system, which requires that +all the files are loaded before any of them can be compiled ] + + End side note + + In ASDF, the dependency information for a given component and +operation can be queried using `(component-depends-on operation +component)', which returns a list + + ((load-op "a") (load-op "b") (compile-op "c") ...) + + `component-depends-on' can be subclassed for more specific +component/operation types: these need to `(call-next-method)' and +append the answer to their dependency, unless they have a good reason +for completely overriding the default dependencies. + + If it weren't for CLISP, we'd be using `LIST' method combination to +do this transparently. But, we need to support CLISP. If you have the +time for some CLISP hacking, I'm sure they'd welcome your fixes. + + A minimal version can be specified for a component you depend on +(typically another system), by specifying `(:version "other-system" +"1.2.3")' instead of simply `"other-system"' as the dependency. See +the discussion of the semantics of `:version' in the defsystem grammar. + +6.2.1.5 pathname +................ + +This attribute is optional and if absent (which is the usual case), the +component name will be used. + + *Note Pathname specifiers: The defsystem grammar, for an explanation +of how this attribute is interpreted. + + Note that the `defsystem' macro (used to create a "top-level" system) +does additional processing to set the filesystem location of the top +component in that system. This is detailed elsewhere. *Note Defining +systems with defsystem::. + +6.2.1.6 properties +.................. + +This attribute is optional. + + Packaging systems often require information about files or systems +in addition to that specified by ASDF's pre-defined component +attributes. Programs that create vendor packages out of ASDF systems +therefore have to create "placeholder" information to satisfy these +systems. Sometimes the creator of an ASDF system may know the +additional information and wish to provide it directly. + + `(component-property component property-name)' and associated `setf' +method will allow the programmatic update of this information. +Property names are compared as if by `EQL', so use symbols or keywords +or something. + +* Menu: + +* Pre-defined subclasses of component:: +* Creating new component types:: + + +File: asdf.info, Node: Pre-defined subclasses of component, Next: Creating new component types, Prev: Common attributes of components, Up: Components + +6.2.2 Pre-defined subclasses of component +----------------------------------------- + + -- Component: source-file + A source file is any file that the system does not know how to + generate from other components of the system. + + Note that this is not necessarily the same thing as "a file + containing data that is typically fed to a compiler". If a file + is generated by some pre-processor stage (e.g. a `.h' file from + `.h.in' by autoconf) then it is not, by this definition, a source + file. Conversely, we might have a graphic file that cannot be + automatically regenerated, or a proprietary shared library that we + received as a binary: these do count as source files for our + purposes. + + Subclasses of source-file exist for various languages. _FIXME: + describe these._ + + -- Component: module + A module is a collection of sub-components. + + A module component has the following extra initargs: + + * `:components' the components contained in this module + + * `:default-component-class' All children components which + don't specify their class explicitly are inferred to be of + this type. + + * `:if-component-dep-fails' This attribute was removed in ASDF + 3. Do not use it. Use `:if-feature' instead. + + * `:serial' When this attribute is set, each subcomponent of + this component is assumed to depend on all subcomponents + before it in the list given to `:components', i.e. all of + them are loaded before a compile or load operation is + performed on it. + + + The default operation knows how to traverse a module, so most + operations will not need to provide methods specialised on modules. + + `module' may be subclassed to represent components such as + foreign-language linked libraries or archive files. + + -- Component: system + `system' is a subclass of `module'. + + A system is a module with a few extra attributes for documentation + purposes; these are given elsewhere. *Note The defsystem + grammar::. + + Users can create new classes for their systems: the default + `defsystem' macro takes a `:class' keyword argument. + + +File: asdf.info, Node: Creating new component types, Prev: Pre-defined subclasses of component, Up: Components + +6.2.3 Creating new component types +---------------------------------- + +New component types are defined by subclassing one of the existing +component classes and specializing methods on the new component class. + + _FIXME: this should perhaps be explained more throughly, not only by +example ..._ + + As an example, suppose we have some implementation-dependent +functionality that we want to isolate in one subdirectory per Lisp +implementation our system supports. We create a subclass of +`cl-source-file': + + (defclass unportable-cl-source-file (cl-source-file) + ()) + + Function `asdf:implementation-type' (exported since 2.014.14) gives +us the name of the subdirectory. All that's left is to define how to +calculate the pathname of an `unportable-cl-source-file'. + + (defmethod component-pathname ((component unportable-cl-source-file)) + (merge-pathnames* + (parse-unix-namestring (format nil "~(~A~)/" (asdf:implementation-type))) + (call-next-method))) + + The new component type is used in a `defsystem' form in this way: + + (defsystem :foo + :components + ((:file "packages") + ... + (:unportable-cl-source-file "threads" + :depends-on ("packages" ...)) + ... + ) + + +File: asdf.info, Node: Functions, Prev: Components, Up: The object model of ASDF + +6.3 Functions +============= + + -- version-satisfies: VERSION VERSION-SPEC + Does VERSION satisfy the VERSION-SPEC. A generic function. ASDF + provides built-in methods for VERSION being a `component' or + `string'. VERSION-SPEC should be a string. If it's a component, + its version is extracted as a string before further processing. + + A version string satisfies the version-spec if after parsing, the + former is no older than the latter. Therefore `"1.9.1"', + `"1.9.2"' and `"1.10"' all satisfy `"1.9.1"', but `"1.8.4"' or + `"1.9"' do not. For more information about how + `version-satisfies' parses and interprets version strings and + specifications, *note The defsystem grammar:: (version specifiers) + and *note Common attributes of components::. + + Note that in versions of ASDF prior to 3.0.1, including the entire + ASDF 1 and ASDF 2 series, `version-satisfies' would also require + that the version and the version-spec have the same major version + number (the first integer in the list); if the major version + differed, the version would be considered as not matching the spec. + But that feature was not documented, therefore presumably not + relied upon, whereas it was a nuisance to several users. Starting + with ASDF 3.0.1, `version-satisfies' does not treat the major + version number specially, and returns T simply if the first + argument designates a version that isn't older than the one + specified as a second argument. If needs be, the `(:version ...)' + syntax for specifying dependencies could be in the future extended + to specify an exclusive upper bound for compatible versions as + well as an inclusive lower bound. + + +File: asdf.info, Node: Controlling where ASDF searches for systems, Next: Controlling where ASDF saves compiled files, Prev: The object model of ASDF, Up: Top + +7 Controlling where ASDF searches for systems +********************************************* + +7.1 Configurations +================== + +Configurations specify paths where to find system files. + + 1. The search registry may use some hardcoded wrapping registry + specification. This allows some implementations (notably SBCL) to + specify where to find some special implementation-provided systems + that need to precisely match the version of the implementation + itself. + + 2. An application may explicitly initialize the source-registry + configuration using the configuration API (*note Configuration + API: Controlling where ASDF searches for systems, below) in which + case this takes precedence. It may itself compute this + configuration from the command-line, from a script, from its own + configuration file, etc. + + 3. The source registry will be configured from the environment + variable `CL_SOURCE_REGISTRY' if it exists. + + 4. The source registry will be configured from user configuration file + `$XDG_CONFIG_DIRS/common-lisp/source-registry.conf' (which + defaults to `~/.config/common-lisp/source-registry.conf') if it + exists. + + 5. The source registry will be configured from user configuration + directory `$XDG_CONFIG_DIRS/common-lisp/source-registry.conf.d/' + (which defaults to `~/.config/common-lisp/source-registry.conf.d/') + if it exists. + + 6. The source registry will be configured from system configuration + file `/etc/common-lisp/source-registry.conf' if it exists/ + + 7. The source registry will be configured from system configuration + directory `/etc/common-lisp/source-registry.conf.d/' if it exists. + + 8. The source registry will be configured from a default + configuration. This configuration may allow for + implementation-specific systems to be found, for systems to be + found the current directory (at the time that the configuration is + initialized) as well as `:directory' entries for + `$XDG_DATA_DIRS/common-lisp/systems/' and `:tree' entries for + `$XDG_DATA_DIRS/common-lisp/source/'. For instance, SBCL will + include directories for its contribs when it can find them; it + will look for them where SBCL was installed, or at the location + specified by the `SBCL_HOME' environment variable. + + + Each of these configurations is specified as an s-expression in a +trivial domain-specific language (defined below). Additionally, a more +shell-friendly syntax is available for the environment variable +(defined yet below). + + Each of these configurations is only used if the previous +configuration explicitly or implicitly specifies that it includes its +inherited configuration. + + Additionally, some implementation-specific directories may be +automatically prepended to whatever directories are specified in +configuration files, no matter if the last one inherits or not. + +7.2 Truenames and other dangers +=============================== + +One great innovation of the original ASDF was its ability to leverage +`CL:TRUENAME' to locate where your source code was and where to build +it, allowing for symlink farms as a simple but effective configuration +mechanism that is easy to control programmatically. ASDF 3 still +supports this configuration style, and it is enabled by default; +however we recommend you instead use our source-registry configuration +mechanism described below, because it is easier to setup in a portable +way across users and implementations. + + Addtionally, some people dislike truename, either because it is very +slow on their system, or because they are using content-addressed +storage where the truename of a file is related to a digest of its +individual contents, and not to other files in the same intended +project. For these people, ASDF 3 allows to eschew the `TRUENAME' +mechanism, by setting the variable ASDF:*RESOLVE-SYMLINKS* to `nil'. + + PS: Yes, if you haven't read Vernor Vinge's short but great classic +"True Names... and Other Dangers" then you're in for a treat. + +7.3 XDG base directory +====================== + +Note that we purport to respect the XDG base directory specification as +to where configuration files are located, where data files are located, +where output file caches are located. Mentions of XDG variables refer +to that document. + +`http://standards.freedesktop.org/basedir-spec/basedir-spec-latest.html' + + This specification allows the user to specify some environment +variables to customize how applications behave to his preferences. + + On Windows platforms, when not using Cygwin, instead of the XDG base +directory specification, we try to use folder configuration from the +registry regarding `Common AppData' and similar directories. Since +support for querying the Windows registry is not possible to do in +reasonable amounts of portable Common Lisp code, ASDF 3 relies on the +environment variables that Windows usually exports. + +7.4 Backward Compatibility +========================== + +For backward compatibility as well as to provide a practical backdoor +for hackers, ASDF will first search for `.asd' files in the directories +specified in `asdf:*central-registry*' before it searches in the source +registry above. + + *Note Configuring ASDF to find your systems -- old style: +Configuring ASDF. + + By default, `asdf:*central-registry*' will be empty. + + This old mechanism will therefore not affect you if you don't use it, +but will take precedence over the new mechanism if you do use it. + +7.5 Configuration DSL +===================== + +Here is the grammar of the s-expression (SEXP) DSL for source-registry +configuration: + + ;; A configuration is a single SEXP starting with keyword :source-registry + ;; followed by a list of directives. + CONFIGURATION := (:source-registry DIRECTIVE ...) + + ;; A directive is one of the following: + DIRECTIVE := + ;; INHERITANCE DIRECTIVE: + ;; Your configuration expression MUST contain + ;; exactly one of either of these: + :inherit-configuration | ; splices inherited configuration (often specified last) + :ignore-inherited-configuration | ; drop inherited configuration (specified anywhere) + + ;; forward compatibility directive (since ASDF 2.011.4), useful when + ;; you want to use new configuration features but have to bootstrap a + ;; the newer required ASDF from an older release that doesn't sport said features: + :ignore-invalid-entries | ; drops subsequent invalid entries instead of erroring out + + ;; add a single directory to be scanned (no recursion) + (:directory DIRECTORY-PATHNAME-DESIGNATOR) | + + ;; add a directory hierarchy, recursing but excluding specified patterns + (:tree DIRECTORY-PATHNAME-DESIGNATOR) | + + ;; override the defaults for exclusion patterns + (:exclude EXCLUSION-PATTERN ...) | + ;; augment the defaults for exclusion patterns + (:also-exclude EXCLUSION-PATTERN ...) | + ;; Note that the scope of a an exclude pattern specification is + ;; the rest of the current configuration expression or file. + + ;; splice the parsed contents of another config file + (:include REGULAR-FILE-PATHNAME-DESIGNATOR) | + + ;; This directive specifies that some default must be spliced. + :default-registry + + REGULAR-FILE-PATHNAME-DESIGNATOR := PATHNAME-DESIGNATOR ;; interpreted as a file + DIRECTORY-PATHNAME-DESIGNATOR := PATHNAME-DESIGNATOR ;; interpreted as a directory name + + PATHNAME-DESIGNATOR := + NIL | ;; Special: skip this entry. + ABSOLUTE-COMPONENT-DESIGNATOR ;; see pathname DSL + + EXCLUSION-PATTERN := a string without wildcards, that will be matched exactly + against the name of a any subdirectory in the directory component + of a path. e.g. `"_darcs"' will match `#p"/foo/bar/_darcs/src/bar.asd"' + + Pathnames are designated using another DSL, shared with the +output-translations configuration DSL below. The DSL is resolved by +the function `asdf::resolve-location', to be documented and exported at +some point in the future. + + ABSOLUTE-COMPONENT-DESIGNATOR := + (ABSOLUTE-COMPONENT-DESIGNATOR RELATIVE-COMPONENT-DESIGNATOR ...) | + STRING | ;; namestring (better be absolute or bust, directory assumed where applicable). + ;; In output-translations, directory is assumed and **/*.*.* added if it's last. + ;; On MCL, a MacOSX-style POSIX namestring (for MacOS9 style, use #p"..."); + ;; Note that none of the above applies to strings used in *central-registry*, + ;; which doesn't use this DSL: they are processed as normal namestrings. + ;; however, you can compute what you put in the *central-registry* + ;; based on the results of say (asdf::resolve-location "/Users/fare/cl/cl-foo/") + PATHNAME | ;; pathname (better be an absolute path, or bust) + ;; In output-translations, unless followed by relative components, + ;; it better have appropriate wildcards, as in **/*.*.* + :HOME | ;; designates the user-homedir-pathname ~/ + :USER-CACHE | ;; designates the default location for the user cache + :HERE | ;; designates the location of the configuration file + ;; (or *default-pathname-defaults*, if invoked interactively) + :ROOT ;; magic, for output-translations source only: paths that are relative + ;; to the root of the source host and device + ;; Not valid anymore: :SYSTEM-CACHE (was a security hazard) + + RELATIVE-COMPONENT-DESIGNATOR := + (RELATIVE-COMPONENT-DESIGNATOR RELATIVE-COMPONENT-DESIGNATOR ...) | + STRING | ;; relative directory pathname as interpreted by parse-unix-namestring. + ;; In output translations, if last component, **/*.*.* is added + PATHNAME | ;; pathname; unless last component, directory is assumed. + :IMPLEMENTATION | ;; directory based on implementation, e.g. sbcl-1.0.45-linux-x64 + :IMPLEMENTATION-TYPE | ;; a directory based on lisp-implementation-type only, e.g. sbcl + :DEFAULT-DIRECTORY | ;; a relativized version of the default directory + :*/ | ;; any direct subdirectory (since ASDF 2.011.4) + :**/ | ;; any recursively inferior subdirectory (since ASDF 2.011.4) + :*.*.* | ;; any file (since ASDF 2.011.4) + ;; Not supported (anymore): :UID and :USERNAME + + For instance, as a simple case, my +`~/.config/common-lisp/source-registry.conf', which is the default +place ASDF looks for this configuration, once contained: + (:source-registry + (:tree (:home "cl")) ;; will expand to e.g. "/home/joeluser/cl/" + :inherit-configuration) + +7.6 Configuration Directories +============================= + +Configuration directories consist in files each containing a list of +directives without any enclosing `(:source-registry ...)' form. The +files will be sorted by namestring as if by `string<' and the lists of +directives of these files with be concatenated in order. An implicit +`:inherit-configuration' will be included at the _end_ of the list. + + This allows for packaging software that has file granularity (e.g. +Debian's `dpkg' or some future version of `clbuild') to easily include +configuration information about distributed software. + + The convention is that, for sorting purposes, the names of files in +such a directory begin with two digits that determine the order in +which these entries will be read. Also, the type of these files is +conventionally `"conf"' and as a limitation to some implementations +(e.g. GNU clisp), the type cannot be `nil'. + + Directories may be included by specifying a directory pathname or +namestring in an `:include' directive, e.g.: + + (:include "/foo/bar/") + + Hence, to achieve the same effect as my example +`~/.config/common-lisp/source-registry.conf' above, I could simply +create a file +`~/.config/common-lisp/source-registry.conf.d/33-home-fare-cl.conf' +alone in its directory with the following contents: + (:tree "/home/fare/cl/") + +7.6.1 The :here directive +------------------------- + +The `:here' directive is an absolute pathname designator that refers to +the directory containing the configuration file currently being +processed. + + The `:here' directive is intended to simplify the delivery of +complex CL systems, and for easy configuration of projects shared +through revision control systems, in accordance with our design +principle that each participant should be able to provide all and only +the information available to him or her. + + Consider a person X who has set up the source code repository for a +complex project with a master directory `dir/'. Ordinarily, one might +simply have the user add a directive that would look something like +this: + (:tree "path/to/dir") + But what if X knows that there are very large subtrees under dir +that are filled with, e.g., Java source code, image files for icons, +etc.? All of the asdf system definitions are contained in the +subdirectories `dir/src/lisp/' and `dir/extlib/lisp/', and these are +the only directories that should be searched. + + In this case, X can put into `dir/' a file `asdf.conf' that contains +the following: + (:source-registry + (:tree (:here "src/lisp/")) + (:tree (:here "extlib/lisp")) + (:directory (:here "outlier/"))) + + Then when someone else (call her Y) checks out a copy of this +repository, she need only add + (:include "/path/to/my/checkout/directory/asdf.conf") + to one of her previously-existing asdf source location configuration +files, or invoke `initialize-source-registry' with a configuration form +containing that s-expression. ASDF will find the .conf file that X has +provided, and then set up source locations within the working directory +according to X's (relative) instructions. + +7.7 Shell-friendly syntax for configuration +=========================================== + +When considering environment variable `CL_SOURCE_REGISTRY' ASDF will +skip to next configuration if it's an empty string. It will `READ' the +string as a SEXP in the DSL if it begins with a paren `(' and it will +be interpreted much like `TEXINPUTS' list of paths, where + + * paths are separated by a `:' (colon) on Unix platforms +(including cygwin), by a `;' (semicolon) on other platforms (mainly, +Windows). + + * each entry is a directory to add to the search path. + + * if the entry ends with a double slash `//' then it instead +indicates a tree in the subdirectories of which to recurse. + + * if the entry is the empty string (which may only appear once), +then it indicates that the inherited configuration should be +spliced there. + +7.8 Search Algorithm +==================== + +In case that isn't clear, the semantics of the configuration is that +when searching for a system of a given name, directives are processed +in order. + + When looking in a directory, if the system is found, the search +succeeds, otherwise it continues. + + When looking in a tree, if one system is found, the search succeeds. +If multiple systems are found, the consequences are unspecified: the +search may succeed with any of the found systems, or an error may be +raised. ASDF currently returns the first system found, XCVB currently +raised an error. If none is found, the search continues. + + Exclude statements specify patterns of subdirectories the systems +from which to ignore. Typically you don't want to use copies of files +kept by such version control systems as Darcs. Exclude statements are +not propagated to further included or inherited configuration files or +expressions; instead the defaults are reset around every configuration +statement to the default defaults from +`asdf::*default-source-registry-exclusions*'. + + Include statements cause the search to recurse with the path +specifications from the file specified. + + An inherit-configuration statement cause the search to recurse with +the path specifications from the next configuration (*note +Configurations: Controlling where ASDF searches for systems. above). + +7.9 Caching Results +=================== + +The implementation is allowed to either eagerly compute the information +from the configurations and file system, or to lazily re-compute it +every time, or to cache any part of it as it goes. To explicitly flush +any information cached by the system, use the API below. + +7.10 Configuration API +====================== + +The specified functions are exported from your build system's package. +Thus for ASDF the corresponding functions are in package ASDF, and for +XCVB the corresponding functions are in package XCVB. + + -- Function: initialize-source-registry &optional PARAMETER + will read the configuration and initialize all internal variables. + You may extend or override configuration from the environment + and configuration files with the given PARAMETER, which can be + `nil' (no configuration override), or a SEXP (in the SEXP DSL), + a string (as in the string DSL), a pathname (of a file or + directory with configuration), or a symbol (fbound to function + that when called returns one of the above). + + -- Function: clear-source-registry + undoes any source registry configuration and clears any cache + for the search algorithm. You might want to call this function + (or better, `clear-configuration') before you dump an image + that would be resumed with a different configuration, and + return an empty configuration. Note that this does not include + clearing information about systems defined in the current + image, only about where to look for systems not yet defined. + + -- Function: ensure-source-registry &optional PARAMETER + checks whether a source registry has been initialized. If not, + initialize it with the given PARAMETER. + + Every time you use ASDF's `find-system', or anything that uses it +(such as `operate', `load-system', etc.), `ensure-source-registry' is +called with parameter `nil', which the first time around causes your +configuration to be read. If you change a configuration file, you need +to explicitly `initialize-source-registry' again, or maybe simply to +`clear-source-registry' (or `clear-configuration') which will cause the +initialization to happen next time around. + +7.11 Status +=========== + +This mechanism is vastly successful, and we have declared that +`asdf:*central-registry*' is not recommended anymore, though we will +continue to support it. All hooks into implementation-specific search +mechanisms have been integrated in the `wrapping-source-registry' that +everyone uses implicitly. + +7.12 Rejected ideas +=================== + +Alternatives I considered and rejected included: + + 1. Keep `asdf:*central-registry*' as the master with its current + semantics, and somehow the configuration parser expands the new + configuration language into a expanded series of directories of + subdirectories to lookup, pre-recursing through specified + hierarchies. This is kludgy, and leaves little space of future + cleanups and extensions. + + 2. Keep `asdf:*central-registry*' remains the master but extend its + semantics in completely new ways, so that new kinds of entries + may be implemented as a recursive search, etc. This seems + somewhat backwards. + + 3. Completely remove `asdf:*central-registry*' and break backwards + compatibility. Hopefully this will happen in a few years after + everyone migrate to a better ASDF and/or to XCVB, but it would + be very bad to do it now. + + 4. Replace `asdf:*central-registry*' by a symbol-macro with + appropriate magic when you dereference it or setf it. Only the + new variable with new semantics is handled by the new search + procedure. Complex and still introduces subtle semantic issues. + + I've been suggested the below features, but have rejected them, for +the sake of keeping ASDF no more complex than strictly necessary. + + * More syntactic sugar: synonyms for the configuration directives, + such as `(:add-directory X)' for `(:directory X)', or + `(:add-directory-hierarchy X)' or `(:add-directory X :recurse + t)' for `(:tree X)'. + + * The possibility to register individual files instead of + directories. + + * Integrate Xach Beane's tilde expander into the parser, or + something similar that is shell-friendly or shell-compatible. + I'd rather keep ASDF minimal. But maybe this precisely keeps it + minimal by removing the need for evaluated entries that ASDF has? + i.e. uses of `USER-HOMEDIR-PATHNAME' and `$SBCL_HOME' + Hopefully, these are already superseded by the `:default-registry' + + * Using the shell-unfriendly syntax `/**' instead of `//' to + specify recursion down a filesystem tree in the environment + variable. It isn't that Lisp friendly either. + +7.13 TODO +========= + + * Add examples + +7.14 Credits for the source-registry +==================================== + +Thanks a lot to Stelian Ionescu for the initial idea. + + Thanks to Rommel Martinez for the initial implementation attempt. + + All bad design ideas and implementation bugs are to mine, not theirs. +But so are good design ideas and elegant implementation tricks. + + -- Francois-Rene Rideau <fare(a)tunes.org>, Mon, 22 Feb 2010 00:07:33 +-0500 + + +File: asdf.info, Node: Controlling where ASDF saves compiled files, Next: Error handling, Prev: Controlling where ASDF searches for systems, Up: Top + +8 Controlling where ASDF saves compiled files +********************************************* + +Each Common Lisp implementation has its own format for compiled files +(fasls for short, short for "fast loading"). If you use multiple +implementations (or multiple versions of the same implementation), +you'll soon find your source directories littered with various `fasl's, +`dfsl's, `cfsl's and so on. Worse yet, some implementations use the +same file extension while changing formats from version to version (or +platform to platform) which means that you'll have to recompile binaries +as you switch from one implementation to the next. + + Since ASDF 2, ASDF includes the `asdf-output-translations' facility +to mitigate the problem. + +8.1 Configurations +================== + +Configurations specify mappings from input locations to output +locations. Once again we rely on the XDG base directory specification +for configuration. *Note XDG base directory: Controlling where ASDF +searches for systems. + + 1. Some hardcoded wrapping output translations configuration may be + used. This allows special output translations (or usually, + invariant directories) to be specified corresponding to the + similar special entries in the source registry. + + 2. An application may explicitly initialize the output-translations + configuration using the Configuration API in which case this takes + precedence. (*note Configuration API: Controlling where ASDF + saves compiled files.) It may itself compute this configuration + from the command-line, from a script, from its own configuration + file, etc. + + 3. The source registry will be configured from the environment + variable `ASDF_OUTPUT_TRANSLATIONS' if it exists. + + 4. The source registry will be configured from user configuration file + `$XDG_CONFIG_DIRS/common-lisp/asdf-output-translations.conf' + (which defaults to + `~/.config/common-lisp/asdf-output-translations.conf') if it + exists. + + 5. The source registry will be configured from user configuration + directory + `$XDG_CONFIG_DIRS/common-lisp/asdf-output-translations.conf.d/' + (which defaults to + `~/.config/common-lisp/asdf-output-translations.conf.d/') if it + exists. + + 6. The source registry will be configured from system configuration + file `/etc/common-lisp/asdf-output-translations.conf' if it exists. + + 7. The source registry will be configured from system configuration + directory `/etc/common-lisp/asdf-output-translations.conf.d/' if + it exists. + + + Each of these configurations is specified as a SEXP in a trival +domain-specific language (defined below). Additionally, a more +shell-friendly syntax is available for the environment variable +(defined yet below). + + Each of these configurations is only used if the previous +configuration explicitly or implicitly specifies that it includes its +inherited configuration. + + Note that by default, a per-user cache is used for output files. +This allows the seamless use of shared installations of software +between several users, and takes files out of the way of the developers +when they browse source code, at the expense of taking a small toll +when developers have to clean up output files and find they need to get +familiar with output-translations first. + +8.2 Backward Compatibility +========================== + +We purposefully do NOT provide backward compatibility with earlier +versions of `ASDF-Binary-Locations' (8 Sept 2009), +`common-lisp-controller' (7.0) or `cl-launch' (2.35), each of which had +similar general capabilities. The previous APIs of these programs were +not designed for configuration by the end-user in an easy way with +configuration files. Recent versions of same packages use the new +`asdf-output-translations' API as defined below: +`common-lisp-controller' (7.2) and `cl-launch' (3.000). +`ASDF-Binary-Locations' is fully superseded and not to be used anymore. + + This incompatibility shouldn't inconvenience many people. Indeed, +few people use and customize these packages; these few people are +experts who can trivially adapt to the new configuration. Most people +are not experts, could not properly configure these features (except +inasmuch as the default configuration of `common-lisp-controller' +and/or `cl-launch' might have been doing the right thing for some +users), and yet will experience software that "just works", as +configured by the system distributor, or by default. + + Nevertheless, if you are a fan of `ASDF-Binary-Locations', we +provide a limited emulation mode: + + -- Function: enable-asdf-binary-locations-compatibility &key + centralize-lisp-binaries default-toplevel-directory + include-per-user-information map-all-source-files + source-to-target-mappings + This function will initialize the new `asdf-output-translations' + facility in a way that emulates the behavior of the old + `ASDF-Binary-Locations' facility. Where you would previously set + global variables *CENTRALIZE-LISP-BINARIES*, + *DEFAULT-TOPLEVEL-DIRECTORY*, *INCLUDE-PER-USER-INFORMATION*, + *MAP-ALL-SOURCE-FILES* or *SOURCE-TO-TARGET-MAPPINGS* you will now + have to pass the same values as keyword arguments to this function. + Note however that as an extension the `:source-to-target-mappings' + keyword argument will accept any valid pathname designator for + `asdf-output-translations' instead of just strings and pathnames. + + If you insist, you can also keep using the old +`ASDF-Binary-Locations' (the one available as an extension to load of +top of ASDF, not the one built into a few old versions of ASDF), but +first you must disable `asdf-output-translations' with +`(asdf:disable-output-translations)', or you might experience +"interesting" issues. + + Also, note that output translation is enabled by default. To +disable it, use `(asdf:disable-output-translations)'. + +8.3 Configuration DSL +===================== + +Here is the grammar of the SEXP DSL for `asdf-output-translations' +configuration: + +;; A configuration is single SEXP starting with keyword :source-registry +;; followed by a list of directives. +CONFIGURATION := (:output-translations DIRECTIVE ...) + +;; A directive is one of the following: +DIRECTIVE := + ;; INHERITANCE DIRECTIVE: + ;; Your configuration expression MUST contain + ;; exactly one of either of these: + :inherit-configuration | ; splices inherited configuration (often specified last) + :ignore-inherited-configuration | ; drop inherited configuration (specified anywhere) + + ;; forward compatibility directive (since ASDF 2.011.4), useful when + ;; you want to use new configuration features but have to bootstrap a + ;; the newer required ASDF from an older release that doesn't sport said features: + :ignore-invalid-entries | ; drops subsequent invalid entries instead of erroring out + + ;; include a configuration file or directory + (:include PATHNAME-DESIGNATOR) | + + ;; enable global cache in ~/.common-lisp/cache/sbcl-1.0.45-linux-amd64/ or something. + :enable-user-cache | + ;; Disable global cache. Map / to / + :disable-cache | + + ;; add a single directory to be scanned (no recursion) + (DIRECTORY-DESIGNATOR DIRECTORY-DESIGNATOR) + + ;; use a function to return the translation of a directory designator + (DIRECTORY-DESIGNATOR (:function TRANSLATION-FUNCTION)) + +DIRECTORY-DESIGNATOR := + NIL | ;; As source: skip this entry. As destination: same as source + T | ;; as source matches anything, as destination leaves pathname unmapped. + ABSOLUTE-COMPONENT-DESIGNATOR ;; same as in the source-registry language + +TRANSLATION-FUNCTION := + SYMBOL | ;; symbol of a function that takes two arguments, + ;; the pathname to be translated and the matching DIRECTORY-DESIGNATOR + LAMBDA ;; A form which evalutates to a function taking two arguments consisting of + ;; the pathname to be translated and the matching DIRECTORY-DESIGNATOR + + Relative components better be either relative or subdirectories of +the path before them, or bust. + + The last component, if not a pathname, is notionally completed by +`/**/*.*'. You can specify more fine-grained patterns by using a +pathname object as the last component e.g. +`#p"some/path/**/foo*/bar-*.fasl"' + + You may use `#+features' to customize the configuration file. + + The second designator of a mapping may be `nil', indicating that +files are not mapped to anything but themselves (same as if the second +designator was the same as the first). + + When the first designator is `t', the mapping always matches. When +the first designator starts with `:root', the mapping matches any host +and device. In either of these cases, if the second designator isn't +`t' and doesn't start with `:root', then strings indicating the host +and pathname are somehow copied in the beginning of the directory +component of the source pathname before it is translated. + + When the second designator is `t', the mapping is the identity. +When the second designator starts with `:root', the mapping preserves +the host and device of the original pathname. Notably, this allows you +to map files to a subdirectory of the whichever directory the file is +in. Though the syntax is not quite as easy to use as we'd like, you +can have an (source destination) mapping entry such as follows in your +configuration file, or you may use +`enable-asdf-binary-locations-compatibility' with +`:centralize-lisp-binaries nil' which will do the same thing internally +for you: + #.(let ((wild-subdir (make-pathname :directory '(:relative :wild-inferiors))) + (wild-file (make-pathname :name :wild :version :wild :type :wild))) + `((:root ,wild-subdir ,wild-file) ;; Or using the implicit wildcard, just :root + (:root ,wild-subdir :implementation ,wild-file))) + Starting with ASDF 2.011.4, you can use the simpler: ``(:root (:root +:**/ :implementation :*.*.*))' + + `:include' statements cause the search to recurse with the path +specifications from the file specified. + + If the `translate-pathname' mechanism cannot achieve a desired +translation, the user may provide a function which provides the +required algorithim. Such a translation function is specified by +supplying a list as the second `directory-designator' the first element +of which is the keyword `:function', and the second element of which is +either a symbol which designates a function or a lambda expression. +The function designated by the second argument must take two arguments, +the first being the pathname of the source file, the second being the +wildcard that was matched. The result of the function invocation +should be the translated pathname. + + An `:inherit-configuration' statement cause the search to recurse +with the path specifications from the next configuration. *Note +Configurations: Controlling where ASDF saves compiled files, above. + + * `:enable-user-cache' is the same as `(t :user-cache)'. + + * `:disable-cache' is the same as `(t t)'. + + * `:user-cache' uses the contents of variable `asdf::*user-cache*' + which by default is the same as using `(:home ".cache" + "common-lisp" :implementation)'. + + * `:system-cache' uses the contents of variable + `asdf::*system-cache*' which by default is the same as using + `("/var/cache/common-lisp" :uid :implementation-type)' (on Unix + and cygwin), or something semi-sensible on Windows. + +8.4 Configuration Directories +============================= + +Configuration directories consist in files each contains a list of +directives without any enclosing `(:output-translations ...)' form. +The files will be sorted by namestring as if by `string<' and the lists +of directives of these files with be concatenated in order. An +implicit `:inherit-configuration' will be included at the _end_ of the +list. + + This allows for packaging software that has file granularity (e.g. +Debian's `dpkg' or some future version of `clbuild') to easily include +configuration information about software being distributed. + + The convention is that, for sorting purposes, the names of files in +such a directory begin with two digits that determine the order in +which these entries will be read. Also, the type of these files is +conventionally `"conf"' and as a limitation of some implementations, +the type cannot be `nil'. + + Directories may be included by specifying a directory pathname or +namestring in an `:include' directive, e.g.: + (:include "/foo/bar/") + +8.5 Shell-friendly syntax for configuration +=========================================== + +When considering environment variable `ASDF_OUTPUT_TRANSLATIONS' ASDF +will skip to next configuration if it's an empty string. It will +`READ' the string as an SEXP in the DSL if it begins with a paren `(' +and it will be interpreted as a list of directories. Directories +should come by pairs, indicating a mapping directive. Entries are +separated by a `:' (colon) on Unix platforms (including cygwin), by a +`;' (semicolon) on other platforms (mainly, Windows). + + The magic empty entry, if it comes in what would otherwise be the +first entry in a pair, indicates the splicing of inherited +configuration. If it comes as the second entry in a pair, it indicates +that the directory specified first is to be left untranslated (which +has the same effect as if the directory had been repeated). + +8.6 Semantics of Output Translations +==================================== + +From the specified configuration, a list of mappings is extracted in a +straightforward way: mappings are collected in order, recursing through +included or inherited configuration as specified. To this list is +prepended some implementation-specific mappings, and is appended a +global default. + + The list is then compiled to a mapping table as follows: for each +entry, in order, resolve the first designated directory into an actual +directory pathname for source locations. If no mapping was specified +yet for that location, resolve the second designated directory to an +output location directory add a mapping to the table mapping the source +location to the output location, and add another mapping from the +output location to itself (unless a mapping already exists for the +output location). + + Based on the table, a mapping function is defined, mapping source +pathnames to output pathnames: given a source pathname, locate the +longest matching prefix in the source column of the mapping table. +Replace that prefix by the corresponding output column in the same row +of the table, and return the result. If no match is found, return the +source pathname. (A global default mapping the filesystem root to +itself may ensure that there will always be a match, with same +fall-through semantics). + +8.7 Caching Results +=================== + +The implementation is allowed to either eagerly compute the information +from the configurations and file system, or to lazily re-compute it +every time, or to cache any part of it as it goes. To explicitly flush +any information cached by the system, use the API below. + +8.8 Output location API +======================= + +The specified functions are exported from package ASDF. + + -- Function: initialize-output-translations &optional PARAMETER + will read the configuration and initialize all internal variables. + You may extend or override configuration from the environment + and configuration files with the given PARAMETER, which can be + `nil' (no configuration override), or a SEXP (in the SEXP DSL), + a string (as in the string DSL), a pathname (of a file or + directory with configuration), or a symbol (fbound to function + that when called returns one of the above). + + -- Function: disable-output-translations + will initialize output translations in a way that maps every + pathname to itself, effectively disabling the output + translation facility. + + -- Function: clear-output-translations + undoes any output translation configuration and clears any + cache for the mapping algorithm. You might want to call this + function (or better, `clear-configuration') before you dump + an image that would be resumed with a different configuration, + and return an empty configuration. Note that this does not + include clearing information about systems defined in the + current image, only about where to look for systems not yet + defined. + + -- Function: ensure-output-translations &optional PARAMETER + checks whether output translations have been initialized. If + not, initialize them with the given PARAMETER. This function + will be called before any attempt to operate on a system. + + -- Function: apply-output-translations PATHNAME + Applies the configured output location translations to PATHNAME + (calls `ensure-output-translations' for the translations). + + Every time you use ASDF's `output-files', or anything that uses it +(that may compile, such as `operate', `perform', etc.), +`ensure-output-translations' is called with parameter `nil', which the +first time around causes your configuration to be read. If you change +a configuration file, you need to explicitly +`initialize-output-translations' again, or maybe +`clear-output-translations' (or `clear-configuration'), which will +cause the initialization to happen next time around. + +8.9 Credits for output translations +=================================== + +Thanks a lot to Bjorn Lindberg and Gary King for +`ASDF-Binary-Locations', and to Peter van Eynde for `Common Lisp +Controller'. + + All bad design ideas and implementation bugs are to mine, not theirs. +But so are good design ideas and elegant implementation tricks. + + -- Francois-Rene Rideau <fare(a)tunes.org> + + +File: asdf.info, Node: Error handling, Next: Miscellaneous additional functionality, Prev: Controlling where ASDF saves compiled files, Up: Top + +9 Error handling +**************** + +9.1 ASDF errors +=============== + +If ASDF detects an incorrect system definition, it will signal a +generalised instance of `SYSTEM-DEFINITION-ERROR'. + + Operations may go wrong (for example when source files contain +errors). These are signalled using generalised instances of +`OPERATION-ERROR'. + +9.2 Compilation error and warning handling +========================================== + +ASDF checks for warnings and errors when a file is compiled. The +variables *COMPILE-FILE-WARNINGS-BEHAVIOUR* and +*COMPILE-FILE-ERRORS-BEHAVIOR* control the handling of any such events. +The valid values for these variables are `:error', `:warn', and +`:ignore'. + + +File: asdf.info, Node: Miscellaneous additional functionality, Next: Getting the latest version, Prev: Error handling, Up: Top + +10 Miscellaneous additional functionality +***************************************** + +ASDF includes several additional features that are generally useful for +system definition and development. + +10.1 Controlling file compilation +================================= + +When declaring a component (system, module, file), you can specify a +keyword argument `:around-compile function'. If left unspecified (and +therefore unbound), the value will be inherited from the parent +component if any, or with a default of `nil' if no value is specified +in any transitive parent. + + The argument must be a either `nil', a fbound symbol, a +lambda-expression (e.g. `(lambda (thunk) ...(funcall thunk ...) ...)') +a function object (e.g. using `#.#'' but that's discouraged because it +prevents the introspection done by e.g. asdf-dependency-grovel), or a +string that when `read' yields a symbol or a lambda-expression. `nil' +means the normal compile-file function will be called. A non-nil value +designates a function of one argument that will be called with a +function that will invoke `compile-file*' with various arguments; the +around-compile hook may supply additional keyword arguments to pass to +that call to `compile-file*'. + + One notable argument that is heeded by `compile-file*' is +`:compile-check', a function called when the compilation was otherwise +a success, with the same arguments as `compile-file'; the function +shall return true if the compilation and its resulting compiled file +respected all system-specific invariants, and false (`nil') if it broke +any of those invariants; it may issue warnings or errors before it +returns `nil'. (NB: The ability to pass such extra flags is only +available starting with ASDF 2.22.3.) This feature is notably +exercised by asdf-finalizers. + + By using a string, you may reference a function, symbol and/or +package that will only be created later during the build, but isn't yet +present at the time the defsystem form is evaluated. However, if your +entire system is using such a hook, you may have to explicitly override +the hook with `nil' for all the modules and files that are compiled +before the hook is defined. + + Using this hook, you may achieve such effects as: locally renaming +packages, binding *READTABLES* and other syntax-controlling variables, +handling warnings and other conditions, proclaiming consistent +optimization settings, saving code coverage information, maintaining +meta-data about compilation timings, setting gensym counters and PRNG +seeds and other sources of non-determinism, overriding the +source-location and/or timestamping systems, checking that some +compile-time side-effects were properly balanced, etc. + + Note that there is no around-load hook. This is on purpose. Some +implementations such as ECL, GCL or MKCL link object files, which +allows for no such hook. Other implementations allow for concatenating +FASL files, which doesn't allow for such a hook either. We aim to +discourage something that's not portable, and has some dubious impact +on performance and semantics even when it is possible. Things you +might want to do with an around-load hook are better done +around-compile, though it may at times require some creativity (see +e.g. the `package-renaming' system). + +10.2 Controlling source file character encoding +=============================================== + +Starting with ASDF 2.21, components accept a `:encoding' option so +authors may specify which character encoding should be used to read and +evaluate their source code. When left unspecified, the encoding is +inherited from the parent module or system; if no encoding is specified +at any point, the default `:autodetect' is assumed. By default, only +`:default', `:utf-8' and `:autodetect' are accepted. `:autodetect', +the default, calls `*encoding-detection-hook*' which by default always +returns `*default-encoding*' which itself defaults to `:default'. + + In other words, there now are plenty of extension hooks, but by +default ASDF follows the backwards compatible behavior of using +whichever `:default' encoding your implementation uses, which itself +may or may not vary based on environment variables and other locale +settings. In practice this means that only source code that only uses +ASCII is guaranteed to be read the same on all implementations +independently from any user setting. + + Additionally, for backward-compatibility with older versions of ASDF +and/or with implementations that do not support unicode and its many +encodings, you may want to use the reader conditionals `#+asdf-unicode +#+asdf-unicode' to protect any `:encoding _encoding_' statement as +`:asdf-unicode' will be present in `*features*' only if you're using a +recent ASDF on an implementation that supports unicode. We recommend +that you avoid using unprotected `:encoding' specifications until after +ASDF 2.21 or later becomes widespread, hopefully by the end of 2012. + + While it offers plenty of hooks for extension, and one such +extension is being developed (see below), ASDF itself only recognizes +one encoding beside `:default', and that is `:utf-8', which is the _de +facto_ standard, already used by the vast majority of libraries that +use more than ASCII. On implementations that do not support unicode, +the feature `:asdf-unicode' is absent, and the `:default' +external-format is used to read even source files declared as `:utf-8'. +On these implementations, non-ASCII characters intended to be read as +one CL character may thus end up being read as multiple CL characters. +In most cases, this shouldn't affect the software's semantics: comments +will be skipped just the same, strings with be read and printed with +slightly different lengths, symbol names will be accordingly longer, +but none of it should matter. But a few systems that actually depend +on unicode characters may fail to work properly, or may work in a +subtly different way. See for instance `lambda-reader'. + + We invite you to embrace UTF-8 as the encoding for non-ASCII +characters starting today, even without any explicit specification in +your `.asd' files. Indeed, on some implementations and configurations, +UTF-8 is already the `:default', and loading your code may cause errors +if it is encoded in anything but UTF-8. Therefore, even with the +legacy behavior, non-UTF-8 is guaranteed to break for some users, +whereas UTF-8 is pretty much guaranteed not to break anywhere (provided +you do _not_ use a BOM), although it might be read incorrectly on some +implementations. In the future, we intend to make `:utf-8' the default +value of `*default-encoding*', to be enforced everywhere, so at least +the code is guaranteed to be read correctly everywhere it can be. + + If you need non-standard character encodings for your source code, +use the extension system `asdf-encodings', by specifying +`:defsystem-depends-on (:asdf-encodings)' in your `defsystem'. This +extension system will register support for more encodings using the +`*encoding-external-format-hook*' facility, so you can explicitly +specify `:encoding :latin1' in your `.asd' file. Using the +`*encoding-detection-hook*' it will also eventually implement some +autodetection of a file's encoding from an emacs-style `-*- mode: lisp +; coding: latin1 -*-' declaration, or otherwise based on an analysis of +octet patterns in the file. At this point, asdf-encoding only supports +the encodings that are supported as part of your implementation. Since +the list varies depending on implementations, we once again recommend +you use `:utf-8' everywhere, which is the most portable (next is +`:latin1'). + + If you're not using a version of Quicklisp that has it, you may get +the source for `asdf-encodings' using git: `git clone +git://common-lisp.net/projects/asdf/asdf-encodings.git' or `git clone +ssh://common-lisp.net/project/asdf/git/asdf-encodings.git'. You can +also browse the repository on +`http://common-lisp.net/gitweb?p=projects/asdf/asdf-encodings.git'. + + In the future, we intend to change the default `*default-encoding*' +to `:utf-8', which is already the de facto standard for most libraries +that use non-ASCII characters: utf-8 works everywhere and was +backhandedly enforced by a lot of people using SBCL and utf-8 and +sending reports to authors so they make their packages compatible. A +survey showed only about a handful few libraries are incompatible with +non-UTF-8, and then, only in comments, and we believe that authors will +adopt UTF-8 when prompted. See the April 2012 discussion on the +asdf-devel mailing-list. For backwards compatibility with users who +insist on a non-UTF-8 encoding, but cannot immediately transition to +using `asdf-encodings' (maybe because it isn't ready), it will still be +possible to use the `:encoding :default' option in your `defsystem' form +to restore the behavior of ASDF 2.20 and earlier. This shouldn't be +required in libraries, because user pressure as mentioned above will +already have pushed library authors towards using UTF-8; but authors of +end-user programs might care. + + When you use `asdf-encodings', any further loaded `.asd' file will +use the autodetection algorithm to determine its encoding; yet if you +depend on this detection happening, you may want to explicitly load +`asdf-encodings' early in your build, for by the time you can use +`:defsystem-depends-on', it is already too late to load it. In +practice, this means that the `*default-encoding*' is usually used for +`.asd' files. Currently, this defaults to `:default' for backwards +compatibility, and that means that you shouldn't rely on non-ASCII +characters in a .asd file. Since component (path)names are the only +real data in these files, and non-ASCII characters are not very +portable for file names, this isn't too much of an issue. We still +encourage you to use either plain ASCII or UTF-8 in `.asd' files, as we +intend to make `:utf-8' the default encoding in the future. This might +matter, for instance, in meta-data about author's names. + +10.3 Miscellaneous Functions +============================ + +These functions are exported by ASDF for your convenience. + + -- Function: system-relative-pathname system name &key type + It's often handy to locate a file relative to some system. The + `system-relative-pathname' function meets this need. + + It takes two mandatory arguments SYSTEM and NAME and a keyword + argument TYPE: SYSTEM is name of a system, whereas NAME and + optionally TYPE specify a relative pathname, interpreted like a + component pathname specifier by `coerce-pathname'. *Note Pathname + specifiers: The defsystem grammar. + + It returns a pathname built from the location of the system's + source directory and the relative pathname. For example: + + > (asdf:system-relative-pathname 'cl-ppcre "regex.data") + #P"/repository/other/cl-ppcre/regex.data" + + + -- Function: system-source-directory system-designator + ASDF does not provide a turnkey solution for locating data (or + other miscellaneous) files that are distributed together with the + source code of a system. Programmers can use + `system-source-directory' to find such files. Returns a pathname + object. The SYSTEM-DESIGNATOR may be a string, symbol, or ASDF + system object. + + -- Function: clear-system system-designator + It is sometimes useful to force recompilation of a previously + loaded system. In these cases, it may be useful to + `(asdf:clear-system :foo)' to remove the system from the table of + currently loaded systems; the next time the system `foo' or one + that depends on it is re-loaded, `foo' will then be loaded again. + Alternatively, you could touch `foo.asd' or remove the + corresponding fasls from the output file cache. (It was once + conceived that one should provide a list of systems the + recompilation of which to force as the `:force' keyword argument + to `load-system'; but this has never worked, and though the + feature was fixed in ASDF 2.000, it remains `cerror''ed out as + nobody ever used it.) + + Note that this does not and cannot by itself undo the previous + loading of the system. Common Lisp has no provision for such an + operation, and its reliance on irreversible side-effects to global + datastructures makes such a thing impossible in the general case. + If the software being re-loaded is not conceived with hot upgrade + in mind, this re-loading may cause many errors, warnings or subtle + silent problems, as packages, generic function signatures, + structures, types, macros, constants, etc. are being redefined + incompatibly. It is up to the user to make sure that reloading is + possible and has the desired effect. In some cases, extreme + measures such as recursively deleting packages, unregistering + symbols, defining methods on `update-instance-for-redefined-class' + and much more are necessary for reloading to happen smoothly. + ASDF itself goes through notable pains to make such a hot upgrade + possible with respect to its own code, and what it does is + ridiculously complex; look at the beginning of `asdf.lisp' to see + what it does. + + -- Function: register-preloaded-system name &rest keys + A system with name NAME, created by `make-instance' with extra + keys KEYS (e.g. `:version'), is registered as _preloaded_. That + is, its code has already been loaded into the current image, and + if at some point some other system `:depends-on' it yet no source + code is found, it is considered as already provided, and ASDF will + not raise a `missing-component' error. + + This function is particularly useful if you distribute your code + as fasls with either `fasl-op' or `monolithic-fasl-op', and want + to register systems so that dependencies will work uniformly + whether you're using your software from source or from fasl. + + -- Function: run-shell-command control-string &rest args + This function is obsolete and present only for the sake of + backwards-compatibility: "If it's not backwards, it's not + compatible". We _strongly_ discourage its use. Its current + behavior is only well-defined on Unix platforms (which include + MacOS X and cygwin). On Windows, anything goes. The following + documentation is only for the purpose of your migrating away from + it in a way that preserves semantics. + + Instead we recommend the use `run-program', described in the next + section, and available as part of ASDF since ASDF 3. + + `run-shell-command' takes as arguments a format `control-string' + and arguments to be passed to `format' after this control-string + to produce a string. This string is a command that will be + evaluated with a POSIX shell if possible; yet, on Windows, some + implementations will use CMD.EXE, while others (like SBCL) will + make an attempt at invoking a POSIX shell (and fail if it is not + present). + +10.4 Some Utility Functions +=========================== + +The below functions are not exported by ASDF itself, but by UIOP, +available since ASDF 3. Some of them have precursors in ASDF 2, but we +recommend you rely on ASDF 3 for active developments. UIOP provides +many, many more utility functions, and we recommend you read its README +and sources for more information. + + -- Function: parse-unix-namestring name &key type defaults dot-dot + ensure-directory &allow-other-keys + Coerce NAME into a PATHNAME using standard Unix syntax. + + Unix syntax is used whether or not the underlying system is Unix; + on such non-Unix systems it is only usable but for relative + pathnames; but especially to manipulate relative pathnames + portably, it is of crucial to possess a portable pathname syntax + independent of the underlying OS. This is what + `parse-unix-namestring' provides, and why we use it in ASDF. + + When given a `pathname' object, just return it untouched. When + given `nil', just return `nil'. When given a non-null `symbol', + first downcase its name and treat it as a string. When given a + `string', portably decompose it into a pathname as below. + + `#\/' separates directory components. + + The last `#\/'-separated substring is interpreted as follows: 1- + If TYPE is `:directory' or ENSURE-DIRECTORY is true, the string + is made the last directory component, and its `name' and `type' + are `nil'. if the string is empty, it's the empty pathname with + all slots `nil'. 2- If TYPE is `nil', the substring is a + file-namestring, and its `name' and `type' are separated by + `split-name-type'. 3- If TYPE is a string, it is the given + `type', and the whole string is the `name'. + + Directory components with an empty name the name `.' are removed. + Any directory named `..' is read as DOT-DOT, which must be one of + `:back' or `:up' and defaults to `:back'. + + `host', `device' and `version' components are taken from DEFAULTS, + which itself defaults to `*nil-pathname*', also used if DEFAULTS + is `nil'. No host or device can be specified in the string itself, + which makes it unsuitable for absolute pathnames outside Unix. + + For relative pathnames, these components (and hence the defaults) + won't matter if you use `merge-pathnames*' but will matter if you + use `merge-pathnames', which is an important reason to always use + `merge-pathnames*'. + + Arbitrary keys are accepted, and the parse result is passed to + `ensure-pathname' with those keys, removing TYPE, DEFAULTS and + DOT-DOT. When you're manipulating pathnames that are supposed to + make sense portably even though the OS may not be Unixish, we + recommend you use `:want-relative t' to throw an error if the + pathname is absolute + + -- Function: merge-pathnames* specified &optional defaults + This function is a replacement for `merge-pathnames' that uses the + host and device from the DEFAULTS rather than the SPECIFIED + pathname when the latter is a relative pathname. This allows ASDF + and its users to create and use relative pathnames without having + to know beforehand what are the host and device of the absolute + pathnames they are relative to. + + + -- Function: subpathname pathname subpath &key type + This function takes a PATHNAME and a SUBPATH and a TYPE. If + SUBPATH is already a `pathname' object (not namestring), and is an + absolute pathname at that, it is returned unchanged; otherwise, + SUBPATH is turned into a relative pathname with given TYPE as per + `parse-unix-namestring' with `:want-relative t :type 'TYPE, then + it is merged with the `pathname-directory-pathname' of PATHNAME, + as per `merge-pathnames*'. + + We strongly encourage the use of this function for portably + resolving relative pathnames in your code base. + + -- Function: subpathname* pathname subpath &key type + This function returns `nil' if the base PATHNAME is `nil', + otherwise acts like `subpathname'. + + -- Function: run-program command &key ignore-error-status force-shell + input output error-output + if-input-does-not-exist if-output-exists if-error-output-exists + element-type external-format &allow-other-keys + + `run-program' takes a COMMAND argument that is either a list of a + program name or path and its arguments, or a string to be executed + by a shell. It spawns the command, waits for it to return, + verifies that it exited cleanly (unless told not too below), and + optionally captures and processes its output. It accepts many + keyword arguments to configure its behavior. + + `run-program' returns three values: the first for the output, the + second for the error-output, and the third for the return value. + (Beware that before ASDF 3.0.2.11, it didn't handle input or + error-output, and returned only one value, the one for the output + if any handler was specified, or else the exit code; please + upgrade ASDF, or at least UIOP, to rely on the new enhanced + behavior.) + + OUTPUT is its most important argument; it specifies how the output + is captured and processed. If it is `nil', then the output is + redirected to the null device, that will discard it. If it is + `:interactive', then it is inherited from the current process + (beware: this may be different from your *STANDARD-OUTPUT*, and + under SLIME will be on your `*inferior-lisp*' buffer). If it is + `t', output goes to your current *STANDARD-OUTPUT* stream. + Otherwise, OUTPUT should be a value that is a suitable first + argument to `slurp-input-stream' (see below), or a list of such a + value and keyword arguments. In this case, `run-program' will + create a temporary stream for the program output; the program + output, in that stream, will be processed by a call to + `slurp-input-stream', using OUTPUT as the first argument (or if + it's a list the first element of OUTPUT and the rest as keywords). + The primary value resulting from that call (or `nil' if no call + was needed) will be the first value returned by `run-program'. + E.g., using `:output :string' will have it return the entire + output stream as a string. And using `:output '(:string :stripped + t)' will have it return the same string stripped of any ending + newline. + + ERROR-OUTPUT is similar to OUTPUT, except that the resulting value + is returned as the second value of `run-program'. `t' designates + the *ERROR-OUTPUT*. Also `:output' means redirecting the error + output to the output stream, in which case `nil' is returned. + + INPUT is similar to OUTPUT, except that `vomit-output-stream' is + used, no value is returned, and `t' designates the + *STANDARD-INPUT*. + + `element-type' and `external-format' are passed on to your Lisp + implementation, when applicable, for creation of the output stream. + + One and only one of the stream slurping or vomiting may or may not + happen in parallel in parallel with the subprocess, depending on + options and implementation, and with priority being given to + output processing. Other streams are completely produced or + consumed before or after the subprocess is spawned, using + temporary files. + + `force-shell' forces evaluation of the command through a shell, + even if it was passed as a list rather than a string. If a shell + is used, it is `/bin/sh' on Unix or `CMD.EXE' on Windows, except + on implementations that (erroneously, IMNSHO) insist on consulting + `$SHELL' like clisp. + + `ignore-error-status' causes `run-program' to not raise an error + if the spawned program exits in error. Following POSIX + convention, an error is anything but a normal exit with status + code zero. By default, an error of type `subprocess-error' is + raised in this case. + + `run-program' works on all platforms supported by ASDF, except + Genera. See the source code for more documentation. + + + -- Function: slurp-input-stream processor input-stream &key + It's a generic function of two arguments, a target object and an + input stream, and accepting keyword arguments. Predefined methods + based on the target object are as follow: + + If the object is a function, the function is called with the + stream as argument. + + If the object is a cons, its first element is applied to its rest + appended by a list of the input stream. + + If the object is an output stream, the contents of the input + stream are copied to it. If the LINEWISE keyword argument is + provided, copying happens line by line, and an optional PREFIX is + printed before each line. Otherwise, copying happen based on a + buffer of size BUFFER-SIZE, using the specified ELEMENT-TYPE. + + If the object is `'string' or `:string', the content is captured + into a string. Accepted keywords include the ELEMENT-TYPE and a + flag STRIPPED, which when true causes any single line ending to be + removed as per `uiop:stripln'. + + If the object is `:lines', the content is captured as a list of + strings, one per line, without line ending. If the COUNT keyword + argument is provided, it is a maximum count of lines to be read. + + If the object is `:line', the content is capture as with `:lines' + above, and then its sub-object is extracted with the AT argument, + which defaults to `0', extracting the first line. A number will + extract the corresponding line. See the documentation for + `uiop:access-at'. + + If the object is `:forms', the content is captured as a list of + S-expressions, as read by the Lisp reader. If the COUNT argument + is provided, it is a maximum count of lines to be read. We + recommend you control the syntax with such macro as + `uiop:with-safe-io-syntax'. + + If the object is `:form', the content is capture as with `:forms' + above, and then its sub-object is extracted with the AT argument, + which defaults to `0', extracting the first form. A number will + extract the corresponding form. See the documentation for + `uiop:access-at'. We recommend you control the syntax with such + macro as `uiop:with-safe-io-syntax'. + + + +File: asdf.info, Node: Getting the latest version, Next: FAQ, Prev: Miscellaneous additional functionality, Up: Top + +11 Getting the latest version +***************************** + +Decide which version you want. The `master' branch is where +development happens; its `HEAD' is usually OK, including the latest +fixes and portability tweaks, but an occasional regression may happen +despite our (limited) test suite. + + The `release' branch is what cautious people should be using; it has +usually been tested more, and releases are cut at a point where there +isn't any known unresolved issue. + + You may get the ASDF source repository using git: `git clone +git://common-lisp.net/projects/asdf/asdf.git' + + You will find the above referenced tags in this repository. You can +also browse the repository on +`http://common-lisp.net/gitweb?p=projects/asdf/asdf.git'. + + Discussion of ASDF development is conducted on the mailing list +`asdf-devel(a)common-lisp.net'. +`http://common-lisp.net/cgi-bin/mailman/listinfo/asdf-devel' + + +File: asdf.info, Node: FAQ, Next: TODO list, Prev: Getting the latest version, Up: Top + +12 FAQ +****** + +12.1 "Where do I report a bug?" +=============================== + +ASDF bugs are tracked on launchpad: `https://launchpad.net/asdf'. + + If you're unsure about whether something is a bug, or for general +discussion, use the asdf-devel mailing list +(http://common-lisp.net/cgi-bin/mailman/listinfo/asdf-devel) + +12.2 "What has changed between ASDF 1 and ASDF 2?" +================================================== + +12.2.1 What are ASDF 1 and ASDF 2? +---------------------------------- + +On May 31st 2010, we have released ASDF 2. ASDF 2 refers to release +2.000 and later. (Releases between 1.656 and 1.728 were development +releases for ASDF 2.) ASDF 1 to any release earlier than 1.369 or so. +If your ASDF doesn't sport a version, it's an old ASDF 1. + + ASDF 2 and its release candidates push `:asdf2' onto `*features*' so +that if you are writing ASDF-dependent code you may check for this +feature to see if the new API is present. _All_ versions of ASDF +should have the `:asdf' feature. + + Additionally, all versions of ASDF 2 define a function +`(asdf:asdf-version)' you may use to query the version; and the source +code of recent versions of ASDF 2 features the version number +prominently on the second line of its source code. + + If you are experiencing problems or limitations of any sort with +ASDF 1, we recommend that you should upgrade to ASDF 2, or whatever is +the latest release. + +12.2.2 ASDF can portably name files in subdirectories +----------------------------------------------------- + +Common Lisp namestrings are not portable, except maybe for logical +pathnamestrings, that themselves have various limitations and require a +lot of setup that is itself ultimately non-portable. + + In ASDF 1, the only portable ways to refer to pathnames inside +systems and components were very awkward, using `#.(make-pathname ...)' +and `#.(merge-pathnames ...)'. Even the above were themselves were +inadequate in the general case due to host and device issues, unless +horribly complex patterns were used. Plenty of simple cases that +looked portable actually weren't, leading to much confusion and +greavance. + + ASDF 2 implements its own portable syntax for strings as pathname +specifiers. Naming files within a system definition becomes easy and +portable again. *Note asdf:system-relative-pathname: Miscellaneous +additional functionality, `merge-pathnames*', `coerce-pathname'. + + On the other hand, there are places where systems used to accept +namestrings where you must now use an explicit pathname object: +`(defsystem ... :pathname "LOGICAL-HOST:PATH;TO;SYSTEM;" ...)' must now +be written with the `#p' syntax: `(defsystem ... :pathname +#p"LOGICAL-HOST:PATH;TO;SYSTEM;" ...)' + + *Note Pathname specifiers: The defsystem grammar. + +12.2.3 Output translations +-------------------------- + +A popular feature added to ASDF was output pathname translation: +`asdf-binary-locations', `common-lisp-controller', `cl-launch' and +other hacks were all implementing it in ways both mutually incompatible +and difficult to configure. + + Output pathname translation is essential to share source directories +of portable systems across multiple implementations or variants thereof, +or source directories of shared installations of systems across +multiple users, or combinations of the above. + + In ASDF 2, a standard mechanism is provided for that, +`asdf-output-translations', with sensible defaults, adequate +configuration languages, a coherent set of configuration files and +hooks, and support for non-Unix platforms. + + *Note Controlling where ASDF saves compiled files::. + +12.2.4 Source Registry Configuration +------------------------------------ + +Configuring ASDF used to require special magic to be applied just at +the right moment, between the moment ASDF is loaded and the moment it +is used, in a way that is specific to the user, the implementation he +is using and the application he is building. + + This made for awkward configuration files and startup scripts that +could not be shared between users, managed by administrators or +packaged by distributions. + + ASDF 2 provides a well-documented way to configure ASDF, with +sensible defaults, adequate configuration languages, and a coherent set +of configuration files and hooks. + + We believe it's a vast improvement because it decouples application +distribution from library distribution. The application writer can +avoid thinking where the libraries are, and the library distributor +(dpkg, clbuild, advanced user, etc.) can configure them once and for +every application. Yet settings can be easily overridden where needed, +so whoever needs control has exactly as much as required. + + At the same time, ASDF 2 remains compatible with the old magic you +may have in your build scripts (using `*central-registry*' and +`*system-definition-search-functions*') to tailor the ASDF +configuration to your build automation needs, and also allows for new +magic, simpler and more powerful magic. + + *Note Controlling where ASDF searches for systems::. + +12.2.5 Usual operations are made easier to the user +--------------------------------------------------- + +In ASDF 1, you had to use the awkward syntax `(asdf:oos 'asdf:load-op +:foo)' to load a system, and similarly for `compile-op', `test-op'. + + In ASDF 2, you can use shortcuts for the usual operations: +`(asdf:load-system :foo)', and similarly for `compile-system', +`test-system'. + +12.2.6 Many bugs have been fixed +-------------------------------- + +The following issues and many others have been fixed: + + * The infamous TRAVERSE function has been revamped completely + between ASDF 1 and ASDF 2, with many bugs squashed. In + particular, dependencies were not correctly propagated across + modules but now are. It has been completely rewritten many times + over between ASDF 2.000 and ASDF 3, with fundamental issues in the + original model being fixed. Timestamps were not propagated at + all, and now are. The internal model of how actions depend on + each other is now both consistent and complete. The :version and + the :force (system1 .. systemN) feature have been fixed. + + * Performance has been notably improved for large systems (say with + thousands of components) by using hash-tables instead of linear + search, and linear-time list accumulation instead of + quadratic-time recursive appends. + + * Many features used to not be portable, especially where pathnames + were involved. Windows support was notably quirky because of such + non-portability. + + * The internal test suite used to massively fail on many + implementations. While still incomplete, it now fully passes on + all implementations supported by the test suite, except for GCL + (due to GCL bugs). + + * Support was lacking for some implementations. ABCL and GCL were + notably wholly broken. ECL extensions were not integrated with + ASDF release. + + * The documentation was grossly out of date. + + +12.2.7 ASDF itself is versioned +------------------------------- + +Between new features, old bugs fixed, and new bugs introduced, there +were various releases of ASDF in the wild, and no simple way to check +which release had which feature set. People using or writing systems +had to either make worst-case assumptions as to what features were +available and worked, or take great pains to have the correct version +of ASDF installed. + + With ASDF 2, we provide a new stable set of working features that +everyone can rely on from now on. Use `#+asdf2' to detect presence of +ASDF 2, `(asdf:version-satisfies (asdf:asdf-version) "2.345.67")' to +check the availability of a version no earlier than required. + +12.2.8 ASDF can be upgraded +--------------------------- + +When an old version of ASDF was loaded, it was very hard to upgrade +ASDF in your current image without breaking everything. Instead you +had to exit the Lisp process and somehow arrange to start a new one +from a simpler image. Something that can't be done from within Lisp, +making automation of it difficult, which compounded with difficulty in +configuration, made the task quite hard. Yet as we saw before, the +task would have been required to not have to live with the worst case +or non-portable subset of ASDF features. + + With ASDF 2, it is easy to upgrade from ASDF 2 to later versions +from within Lisp, and not too hard to upgrade from ASDF 1 to ASDF 2 +from within Lisp. We support hot upgrade of ASDF and any breakage is a +bug that we will do our best to fix. There are still limitations on +upgrade, though, most notably the fact that after you upgrade ASDF, you +must also reload or upgrade all ASDF extensions. + +12.2.9 Decoupled release cycle +------------------------------ + +When vendors were releasing their Lisp implementations with ASDF, they +had to basically never change version because neither upgrade nor +downgrade was possible without breaking something for someone, and no +obvious upgrade path was visible and recommendable. + + With ASDF 2, upgrade is possible, easy and can be recommended. This +means that vendors can safely ship a recent version of ASDF, confident +that if a user isn't fully satisfied, he can easily upgrade ASDF and +deal with a supported recent version of it. This means that release +cycles will be causally decoupled, the practical consequence of which +will mean faster convergence towards the latest version for everyone. + +12.2.10 Pitfalls of the transition to ASDF 2 +-------------------------------------------- + +The main pitfalls in upgrading to ASDF 2 seem to be related to the +output translation mechanism. + + * Output translations is enabled by default. This may surprise some + users, most of them in pleasant way (we hope), a few of them in an + unpleasant way. It is trivial to disable output translations. + *Note "How can I wholly disable the compiler output cache?": FAQ. + + * Some systems in the large have been known not to play well with + output translations. They were relatively easy to fix. Once + again, it is also easy to disable output translations, or to + override its configuration. + + * The new ASDF output translations are incompatible with + ASDF-Binary-Locations. They replace A-B-L, and there is + compatibility mode to emulate your previous A-B-L configuration. + See `enable-asdf-binary-locations-compatibility' in *note Backward + Compatibility: Controlling where ASDF saves compiled files. But + thou shalt not load ABL on top of ASDF 2. + + + Other issues include the following: + + * ASDF pathname designators are now specified in places where they + were unspecified, and a few small adjustments have to be made to + some non-portable defsystems. Notably, in the `:pathname' argument + to a `defsystem' and its components, a logical pathname (or + implementation-dependent hierarchical pathname) must now be + specified with `#p' syntax where the namestring might have + previously sufficed; moreover when evaluation is desired `#.' must + be used, where it wasn't necessary in the toplevel `:pathname' + argument (but necessary in other `:pathname' arguments). + + * There is a slight performance bug, notably on SBCL, when initially + searching for `asd' files, the implicit `(directory + "/configured/path/**/*.asd")' for every configured path `(:tree + "/configured/path/")' in your `source-registry' configuration can + cause a slight pause. Try to `(time + (asdf:initialize-source-registry))' to see how bad it is or isn't + on your system. If you insist on not having this pause, you can + avoid the pause by overriding the default source-registry + configuration and not use any deep `:tree' entry but only + `:directory' entries or shallow `:tree' entries. Or you can fix + your implementation to not be quite that slow when recursing + through directories. _Update_: This performance bug fixed the + hard way in 2.010. + + * On Windows, only LispWorks supports proper default configuration + pathnames based on the Windows registry. Other implementations + make do with environment variables, that you may have to define + yourself if you're using an older version of Windows. Windows + support is somewhat less tested than Unix support. Please help + report and fix bugs. _Update_: As of ASDF 2.21, all + implementations should now use the same proper default + configuration pathnames and they should actually work, though they + haven't all been tested. + + * The mechanism by which one customizes a system so that Lisp files + may use a different extension from the default `.lisp' has changed. + Previously, the pathname for a component was lazily computed when + operating on a system, and you would `(defmethod source-file-type + ((component cl-source-file) (system (eql (find-system 'foo)))) + (declare (ignorable component system)) "lis")'. Now, the pathname + for a component is eagerly computed when defining the system, and + instead you will `(defclass cl-source-file.lis (cl-source-file) + ((type :initform "lis")))' and use `:default-component-class + cl-source-file.lis' as argument to `defsystem', as detailed in a + *note How do I create a system definition where all the source + files have a .cl extension?: FAQ. below. + + +12.3 Issues with installing the proper version of ASDF +====================================================== + +12.3.1 "My Common Lisp implementation comes with an outdated version of ASDF. What to do?" +------------------------------------------------------------------------------------------ + +We recommend you upgrade ASDF. *Note Upgrading ASDF: Loading ASDF. + + If this does not work, it is a bug, and you should report it. *Note +report-bugs: FAQ. In the meantime, you can load `asdf.lisp' directly. +*Note Loading an otherwise installed ASDF: Loading ASDF. + +12.3.2 "I'm a Common Lisp implementation vendor. When and how should I upgrade ASDF?" +------------------------------------------------------------------------------------- + +Since ASDF 2, it should always be a good time to upgrade to a recent +version of ASDF. You may consult with the maintainer for which +specific version they recommend, but the latest `release' should be +correct. We trust you to thoroughly test it with your implementation +before you release it. If there are any issues with the current +release, it's a bug that you should report upstream and that we will +fix ASAP. + + As to how to include ASDF, we recommend the following: + + * If ASDF isn't loaded yet, then `(require "asdf")' should load the + version of ASDF that is bundled with your system. If possible so + should `(require "ASDF")'. You may have it load some other + version configured by the user, if you allow such configuration. + + * If your system provides a mechanism to hook into `CL:REQUIRE', + then it would be nice to add ASDF to this hook the same way that + ABCL, CCL, CLISP, CMUCL, ECL, SBCL and SCL do it. Please send us + appropriate code to this end. + + * You may, like SBCL, have ASDF be implicitly used to require systems + that are bundled with your Lisp distribution. If you do have a + few magic systems that come with your implementation in a + precompiled way such that one should only use the binary version + that goes with your distribution, like SBCL does, then you should + add them in the beginning of `wrapping-source-registry'. + + * If you have magic systems as above, like SBCL does, then we + explicitly ask you to _NOT_ distribute `asdf.asd' as part of those + magic systems. You should still include the file `asdf.lisp' in + your source distribution and precompile it in your binary + distribution, but `asdf.asd' if included at all, should be + secluded from the magic systems, in a separate file hierarchy. + Alternatively, you may provide the system after renaming it and + its `.asd' file to e.g. `asdf-ecl' and `asdf-ecl.asd', or + `sb-asdf' and `sb-asdf.asd'. Indeed, if you made `asdf.asd' a + magic system, then users would no longer be able to upgrade ASDF + using ASDF itself to some version of their preference that they + maintain independently from your Lisp distribution. + + * If you do not have any such magic systems, or have other non-magic + systems that you want to bundle with your implementation, then you + may add them to the `wrapping-source-registry', and you are + welcome to include `asdf.asd' amongst them. Non-magic systems + should be at the back of the `wrapping-source-registry' while + magic systems are at the front. + + * Please send us upstream any patches you make to ASDF itself, so we + can merge them back in for the benefit of your users when they + upgrade to the upstream version. + + +12.4 Issues with configuring ASDF +================================= + +12.4.1 "How can I customize where fasl files are stored?" +--------------------------------------------------------- + +*Note Controlling where ASDF saves compiled files::. + + Note that in the past there was an add-on to ASDF called +`ASDF-binary-locations', developed by Gary King. That add-on has been +merged into ASDF proper, then superseded by the +`asdf-output-translations' facility. + + Note that use of `asdf-output-translations' can interfere with one +aspect of your systems -- if your system uses `*load-truename*' to find +files (e.g., if you have some data files stored with your program), +then the relocation that this ASDF customization performs is likely to +interfere. Use `asdf:system-relative-pathname' to locate a file in the +source directory of some system, and use +`asdf:apply-output-translations' to locate a file whose pathname has +been translated by the facility. + +12.4.2 "How can I wholly disable the compiler output cache?" +------------------------------------------------------------ + +To permanently disable the compiler output cache for all future runs of +ASDF, you can: + + mkdir -p ~/.config/common-lisp/asdf-output-translations.conf.d/ + echo ':disable-cache' > ~/.config/common-lisp/asdf-output-translations.conf.d/99-disable-cache.conf + + This assumes that you didn't otherwise configure the ASDF files (if +you did, edit them again), and don't somehow override the configuration +at runtime with a shell variable (see below) or some other runtime +command (e.g. some call to `asdf:initialize-output-translations'). + + To disable the compiler output cache in Lisp processes run by your +current shell, try (assuming `bash' or `zsh') (on Unix and cygwin only): + + export ASDF_OUTPUT_TRANSLATIONS=/: + + To disable the compiler output cache just in the current Lisp +process, use (after loading ASDF but before using it): + + (asdf:disable-output-translations) + +12.5 Issues with using and extending ASDF to define systems +=========================================================== + +12.5.1 "How can I cater for unit-testing in my system?" +------------------------------------------------------- + +ASDF provides a predefined test operation, `test-op'. *Note test-op: +Predefined operations of ASDF. The test operation, however, is largely +left to the system definer to specify. `test-op' has been a topic of +considerable discussion on the asdf-devel mailing list +(http://common-lisp.net/cgi-bin/mailman/listinfo/asdf-devel), and on the +launchpad bug-tracker (https://launchpad.net/asdf). + + Here are some guidelines: + + * For a given system, FOO, you will want to define a corresponding + test system, such as FOO-TEST. The reason that you will want this + separate system is that ASDF does not out of the box supply + components that are conditionally loaded. So if you want to have + source files (with the test definitions) that will not be loaded + except when testing, they should be put elsewhere. + + * The FOO-TEST system can be defined in an asd file of its own or + together with FOO. An aesthetic preference against cluttering up + the filesystem with extra asd files should be balanced against the + question of whether one might want to directly load FOO-TEST. + Typically one would not want to do this except in early stages of + debugging. + + * Record that testing is implemented by FOO-TEST. For example: + (defsystem FOO + :in-order-to ((test-op (test-op FOO-TEST))) + ....) + + (defsystem FOO-TEST + :depends-on (FOO MY-TEST-LIBRARY ...) + ....) + + This procedure will allow you to support users who do not wish to +install your test framework. + + One oddity of ASDF is that `operate' (*note operate: Operations.) +does not return a value. So in current versions of ASDF there is no +reliable programmatic means of determining whether or not a set of tests +has passed, or which tests have failed. The user must simply read the +console output. This limitation has been the subject of much +discussion. + +12.5.2 "How can I cater for documentation generation in my system?" +------------------------------------------------------------------- + +The ASDF developers are currently working to add a `doc-op' to the set +of predefined ASDF operations. *Note Predefined operations of ASDF::. +See also `https://bugs.launchpad.net/asdf/+bug/479470'. + +12.5.3 "How can I maintain non-Lisp (e.g. C) source files?" +----------------------------------------------------------- + +See `cffi''s `cffi-grovel'. + +12.5.4 "I want to put my module's files at the top level. How do I do this?" +----------------------------------------------------------------------------- + +By default, the files contained in an asdf module go in a subdirectory +with the same name as the module. However, this can be overridden by +adding a `:pathname ""' argument to the module description. For +example, here is how it could be done in the spatial-trees ASDF system +definition for ASDF 2: + + (asdf:defsystem :spatial-trees + :components + ((:module base + :pathname "" + :components + ((:file "package") + (:file "basedefs" :depends-on ("package")) + (:file "rectangles" :depends-on ("package")))) + (:module tree-impls + :depends-on (base) + :pathname "" + :components + ((:file "r-trees") + (:file "greene-trees" :depends-on ("r-trees")) + (:file "rstar-trees" :depends-on ("r-trees")) + (:file "rplus-trees" :depends-on ("r-trees")) + (:file "x-trees" :depends-on ("r-trees" "rstar-trees")))) + (:module viz + :depends-on (base) + :pathname "" + :components + ((:static-file "spatial-tree-viz.lisp"))) + (:module tests + :depends-on (base) + :pathname "" + :components + ((:static-file "spatial-tree-test.lisp"))) + (:static-file "LICENCE") + (:static-file "TODO"))) + + All of the files in the `tree-impls' module are at the top level, +instead of in a `tree-impls/' subdirectory. + + Note that the argument to `:pathname' can be either a pathname +object or a string. A pathname object can be constructed with the +`#p"foo/bar/"' syntax, but this is discouraged because the results of +parsing a namestring are not portable. A pathname can only be portably +constructed with such syntax as `#.(make-pathname :directory +'(:relative "foo" "bar"))', and similarly the current directory can +only be portably specified as `#.(make-pathname :directory +'(:relative))'. However, as of ASDF 2, you can portably use a string +to denote a pathname. The string will be parsed as a `/'-separated +path from the current directory, such that the empty string `""' +denotes the current directory, and `"foo/bar"' (no trailing `/' +required in the case of modules) portably denotes the same subdirectory +as above. When files are specified, the last `/'-separated component +is interpreted either as the name component of a pathname (if the +component class specifies a pathname type), or as a name component plus +optional dot-separated type component (if the component class doesn't +specifies a pathname type). + +12.5.5 How do I create a system definition where all the source files have a .cl extension? +------------------------------------------------------------------------------------------- + +Starting with ASDF 2.014.14, you may just pass the builtin class +`cl-source-file.cl' as the `:default-component-class' argument to +`defsystem': + + (defsystem my-cl-system + :default-component-class cl-source-file.cl + ...) + + Another builtin class `cl-source-file.lsp' is offered for files +ending in `.lsp'. + + If you want to use a different extension for which ASDF doesn't +provide builtin support, or want to support versions of ASDF earlier +than 2.014.14 (but later than 2.000), you can define a class as follows: + + ;; Prologue: make sure we're using a sane package. + (defpackage :my-asdf-extension + (:use :asdf :common-lisp) + (:export #:cl-source-file.lis)) + (in-package :my-asdf-extension) + + (defclass cl-source-file.lis (cl-source-file) + ((type :initform "lis"))) + + Then you can use it as follows: + (defsystem my-cl-system + :default-component-class my-asdf-extension:cl-source-file.lis + ...) + + Of course, if you're in the same package, e.g. in the same file, you +won't need to use the package qualifier before `cl-source-file.lis'. +Actually, if all you're doing is defining this class and using it in +the same file without other fancy definitions, you might skip package +complications: + + (in-package :asdf) + (defclass cl-source-file.lis (cl-source-file) + ((type :initform "lis"))) + (defsystem my-cl-system + :default-component-class cl-source-file.lis + ...) + + It is possible to achieve the same effect in a way that supports +both ASDF 1 and ASDF 2, but really, friends don't let friends use ASDF +1. Please upgrade to ASDF 3. In short, though: do same as above, but +_before_ you use the class in a `defsystem', you also define the +following method: + + (defmethod source-file-type ((f cl-source-file.lis) (s system)) + (declare (ignorable f s)) + "lis") + + +File: asdf.info, Node: TODO list, Next: Inspiration, Prev: FAQ, Up: Top + +13 TODO list +************ + +Here is an old list of things to do, in addition to the bugs that are +now tracked on launchpad: `https://launchpad.net/asdf'. + +13.1 Outstanding spec questions, things to add +============================================== + +** packaging systems + + *** manual page component? + + ** style guide for .asd files + + You should either use keywords or be careful with the package that +you evaluate defsystem forms in. Otherwise `(defsystem partition ...)' +being read in the `cl-user' package will intern a `cl-user:partition' +symbol, which will then collide with the `partition:partition' symbol. + + Actually there's a hairier packages problem to think about too. +`in-order-to' is not a keyword: if you read `defsystem' forms in a +package that doesn't use ASDF, odd things might happen. + + ** extending defsystem with new options + + You might not want to write a whole parser, but just to add options +to the existing syntax. Reinstate `parse-option' or something akin. + + ** Diagnostics + + A "dry run" of an operation can be made with the following form: + + (let ((asdf::*verbose-out* *standard-output*)) + (loop :for (op . comp) :in + (asdf::traverse (make-instance '<operation-name> :force t) + (asdf:find-system <system-name>)) + :do (asdf:explain op comp))) + + This uses unexported symbols. What would be a nice interface for +this functionality? + +13.2 Missing bits in implementation +=================================== + +** reuse the same scratch package whenever a system is reloaded from +disk + + Have a package ASDF-USER instead of all these temporary packages? + + ** proclamations probably aren't + + ** A revert function + + Other possible interface: have a "revert" function akin to `make +clean'. + + (asdf:revert 'asdf:compile-op 'araneida) + + would delete any files produced by `(compile-system :araneida)'. Of +course, it wouldn't be able to do much about stuff in the image itself. + + How would this work? + + `traverse' + + There's a difference between a module's dependencies (peers) and its +components (children). Perhaps there's a similar difference in +operations? For example, `(load "use") depends-on (load "macros")' is +a peer, whereas `(load "use") depends-on (compile "use")' is more of a +"subservient" relationship. + + +File: asdf.info, Node: Inspiration, Next: Concept Index, Prev: TODO list, Up: Top + +14 Inspiration +************** + +14.1 mk-defsystem (defsystem-3.x) +================================= + +We aim to solve basically the same problems as `mk-defsystem' does. +However, our architecture for extensibility better exploits CL language +features (and is documented), and we intend to be portable rather than +just widely-ported. No slight on the `mk-defsystem' authors and +maintainers is intended here; that implementation has the unenviable +task of supporting pre-ANSI implementations, which is no longer +necessary. + + The surface defsystem syntax of asdf is more-or-less compatible with +`mk-defsystem', except that we do not support the `source-foo' and +`binary-foo' prefixes for separating source and binary files, and we +advise the removal of all options to specify pathnames. + + The `mk-defsystem' code for topologically sorting a module's +dependency list was very useful. + +14.2 defsystem-4 proposal +========================= + +Marco and Peter's proposal for defsystem 4 served as the driver for +many of the features in here. Notable differences are: + + * We don't specify output files or output file extensions as part of + the system. + + If you want to find out what files an operation would create, ask + the operation. + + * We don't deal with CL packages + + If you want to compile in a particular package, use an + `in-package' form in that file (ilisp / SLIME will like you more + if you do this anyway) + + * There is no proposal here that `defsystem' does version control. + + A system has a given version which can be used to check + dependencies, but that's all. + + The defsystem 4 proposal tends to look more at the external features, +whereas this one centres on a protocol for system introspection. + +14.3 kmp's "The Description of Large Systems", MIT AI Memo 801 +============================================================== + +Available in updated-for-CL form on the web at +`http://nhplace.com/kent/Papers/Large-Systems.html' + + In our implementation we borrow kmp's overall `PROCESS-OPTIONS' and +concept to deal with creating component trees from `defsystem' surface +syntax. [ this is not true right now, though it used to be and +probably will be again soon ] + + +File: asdf.info, Node: Concept Index, Next: Function and Class Index, Prev: Inspiration, Up: Top + +Concept Index +************* + +[index] +* Menu: + +* :around-compile: Miscellaneous additional functionality. + (line 12) +* :asdf: Introduction. (line 6) +* :asdf2: Introduction. (line 6) +* :asdf3: Introduction. (line 6) +* :compile-check: Miscellaneous additional functionality. + (line 12) +* :defsystem-depends-on: The defsystem grammar. + (line 106) +* :version <1>: The defsystem grammar. + (line 214) +* :version <2>: Common attributes of components. + (line 22) +* :version: The defsystem form. (line 76) +* :weakly-depends-on: The defsystem grammar. + (line 114) +* around-compile keyword: Miscellaneous additional functionality. + (line 12) +* ASDF versions: Introduction. (line 6) +* ASDF-BINARY-LOCATIONS compatibility: Controlling where ASDF saves compiled files. + (line 81) +* asdf-output-translations: Controlling where ASDF saves compiled files. + (line 6) +* ASDF-related features: Introduction. (line 6) +* compile-check keyword: Miscellaneous additional functionality. + (line 12) +* component: Components. (line 6) +* component designator: Components. (line 6) +* link farm: Loading ASDF. (line 6) +* logical pathnames: The defsystem grammar. + (line 233) +* operation: Operations. (line 6) +* pathname specifiers: The defsystem grammar. + (line 143) +* serial dependencies: The defsystem grammar. + (line 279) +* system: Components. (line 6) +* system designator: Components. (line 6) +* system directory designator: Loading ASDF. (line 6) +* Testing for ASDF: Introduction. (line 6) +* version specifiers: The defsystem grammar. + (line 214) + + +File: asdf.info, Node: Function and Class Index, Next: Variable Index, Prev: Concept Index, Up: Top + +Function and Class Index +************************ + +[index] +* Menu: + +* already-loaded-systems: Using ASDF. (line 80) +* apply-output-translations: Controlling where ASDF saves compiled files. + (line 356) +* clear-configuration: Using ASDF. (line 11) +* clear-output-translations <1>: Configuring ASDF. (line 114) +* clear-output-translations: Controlling where ASDF saves compiled files. + (line 341) +* clear-source-registry: Controlling where ASDF searches for systems. + (line 372) +* clear-system: Miscellaneous additional functionality. + (line 207) +* compile-file*: Miscellaneous additional functionality. + (line 12) +* compile-op: Predefined operations of ASDF. + (line 12) +* compile-system: Loading ASDF. (line 6) +* concatenate-source-op: Predefined operations of ASDF. + (line 167) +* disable-output-translations: Controlling where ASDF saves compiled files. + (line 336) +* enable-asdf-binary-locations-compatibility: Controlling where ASDF saves compiled files. + (line 107) +* ensure-output-translations: Controlling where ASDF saves compiled files. + (line 351) +* ensure-source-registry: Controlling where ASDF searches for systems. + (line 381) +* fasl-op: Predefined operations of ASDF. + (line 94) +* find-component: Components. (line 56) +* find-system: Components. (line 18) +* initialize-output-translations: Controlling where ASDF saves compiled files. + (line 327) +* initialize-source-registry: Controlling where ASDF searches for systems. + (line 363) +* load-op: Predefined operations of ASDF. + (line 25) +* load-source-op: Predefined operations of ASDF. + (line 42) +* load-system: Loading ASDF. (line 6) +* merge-pathnames*: Miscellaneous additional functionality. + (line 329) +* module: Pre-defined subclasses of component. + (line 23) +* oos <1>: Operations. (line 31) +* oos: Loading ASDF. (line 6) +* operate <1>: Operations. (line 29) +* operate: Loading ASDF. (line 6) +* OPERATION-ERROR: Error handling. (line 6) +* parse-unix-namestring: Miscellaneous additional functionality. + (line 282) +* prepare-op: Predefined operations of ASDF. + (line 36) +* register-preloaded-system: Miscellaneous additional functionality. + (line 239) +* require-system: Loading ASDF. (line 6) +* run-program: Miscellaneous additional functionality. + (line 355) +* run-shell-command: Miscellaneous additional functionality. + (line 252) +* slurp-input-stream: Miscellaneous additional functionality. + (line 430) +* source-file: Pre-defined subclasses of component. + (line 7) +* source-file-type: FAQ. (line 287) +* subpathname: Miscellaneous additional functionality. + (line 338) +* subpathname*: Miscellaneous additional functionality. + (line 350) +* system: Pre-defined subclasses of component. + (line 50) +* SYSTEM-DEFINITION-ERROR: Error handling. (line 6) +* system-relative-pathname: Miscellaneous additional functionality. + (line 182) +* system-source-directory: Miscellaneous additional functionality. + (line 199) +* test-op: Predefined operations of ASDF. + (line 60) +* test-system: Loading ASDF. (line 6) +* VERSION: Functions. (line 7) +* version-satisfies <1>: Functions. (line 6) +* version-satisfies: Common attributes of components. + (line 22) + + +File: asdf.info, Node: Variable Index, Prev: Function and Class Index, Up: Top + +Variable Index +************** + +[index] +* Menu: + +* *central-registry*: Loading ASDF. (line 6) +* *compile-file-errors-behavior*: Error handling. (line 19) +* *compile-file-warnings-behaviour*: Error handling. (line 19) +* *default-source-registry-exclusions*: Controlling where ASDF searches for systems. + (line 319) +* *features*: Introduction. (line 6) +* *system-definition-search-functions*: Components. (line 6) +* ASDF_OUTPUT_TRANSLATIONS: Controlling where ASDF saves compiled files. + (line 6) + + + +Tag Table: +Node: Top1687 +Node: Introduction3739 +Node: Loading ASDF5819 +Node: Configuring ASDF13441 +Ref: Configuring ASDF-Footnote-121589 +Ref: Configuring ASDF-Footnote-221821 +Node: Using ASDF22534 +Node: Defining systems with defsystem26836 +Node: The defsystem form27222 +Ref: The defsystem form-Footnote-130809 +Node: A more involved example30892 +Node: The defsystem grammar32924 +Node: Other code in .asd files48535 +Node: The object model of ASDF49625 +Node: Operations54177 +Ref: operate55087 +Node: Predefined operations of ASDF57060 +Ref: test-op59879 +Node: Creating new operations66512 +Node: Components71498 +Node: Common attributes of components75247 +Node: Pre-defined subclasses of component81739 +Node: Creating new component types84100 +Node: Functions85476 +Node: Controlling where ASDF searches for systems87299 +Node: Controlling where ASDF saves compiled files108946 +Node: Error handling126833 +Node: Miscellaneous additional functionality127665 +Node: Getting the latest version153111 +Node: FAQ154137 +Ref: report-bugs175672 +Node: TODO list180560 +Node: Inspiration182961 +Node: Concept Index185261 +Node: Function and Class Index188478 +Node: Variable Index194871 + +End Tag Table ===================================== src/contrib/asdf/doc/asdf.pdf ===================================== Binary files /dev/null and b/src/contrib/asdf/doc/asdf.pdf differ View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/compare/419cdec64f8aebe4f9571cf8…

1 0

[cmucl/cmucl][rtoy-unix-core] 9 commits: Load up initial_function with the correct value for Darwin/ppc if the
by Raymond Toy 17 Apr '15

17 Apr '15

Raymond Toy pushed to rtoy-unix-core at cmucl / cmucl Commits: 214a3766 by Raymond Toy at 2014-12-02T20:25:57Z Load up initial_function with the correct value for Darwin/ppc if the builtin_image_flag is set. - - - - - 4e3000cd by Raymond Toy at 2014-12-02T20:28:50Z Add bootstrap file to enable :executable feature for ppc. - - - - - ee975d1b by Raymond Toy at 2014-12-02T20:34:57Z Use the same code for sparc and ppc to handle the call_into_c entry. They were identical before anyway, so make it so. - - - - - 3dd74e81 by Raymond Toy at 2014-12-03T20:50:03Z Update from logs. - - - - - f8a84c42 by Raymond Toy at 2015-01-03T11:55:07Z Move the vpath stuff to GNUMakefile from the configs. These paths don't depend on the config so GNUMakefile is the right place. - - - - - b038df8d by Raymond Toy at 2015-01-17T10:12:21Z Simplify code to use FUNCTION_CODE_OFFSET instead of computing the value directly. - - - - - 01777725 by Raymond Toy at 2015-01-17T10:16:39Z Remove old sunos stuff from sparc-assem.S We only support Solaris now so remove the old SunOS stuff. (Besides we haven't built for SunOS in decades.) * globals.h: * Solaris uses ELF, so don't prefix names with _. * sparc-assem.S: * Remove SunOS support. * Don't prefix names with _. - - - - - 419cdec6 by Raymond Toy at 2015-03-07T21:35:05Z Add clx-inspector contrib module. Submitted by Fred Gilham, who updated and enhanced the version from Bill Chiles, Christopher Hoover, and Skef Wholey. - - - - - 2a6b55bb by Raymond Toy at 2015-04-16T19:04:59Z Merge branch 'master' into rtoy-unix-core - - - - - 22 changed files: - + src/bootfiles/20f/boot-2014-11-ppc.lisp - + src/contrib/clx-inspector/clx-inspector.asd - + src/contrib/clx-inspector/clx-inspector.catalog - + src/contrib/clx-inspector/clx-inspector.lisp - + src/contrib/clx-inspector/compile-clx-inspector.lisp - + src/contrib/clx-inspector/inspect11-d.cursor - + src/contrib/clx-inspector/inspect11-d.mask - + src/contrib/clx-inspector/inspect11-s.cursor - + src/contrib/clx-inspector/inspect11-s.mask - + src/contrib/clx-inspector/inspect11.cursor - + src/contrib/clx-inspector/inspect11.mask - + src/contrib/clx-inspector/inspector.help - src/general-info/release-21a.txt - src/lisp/Config.ppc_darwin - src/lisp/Config.sparc_common - src/lisp/Config.x86_common - src/lisp/GNUmakefile - src/lisp/globals.h - src/lisp/lisp.c - src/lisp/os-common.c - src/lisp/ppc-assem.S - src/lisp/sparc-assem.S Changes: ===================================== src/bootfiles/20f/boot-2014-11-ppc.lisp ===================================== --- /dev/null +++ b/src/bootfiles/20f/boot-2014-11-ppc.lisp @@ -0,0 +1,3 @@ +;; Enable executable feature on ppc. +#+ppc +(pushnew :executable *features*) ===================================== src/contrib/clx-inspector/clx-inspector.asd ===================================== --- /dev/null +++ b/src/contrib/clx-inspector/clx-inspector.asd @@ -0,0 +1,18 @@ +;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*- + +(in-package :asdf) + +(require :clx) + +(defsystem :clx-inspector + :name "INSPECT" + :author "Skef Wholey et. al." + :maintainer "Fred Gilham" + :license "Public Domain" + :description "Graphical Inspector" + :long-description "Inspector that uses pop-up windows to display the + objects. Updates the values of the objects in the background." + :components + ((:file "clx-inspector"))) + + ===================================== src/contrib/clx-inspector/clx-inspector.catalog ===================================== --- /dev/null +++ b/src/contrib/clx-inspector/clx-inspector.catalog @@ -0,0 +1,39 @@ +Name: + CLX Inspector. + +Package Name: + INSPECT + +Description: + Adds another inspector style as an alternative to the console + inspector. Inspecting objects pops up windows with the + contents of the object. The values of the object are updated + in the background. Multiple windows can be displayed at the + same time. + + +Author: + Original by Skef Wholey. Ported to CLX by Christopher Hoover + with "minor tweaks" by Bill Chiles. Updated and enhanced by + Fred Gilham. + +Net Address: + fred(a)sunbot.homedns.org + +Copyright Status: + CMUCL public domain code. No Warranty. + +Files: + clx-inspector.lisp + + +How to Get: + Comes with CMUCL contrib library. + +Portability: + Depends on CMUCL-specific features. + +Instructions: + (require :clx-inspector) + (inspect <object>) Once the window pops up, you can type "h" + to pop up a window of instructions. ===================================== src/contrib/clx-inspector/clx-inspector.lisp ===================================== --- /dev/null +++ b/src/contrib/clx-inspector/clx-inspector.lisp @@ -0,0 +1,2214 @@ +;;; -*- Mode: Lisp; Package: INSPECT; Log:code.log -*- +;;; +;;; ********************************************************************** +;;; This code was written as part of the CMU Common Lisp project at +;;; Carnegie Mellon University, and has been placed in the public domain. +;;; If you want to use this code or any part of CMU Common Lisp, please contact +;;; Scott Fahlman or slisp-group(a)cs.cmu.edu. +;;; +#+cmu +(ext:file-comment + "$Header: clx-inspector.lisp,v 1.1 2004/03/12 10:02:30 fmg $") +;;; +;;; ********************************************************************** +;;; +;;; An inspector for CMU Common Lisp. +;;; +;;; Written by Skef Wholey. +;;; Ported to CLX by Christopher Hoover with minor tweaks by Bill Chiles. +;;; +;;; Each Lisp object is displayed in its own X window, and components +;;; of each object are "mouse sensitive" items that may be selected +;;; for further investigation. +;;; +;;; Some cleanup by FMG plus adding dynamic updating of values when +;;; multiprocessing is present. (2000-2002) +;;; +;;; Converted former "home-made object system" to CLOS. FMG Oct 2002. +;;; +;;; Fix inability to deal with circular lists. Paper over problem with +;;; PCL and uninitialized slots. FMG March 2004. +;;; +;;; Cleanup and minor fixes. FMG 2015. Haha.. ten years.. still works.... +;;; Add scroll wheel support. FMG 2015. + +(declaim (optimize (speed 2) (safety 3) (debug 3) (space 1.5) (ext:inhibit-warnings 3))) + +(eval-when (:compile-toplevel :load-toplevel :execute) + (provide :clx-inspector)) + +(eval-when (:compile-toplevel :load-toplevel :execute) + (setf lisp::*enable-package-locked-errors* nil)) + +(in-package "COMMON-LISP-USER") + +(eval-when (:compile-toplevel :load-toplevel :execute) + (require :clx #+cmu "library:subsystems/clx-library")) + +(defpackage "INSPECT" + (:use "COMMON-LISP" "LISP" "EXTENSIONS" "KERNEL") + (:export inspect show-object remove-object-display remove-all-displays *interface-style*)) + +(in-package "INSPECT") + + +;;;; Parameters and stuff. + +(defvar *inspect-result*) + +(defparameter *update-interval* .5 + "Seconds between item window background updates.") + +;;; CLX specials + +(defvar *display* nil) +(defvar *screen* nil) +(defvar *root* nil) +(defvar *gcontext* nil) +(defvar *black-pixel* nil) +(defvar *white-pixel* nil) + +;; Inspect-Length is the number of components that will be displayed in a +;; window at any one time. If an object has more than Inspect-Length +;; components, we generally put it in a scrolling window. Inspect-Level +;; might someday correspond to Print-Level, controlling the amount of +;; detail and mouse-sensitivity we get inside components, but for now +;; it's ignored. +(defparameter inspect-length 30) +(defparameter inspect-level 1) + +;; Inspect-Print-Level and Inspect-Print-Length are used by +;; IPrin1-To-String to generate the textual representation of +;; components. +(defparameter inspect-print-length 10) +(defparameter inspect-print-level 3) + + +;; The handler-case is an easy way to handle unbound slots. From what +;; previous versions said, using slot-boundp didn't always work. +(defun iprin1-to-string (object) + (let ((*print-length* inspect-print-length) + (*print-level* inspect-print-level) + (*print-pretty* nil)) + + (handler-case (prin1-to-string object) + (unbound-slot () "Unbound")))) + + +;;;; Setting up fonts and cursors and stuff. + +;; We use Font structures to keep stuff like the character height and +;; width of a font around for quick and easy size calculations. For +;; variable width fonts, the Width slot will be Nil. + +(defstruct (font (:constructor make-font (name font height ascent width))) + name + font + height + ascent + width) + +;; The *Header-Font* is a big font usually used for displaying stuff +;; in the header portion of an object view. *Entry-Font* is used as +;; the main "body font" for an object, and *Italic-Font* is used for +;; special stuff. + +;; You can go crazy with fonts here. +;;(defparameter header-font-name "*-*-bold-r-*-sans-14-*-*") +(defparameter header-font-name "-adobe-helvetica-bold-r-*-*-14-*-*") +(defvar *header-font*) + +;; XXX You must use a fixed-width font here. Variable-width fonts +;; cause the tracking to fail miserably. +(defparameter entry-font-name "*-courier-medium-r-normal--12-*-*") +(defvar *entry-font*) + +;; XXX Better to use a fixed-width font here --- a variable-width font +;; tends to result in bits and pieces of letters getting chopped off. +(defparameter italic-font-name "*-courier-medium-o-normal--12-*-*") +(defvar *italic-font*) + +;; The *Cursor* is a normal arrow thing used most of the time. During +;; modification operations, we change the cursor to *Cursor-D* (while +;; the destination for the modification is being chosen) and +;; *Cursor-S* (while the source is being chosen). + +(defparameter cursor-name "library:contrib/clx-inspector/inspect11.cursor") +(defvar *cursor*) +(defparameter cursor-d-name "library:contrib/clx-inspector/inspect11-d.cursor") +(defvar *cursor-d*) +(defparameter cursor-s-name "library:contrib/clx-inspector/inspect11-s.cursor") +(defvar *cursor-s*) + +;; This file contains the help message for the inspector. The text in +;; the file must not extend past the 72nd column, and any initial +;; whitespace on a line must be built on the space character only. The +;; window that displays this text is too small in height for easy +;; reading of this text. +(defparameter help-file-pathname "library:contrib/clx-inspector/inspector.help") + + +;;;; CLX stuff + +;; Max-Window-Width is used to constrain the width of our views. + +(declaim (fixnum max-window-width)) +(defparameter max-window-width 1000) + +;; Border is the number of pixels between an object view and the box +;; we draw around it. VSP is the number of pixels we leave between +;; lines of text. (We should put VSP in the fonts structure sometime +;; so we can have font-specific vertical spacing.) + +(defparameter border 3) +(defparameter vsp 2) + +;; The arrow bitmaps are used inside scrollbars. + +(defvar *up-arrow*) +(defvar *down-arrow*) +(defvar *up-arrow-i*) +(defvar *down-arrow-i*) + +(defparameter arrow-bits + '(#*0000000000000000 + #*0111111111111110 + #*0100000000000010 + #*0100000110000010 + #*0100001111000010 + #*0100011111100010 + #*0100111111110010 + #*0101111111111010 + #*0100001111000010 + #*0100001111000010 + #*0100001111000010 + #*0100001111000010 + #*0100001111000010 + #*0100000000000010 + #*0111111111111110 + #*0000000000000000)) + + +;; Font and cursor support + +(defun open-font (name) + (let* ((font (xlib:open-font *display* name)) + (max-width (xlib:max-char-width font)) + (min-width (xlib:min-char-width font)) + (width (if (= max-width min-width) max-width nil)) + (ascent (xlib:max-char-ascent font)) + (height (+ (xlib:max-char-descent font) ascent))) + (make-font name font height ascent width))) + +(defun get-cursor-pixmap-from-file (name) + (let ((pathname (probe-file name))) + (if pathname + (let* ((image (xlib:read-bitmap-file pathname)) + (pixmap (xlib:create-pixmap :width 16 :height 16 + :depth 1 :drawable *root*)) + (gc (xlib:create-gcontext :drawable pixmap + :function boole-1 + :foreground *black-pixel* + :background *white-pixel*))) + (xlib:put-image pixmap gc image :x 0 :y 0 :width 16 :height 16) + (xlib:free-gcontext gc) + (values pixmap (xlib:image-x-hot image) (xlib:image-y-hot image))) + (values nil nil nil)))) + +(defun open-cursor (name) + (multiple-value-bind + (cursor-pixmap cursor-x-hot cursor-y-hot) + (get-cursor-pixmap-from-file name) + (multiple-value-bind + (mask-pixmap mask-x-hot mask-y-hot) + (get-cursor-pixmap-from-file (make-pathname :type "mask" :defaults name)) + (declare (ignore mask-x-hot mask-y-hot)) + (let* ((white (xlib:make-color :red 1.0 :green 1.0 :blue 1.0)) + (black (xlib:make-color :red 0.0 :green 0.0 :blue 0.0)) + (cursor (xlib:create-cursor :source cursor-pixmap :mask mask-pixmap + :x cursor-x-hot :y cursor-y-hot + :foreground black :background white))) + (xlib:free-pixmap mask-pixmap) + (xlib:free-pixmap cursor-pixmap) + cursor)))) + +(defun bitvec-list-to-pixmap (bvl width height) + (let* ((image (apply #'xlib:bitmap-image bvl)) + (pixmap (xlib:create-pixmap :width width :height height + :drawable *root* + :depth (xlib:screen-root-depth *screen*))) + (gc (xlib:create-gcontext :drawable pixmap + :function boole-1 + :foreground *black-pixel* + :background *white-pixel*))) + (xlib:put-image pixmap gc image :x 0 :y 0 :width 16 :height 16 :bitmap-p t) + (xlib:free-gcontext gc) + pixmap)) + +(defun invert-pixmap (pixmap) + (let* ((width (xlib:drawable-width pixmap)) + (height (xlib:drawable-height pixmap)) + (inv-pixmap (xlib:create-pixmap :width width :height height + :drawable *root* + :depth (xlib:screen-root-depth *screen*))) + (gc (xlib:create-gcontext :drawable inv-pixmap + :function boole-c1 + :foreground *black-pixel* + :background *white-pixel*))) + (xlib:copy-area pixmap gc 0 0 width height inv-pixmap 0 0) + (xlib:free-gcontext gc) + inv-pixmap)) + +;;; Draw-Bitmap, Draw-Box, and Draw-Block --- thin wrapper over X +;;; drawing primitives. + +(defun draw-bitmap (window x y pixmap) + (xlib:copy-area pixmap *gcontext* 0 0 16 16 window x y)) + +(defun draw-box (window x1 y1 x2 y2) + (declare (fixnum x1 y1 x2 y2)) + (xlib:draw-rectangle window *gcontext* x1 y1 (- x2 x1) (- y2 y1))) + +(defun draw-block (window x1 y1 x2 y2) + (declare (fixnum x1 y1 x2 y2)) + (xlib:draw-rectangle window *gcontext* x1 y1 (- x2 x1) (- y2 y1) t)) + +;;; *X-Constraint* is used by Disp-String to truncate long strings so that +;;; they stay inside windows of reasonable width. + +(defvar *x-constraint* nil) + +;;; Disp-String draws a string in an X window, trying to constrain it +;;; to not run beyond the *X-Constraint*. For variable width fonts, +;;; we can only guess about the right length... + +(defun disp-string (window x y string disp-font) + (declare (simple-string string)) + (let ((font (font-font disp-font)) + (font-width (font-width disp-font)) + (font-height (font-height disp-font)) + (length (length string)) + (max-width (if *x-constraint* (- *x-constraint* x) max-window-width))) + (cond (font-width + ;; fixed width font + (let ((end (if (<= (* length font-width) max-width) + length + (max 0 (truncate max-width font-width))))) + (when window + (xlib:with-gcontext (*gcontext* :font font) + (xlib:draw-image-glyphs window *gcontext* + x (+ y (font-ascent disp-font)) + string :end end))) + (values (* end font-width) (+ font-height vsp)))) + (t + ;; this is hackish... + (multiple-value-bind (end width) + (do* ((index length (1- index)) + (width (xlib:text-width font string :end index) + (xlib:text-width font string :end index))) + ((or (= index 0) (<= width max-width)) + (values index width))) + (when window + (xlib:with-gcontext (*gcontext* :font font) + (xlib:draw-image-glyphs window *gcontext* + x (+ y (font-ascent disp-font)) + string :end end))) + (values width (+ font-height vsp))))))) + + + +;;;; Inspect-Init + +;;; Inspect-Init sets all this stuff up, using *Inspect-Initialized* to +;;; know when it's already been done. + +(defvar *inspect-initialized* nil) + +(defun inspect-init () + (unless *inspect-initialized* + + (multiple-value-setq (*display* *screen*) (ext:open-clx-display)) + (ext:carefully-add-font-paths + *display* + (mapcar #'(lambda (x) + (concatenate 'string (namestring x) "fonts/")) + (ext:search-list "library:"))) + (setq *root* (xlib:screen-root *screen*)) + (setq *black-pixel* (xlib:screen-black-pixel *screen*)) + (setq *white-pixel* (xlib:screen-white-pixel *screen*)) + (setq *gcontext* (xlib:create-gcontext :drawable *root* :function boole-1 + :foreground *black-pixel* + :background *white-pixel*)) + (setq *cursor* (open-cursor cursor-name)) + (setq *cursor-d* (open-cursor cursor-d-name)) + (setq *cursor-s* (open-cursor cursor-s-name)) + (setq *header-font* (open-font header-font-name)) + (setq *entry-font* (open-font entry-font-name)) + (setq *italic-font* (open-font italic-font-name)) + (setq *up-arrow* (bitvec-list-to-pixmap arrow-bits 16 16)) + (setq *up-arrow-i* (invert-pixmap *up-arrow*)) + (setq *down-arrow* (bitvec-list-to-pixmap (reverse arrow-bits) 16 16)) + (setq *down-arrow-i* (invert-pixmap *down-arrow*)) + (ext:enable-clx-event-handling *display* 'inspector-event-handler) + (setq *inspect-initialized* t))) + +#| +;;; For debugging... +;;; +(defun inspect-reinit (&optional (host "unix:0.0")) + (let ((win nil)) + (setq *inspect-initialized* nil) + (when *display* + (ext:disable-clx-event-handling *display*) + (xlib:close-display *display*))) + (unwind-protect + (progn + (multiple-value-setq + (*display* *screen*) + (ext:open-clx-display host)) + (setf (xlib:display-after-function *display*) + #'xlib:display-finish-output) + (setq *root* (xlib:screen-root *screen*)) + (setq *black-pixel* (xlib:screen-black-pixel *screen*)) + (setq *white-pixel* (xlib:screen-white-pixel *screen*)) + (setq *gcontext* (xlib:create-gcontext :drawable *root* + :function boole-1 + :foreground *black-pixel* + :background *white-pixel*)) + (setq *cursor* (open-cursor cursor-name)) + (setq *cursor-d* (open-cursor cursor-d-name)) + (setq *cursor-s* (open-cursor cursor-s-name)) + (setq *header-font* (open-font header-font-name)) + (setq *entry-font* (open-font entry-font-name)) + (setq *italic-font* (open-font italic-font-name)) + (setq *up-arrow* (bitvec-list-to-pixmap arrow-bits 16 16)) + (setq *up-arrow-i* (invert-pixmap *up-arrow*)) + (setq *down-arrow* (bitvec-list-to-pixmap (reverse arrow-bits) 16 16)) + (setq *down-arrow-i* (invert-pixmap *down-arrow*)) + (setf (xlib:display-after-function *display*) nil) + (setf win t)) + (cond (win + (ext:enable-clx-event-handling *display* 'inspector-event-handler) + (setq *inspect-initialized* t)) + (*display* + (xlib:close-display *display*)))))) +|# + + +;;;; Mid-level interface between inspector and window system. + +(defclass view () + ((name :initarg :name :accessor name) + (object :initarg :object :accessor object) + (view-item :initarg :view-item :accessor view-item) + (window :initarg :window :accessor window) + #+:mp (update-process :initarg :update-process :accessor update-process :initform nil) + (stack :initarg :stack :accessor stack :initform nil)) + (:documentation "We use view classes to associate objects with their +graphical images (View-Items, see below), the X windows that they're +displayed in, and maybe even a user-supplied Name for the whole +thing.")) + +#+:mp +(defun make-view (name object view-item window) + (let* ((new-view (make-instance 'view + :name name + :object object + :view-item view-item + :window window))) + ;; Create a background process to update the view once per second. + (setf (update-process new-view) + (mp:make-process + #'(lambda () + (loop + (update-view-of-object new-view) + (sleep *update-interval*))) + :name (format nil "Background update process for ~A" name))) + new-view)) + +#-:mp +(defun make-view (name object view-item window) + (make-instance 'view + :name name + :object object + :view-item view-item + :window window)) + + +;;; *views* is a list of all the live views of objects. +;;; +(defvar *views* nil) + +;;; CLX window to view object mapping. +;;; +(defvar *windows-to-views* (make-hash-table :test #'eq)) + +(defun add-window-view-mapping (window view) + (setf (gethash window *windows-to-views*) view)) + +(defun delete-window-view-mapping (window) + (remhash window *windows-to-views*)) + +(defun map-window-to-view (window) + (multiple-value-bind (view found-p) + (gethash window *windows-to-views*) + (unless found-p (error "No such window as ~S in mapping!" window)) + view)) + +;; *Tracking-Mode* is a kind of hack used so things know what to do +;; during modify operations. If it's :Source, only objects that are +;; really there will be selectable. If it's :Destination, objects that +;; aren't necessarily really there (like the values of unbound +;; symbols) will be selectable. +(declaim (type (member '(:source :destination) *tracking-mode*))) +(defvar *tracking-mode* :source) + +;; *Mouse-X* and *Mouse-Y* are a good approximation of where the mouse +;; is in the window that the mouse is in. + +(declaim (fixnum *mouse-x* *mouse-y*)) +(defvar *mouse-x* 0) +(defvar *mouse-y* 0) + + +;;;; Event Handling for CLX. Translates events in X windows to +;;;; commands operating on views. + +;; We're interested in these events: + +(eval-when (:compile-toplevel :load-toplevel :execute) + (defconstant important-xevents + '(:key-press :button-press :exposure :pointer-motion + :enter-window :leave-window #+notready :structure-notify)) + + (defconstant important-xevents-mask + (apply #'xlib:make-event-mask important-xevents))) + + +;; We need to add some mouse key translations to handle the scroll +;; wheel. XXX These should be in CMUCL, not here. + +(ext:define-mouse-keysym 4 25607 "Scrollupdown" "Super" :button-press) +(ext:define-mouse-keysym 4 25608 "Scrollupup" "Super" :button-release) + +(ext:define-mouse-keysym 5 25609 "Scrolldowndown" "Super" :button-press) +(ext:define-mouse-keysym 5 25610 "Scrolldownup" "Super" :button-release) + + +(defun inspector-event-handler (display) + (xlib:event-case (display :discard-p t :force-output-p t :timeout .1) + ((:exposure) (event-window count) + (when (zerop (the fixnum count)) + (redisplay-item + (view-item (map-window-to-view event-window)))) + t) + ((:key-press) (event-window state code) + (do-command (map-window-to-view event-window) + (ext:translate-key-event display code state)) + t) + ((:button-press :button-release) (event-key event-window state code) + (do-command (map-window-to-view event-window) + (ext:translate-mouse-key-event code state event-key)) + t) + ((:enter-notify :motion-notify) (event-window x y) + (cond ((xlib:event-listen display) + ;; if there are other things in the queue, blow this event off... + nil) + (t + ;; This is the alternative to the background update + ;; process. When the mouse enters the window, its values + ;; get updated. + #-:mp (update-view-of-object (map-window-to-view event-window)) + (setf *mouse-x* x) + (setf *mouse-y* y) + (tracker (view-item (map-window-to-view event-window)) x y) + t))) + ((:leave-notify) (event-window) + (tracker (view-item (map-window-to-view event-window)) -1 -1) + t) + + ((:no-exposure) () + ;; just ignore this one + t) + ((:client-message) (event-window display data) + ;; User used the window manager to close a window. + (when (eq (xlib:atom-name display (aref data 0)) :wm_delete_window) + ;; Make the program think the user hit the "D" key in the event + ;; window. + (do-command (map-window-to-view event-window) #k"D")) + t) + (t (event-key) + (format t "Inspector received unexpected event, ~S, recieved." event-key) + t))) + +#| + +;;; Some debugging code... + + (xlib:event-cond (display :timeout 0 :peek-p t) + (t (event-key) + (unless (eq event-key :motion-notify) + (format t "Event received: ~S~%" event-key)))) + +(defun discard-event-on-window (display window type) + (loop + (unless (xlib:process-event display :timeout 0 + :handler #'(lambda (&key event-window event-type &allow-other-keys) + (and (eq event-window window) + (eq event-type type)))) + (return)))) + +|# + + +;;;; More stuff that interfaces between X and the view stuff. + +;; NEXT-WINDOW-POSITION currently uses a very dumb heuristic to decide +;; where the next inspector window ought to go. If there aren't any +;; windows, it puts the view of an object in the upper left hand +;; corner. Otherwise, it'll put it underneath the last one created. +;; When putting the new window below the last one, if it should extend +;; below the bottom of the screen, we position it to just fit on the +;; bottom. Thus, all future windows created in this fashion will "pile +;; up" on the bottom of the screen. +;; +(defun next-window-position (width height) + (declare (ignore width)) + (if *views* + (let ((window (window (car *views*)))) + (xlib:with-state (window) + (let ((drawable-x (xlib:drawable-x window)) + (drawable-y (xlib:drawable-y window)) + (drawable-height (xlib:drawable-height window)) + (border-width (xlib:drawable-border-width window))) + (declare (fixnum drawable-y drawable-height border-width)) + (multiple-value-bind (children parent root) (xlib:query-tree window) + (declare (ignore children)) + (let ((root-height (xlib:drawable-height root))) + (declare (fixnum root-height)) + (multiple-value-bind + (new-x new-y) + (if (eq parent root) + (values drawable-x (+ drawable-y drawable-height + (* 2 border-width))) + ;; Deal with reparented windows... + (multiple-value-bind (root-x root-y) + (xlib:translate-coordinates + parent drawable-x drawable-y root) + (declare (fixnum root-y)) + (values root-x (+ root-y drawable-height + (* 2 border-width))))) + (declare (fixnum new-y)) + (values new-x + (if (> (+ new-y height border-width) root-height) + (- root-height height border-width) + new-y)))))))) + (values 200 20))) + + +;;;; View-Item. A view item is the object that contains the actual +;;;; underlying object being inspected as well as the window being +;;;; used to display it and some other information about the window. + +(defclass view-item () + ((window :initarg :window :accessor window) + (x :initarg :x :accessor x) + (y :initarg :y :accessor y) + (width :initarg :width :accessor width) + (height :initarg :height :accessor height)) + (:documentation "View-Items are objects with methods to display +themselves, track the mouse inside their boundries, handle mouse +clicks on themselves, and so on. Everything we put up on the screen is +backed in some way by a View-Item. These are the components of the +total view of an object as described in a view object.")) + +(defmethod print-object ((item view-item) stream) + (format stream "#<~S {~8,'0X}>" (type-of item) + (kernel:get-lisp-obj-address item))) + +(defgeneric view-item-p (item) + (:method ((item t)) + nil) + (:method ((item view-item)) + t)) + +;; The following generic functions constitute the interface to the +;; view-item objects. Subclasses of view-item implement behavior by +;; overriding these methods. + +(defgeneric display (item window x y)) + +(defgeneric tracker (item x y) + (:method ((item view-item) x y) + (update-current-item item x y))) + +(defgeneric untracker (item) + (:method ((item view-item)) + nil)) + +(defgeneric mouse-handler (item view key-event) + (:method ((item view-item) view key-event) + (declare (ignore view key-event)) + nil)) + +(defgeneric walker (item function) + (:method ((item view-item) function) + (declare (ignore function)) + nil)) + + +;;;; The following are functions that apply to all view-items. + +;; The *Current-Item* is the view item that is currently under the +;; mouse, to the best of our knowledge, or Nil if the mouse isn't over +;; an item that does anything with its Tracker method. + +(defvar *current-item* nil) + +;; Display-Item invokes the Display method of an item to put it up on +;; the specified window. The window, position, and size are all set, +;; and the size is returned. + +(defun display-item (item window x y) + (setf (window item) window + (x item) x + (y item) y) + (multiple-value-bind (width height) + (display item window x y) + (setf (width item) width) + (setf (height item) height) + (values width height))) + +;; Redisplay-Item redraws an item (if, say, it's changed, or if its +;; window has received an exposure event). If the item is the +;; *Current-Item*, we call its tracker method to make sure it gets +;; highlighted if it's supposed to be. + +(defun redisplay-item (item) + (when (window item) + (xlib:clear-area (window item) + :x (x item) :y (y item) + :width (width item) + :height (height item)) + (multiple-value-bind (width height) + (display item (window item) (x item) (y item)) + (setf (width item) width) + (setf (height item) height)) + (xlib:display-force-output *display*) + (when (and *current-item* + (eq (window *current-item*) + (window item))) + (tracker *current-item* *mouse-x* *mouse-y*)))) + +;; Size-Item uses the Display method to calculate the size of an item +;; once displayed. If the window supplied to View-Item is Nil, all the +;; size calculation will get done, but no graphical output will +;; happen. + +(defun size-item (item) + (if (slot-boundp item 'width) + (values (width item) (height item)) + (display-item item nil 0 0))) + + +;;;; Tracking and untracking. + +;; Update-Current-Item is used by trackers to figure out if an item is +;; really under the mouse. If it is, and it's not the same as the +;; *Current-Item*, the *Current-Item* gets untracked. If the mouse is +;; inside the current item, Update-Current-Item returns T. + +(defun update-current-item (item x0 y0) + (let ((old-current *current-item*)) + (with-slots (x y width height) item + (if (and (<= x x0 (+ x width)) + (<= y y0 (+ y height))) + (setq *current-item* item) + (setq *current-item* nil)) + (when (and old-current (not (eq *current-item* old-current))) + (untracker old-current))) + (eq item *current-item*))) + +;; The Boxifying-Tracker and Boxifying-Untracker highlight and +;; unhighlight an item by drawing or erasing a box around the object. + +(defun boxifying-tracker (item x y) + (when (update-current-item item x y) + (boxify-item item boole-1))) + +(defun boxifying-untracker (item) + (boxify-item item boole-c1)) + +(defun boxify-item (item function) + (when (view-item-p item) + (with-slots (x y width height window) item + (xlib:with-gcontext (*gcontext* :function function) + (xlib:draw-rectangle window *gcontext* (1- x) y (1+ width) (- height 2))) + (xlib:display-force-output *display*)))) + +;; Track-In-List tries to track inside of each item in the List. + +(defun track-in-list (list x0 y0) + (dolist (item list) + (when (view-item-p item) + (with-slots (x y width height) item + (when (and (<= x x0 (+ x width)) + (<= y y0 (+ y height))) + (tracker item x0 y0) + (return-from track-in-list nil))))) + (when *current-item* + (untracker *current-item*) + (setq *current-item* nil))) + + +;;;; Specialized View-Item definitions. + +(defclass inspection-item (view-item) + ((objects :initarg :objects :accessor objects) ; Objects being inspected (for decaching) + (headers :initarg :headers :accessor headers) ; List of items in header, may be Nil + (entries :initarg :entries :accessor entries)) ; List of items below header + (:documentation "Inspection-Items are used as the `top-level' items +in the display of an object. They've got a list of header items and a +list of entry items.")) + +(defun make-inspection-item (objects headers entries) + (make-instance 'inspection-item :objects objects :headers headers :entries entries)) + +;; Inspection item methods + +(defmethod display ((item inspection-item) window x0 y0) + (let ((y (+ y0 border)) + (x (+ x0 border)) + (max-width 0) + (max-x 0) + (first-entry-y nil) + (header-end-y nil) + (sb (when (scrolling-inspection-item-p item) + (scrollbar item)))) + (when sb + (funcall (reset-index sb) sb)) + ;; First, header items. + (when (headers item) + (dolist (element (headers item)) + (multiple-value-bind (width height) + (display-item element window x y) + (incf y height) + (setq max-width (max max-width width)))) + (setq header-end-y y) + (incf y vsp)) + (when sb + (incf x (+ 16 border)) + (funcall (reset-index sb) sb)) + ;; Then do entry items. + (let ((max-name-width 0)) + (setq first-entry-y y) + ;; Figure out width of widest entry slot name. + (dolist (element (entries item)) + (when (slot-item-p element) + (setq max-name-width + (max max-name-width (length (name element)))))) + (dolist (element (entries item)) + (when (slot-item-p element) + (unless (slot-boundp element 'max-name-width) + (setf (max-name-width element) max-name-width))) + (multiple-value-bind (width height) + (display-item element window x y) + (incf y height) + (setq max-width (max max-width (+ width (if sb (+ 16 border) 0))))))) + (setq max-x (+ x0 border max-width border)) + ;; Display scrollbar, if any. + (when sb + (setf (bottom sb) y) + (display-item sb window (+ x0 border) first-entry-y) + (unless (slot-boundp sb 'window-width) + (setf (window-width sb) (- max-width 16 border)))) + ;; Finally, draw a box around the whole thing. + (when window + (draw-box window x0 y0 max-x y) + (when header-end-y + (xlib:draw-line window *gcontext* x0 header-end-y max-x header-end-y))) + ;; And return size. + (values (- max-x x0) (- (+ y border) y0)))) + +(defmethod tracker ((inspection-item inspection-item) x0 y0) + (dolist (item (headers inspection-item)) + (with-slots (x y width height) item + (when (and (<= x x0 (+ x width)) + (<= y y0 (+ y height))) + (tracker item x0 y0) + (return-from tracker nil)))) + (track-in-list (entries inspection-item) x0 y0)) + +(defmethod walker ((item inspection-item) function) + (flet ((walk-item-list (list function) + (dolist (item list) + (walker item function)))) + (with-slots (x width) item + (let ((*x-constraint* (if (slot-boundp item 'width) + (+ x width (- border)) + max-window-width))) + (walk-item-list (headers item) function) + (walk-item-list (entries item) function))))) + + +(defclass scrolling-inspection-item (inspection-item) + ((scrollbar :initarg :scrollbar :accessor scrollbar) ; Scrollbar display item + (set-next :initarg :set-next :accessor set-next) ; To set next state + (next :initarg :next :accessor next)) ; To get & increment next state + (:documentation "Scrolling-Inspection-Items are used as the +'top-level' of display of objects that have lots of components and so +have to scroll. In addition to headers and entries, they've got a +scrollbar item and stuff so that the entries can lazily compute where +they are and what they should display.")) + +(defun make-scrolling-inspection-item (objects headers entries scrollbar) + (make-instance 'scrolling-inspection-item + :objects objects + :headers headers + :entries entries + :scrollbar scrollbar)) + +(defgeneric scrolling-inspection-item-p (item) + (:method ((item t)) + nil) + (:method ((item scrolling-inspection-item)) + t)) + +;; Scrolling-inspection-item methods. + +(defmethod tracker ((item scrolling-inspection-item) x0 y0) + (dolist (element (headers item)) + (with-slots (x y height width) element + (when (and (<= x x0 (+ x width)) + (<= y y0 (+ y height))) + (tracker element x0 y0) + (return-from tracker nil)))) + (let ((sb (scrollbar item))) + (with-slots (x y width height) sb + (if (and (<= x x0 (+ x width)) + (<= y y0 (+ y height))) + (tracker sb x0 y0) + (track-in-list (entries item) x0 y0))))) + + + +(defclass scrollbar (view-item) + ((scrollee :initarg :scrollee :accessor scrollee) ; Item for which this guy's a scrollbar + (bottom :initarg bottom :accessor bottom) ; Y coordinate of end (hack, hack) + (active-button :initarg :active-button :accessor active-button :initform nil) + (first-index :initarg :first-index :accessor first-index) ; Index of first thing to + ; be displayed + (next-element :initarg :next-element :accessor next-element) ; Function to extract next + ; element to be displayed + (reset-index :initarg :reset-index :accessor reset-index) ; Function to reset internal + ; index for next-element + (window-width :initarg :window-width :accessor window-width) ; Max X for scrollees + (bar-height :initarg :bar-height :accessor bar-height) ; Height of bar in pixels + (bar-top :initarg :bar-top :accessor bar-top) + (bar-bottom :initarg :bar-bottom :accessor bar-bottom) + (num-elements :initarg :num-elements :accessor num-elements) ; Number of elements in scrollee + (num-elements-displayed :initarg :num-elements-displayed + :accessor num-elements-displayed )) ; Number of elements displayed + ; at once + (:documentation "A Scrollbar has buttons and a thumb bar and the +stuff it needs to figure out whatever it needs to figure out.")) + +(defun make-scrollbar (first-index num-elements num-elements-displayed + next-element reset-index) + (make-instance 'scrollbar + :first-index first-index :num-elements num-elements + :num-elements-displayed num-elements-displayed + :next-element next-element :reset-index reset-index)) + +;;; Scrollbar methods. + +;; Yeah, we use a hard-wired constant 16 here, which is the width and +;; height of the buttons. Grody, yeah, but hey, "16" is only two +;; keystrokes... + +(defmethod display ((scrollbar scrollbar) window x y) + (with-slots (active-button bottom bar-bottom bar-top bar-height + first-index num-elements num-elements-displayed) + scrollbar + (when window + (draw-bitmap window x y + (if (eq active-button :top) + *up-arrow-i* *up-arrow*)) + (draw-bitmap window x (- bottom 16) + (if (eq active-button :bottom) + *down-arrow-i* *down-arrow*)) + (draw-box window x (+ y 16) (+ x 15) (- bottom 17)) + (setf bar-top (+ y 17) + bar-bottom (- bottom 17) + bar-height (- bar-bottom bar-top)) + (draw-block window x + (+ bar-top (truncate (* first-index bar-height) num-elements)) + (+ x 16) + (- bar-bottom + (truncate (* (- num-elements (+ first-index num-elements-displayed)) + bar-height) + num-elements))) + (xlib:display-force-output *display*)) + (values 16 (- bottom y)))) + +(defmethod tracker ((scrollbar scrollbar) x0 y0) + (with-slots (active-button window x y bottom) scrollbar + (update-current-item scrollbar x0 y0) + (cond ((<= y y0 (+ y 16)) + (setf active-button :top) + (draw-bitmap window x y *up-arrow-i*)) + ((<= (- bottom 16) y0 bottom) + (setf active-button :bottom) + (draw-bitmap window x (- bottom 16) *down-arrow-i*)) + (t + (untracker scrollbar))) + (xlib:display-force-output *display*))) + +(defmethod untracker ((scrollbar scrollbar)) + (with-slots (active-button window x y bottom) scrollbar + (cond ((eq active-button :top) + (draw-bitmap window x y *up-arrow*)) + ((eq active-button :bottom) + (draw-bitmap window x (- bottom 16) *down-arrow*))) + (xlib:display-force-output *display*) + (setf active-button nil))) + +(defmethod mouse-handler ((scrollbar scrollbar) view key-event) + (declare (ignore view)) + (with-slots (first-index active-button num-elements num-elements-displayed + bar-top bar-bottom bar-height scrollee) + scrollbar + (let* ((old-first first-index) + (new-first old-first)) + (cond ((or (eq key-event #k"Scrolldowndown") + (eq active-button :bottom)) + (incf new-first + (if (eq key-event #k"Rightdown") + num-elements-displayed + 1))) + ((or (eq key-event #k"Scrollupdown") + (eq active-button :top)) + (decf new-first + (if (eq key-event #k"Rightdown") + num-elements-displayed + 1))) + ((<= bar-top *mouse-y* bar-bottom) + (setq new-first + (truncate (* (- *mouse-y* bar-top) + num-elements) + bar-height)))) + (setq new-first (max new-first 0)) + (setq new-first (min new-first (- num-elements num-elements-displayed))) + (unless (= new-first old-first) + (setf first-index new-first) + (funcall (reset-index scrollbar) scrollbar) + (dolist (element (entries scrollee)) + (redisplay-item element)) + (redisplay-item scrollbar))))) + + +(defclass scrolling-item (view-item) + ((scrollbar :initarg :scrollbar :accessor scrollbar) + (item :initarg :item :accessor item)) + (:documentation "Scrolling-Items are used as the entries in +Scrolling-Inspection-Items. They know the scrollbar that moves them +around so they can lazily do their stuff.")) + +(defun make-scrolling-item (scrollbar item) + (make-instance 'scrolling-item :scrollbar scrollbar :item item)) + +;; Scrolling item methods. + +(defmethod display ((item scrolling-item) window x y) + (with-slots (scrollbar item) item + (funcall (next-element scrollbar) item) + (let ((*x-constraint* (if (slot-boundp scrollbar 'window-width) + (+ (window-width scrollbar) x) + max-window-width))) + (multiple-value-bind (width height) (display item window x y) + (values + (or (and (slot-boundp scrollbar 'window-width) + (window-width scrollbar)) + width) + height))))) + +(defmethod tracker :before ((scrolling-item scrolling-item) x y) + (update-current-item scrolling-item x y)) + +(defmethod tracker ((scrolling-item scrolling-item) x y) + (tracker (item scrolling-item) x y)) + +(defmethod walker ((scrolling-item scrolling-item) function) + (walker (item scrolling-item) function)) + + +(defclass string-item (view-item) + ((item-string :initarg :item-string :accessor item-string) ; String to be displayed + (font :initarg :font :accessor font)) ; Font in which to display it + (:documentation "String-Items just have a string of text and a font +that it gets displayed in.")) + +(defun make-string-item (string &optional (font *entry-font*)) + (make-instance 'string-item :item-string string :font font)) + +;;; String item method. + +(defmethod display ((item string-item) window x y) + (disp-string window x y (item-string item) (font item))) + + +(defclass slot-item (view-item) + ((name :initarg :name :accessor name) ; String name of slot + (object :initarg :object :accessor object) ; Display item for contents of slot + (max-name-width :initarg :max-name-width + :accessor max-name-width)) ; Length of longest slot name in structure + (:documentation "Slot-Items have a string name for the slot (e.g., +structure slot name or vector index) and an object item for the +contents of the slot. The Max-Name-Width is used so that all the slots +in an inspection item can line their objects up nicely in a +left-justified column.")) + +(defun make-slot-item (name object) + (make-instance 'slot-item :name name :object object)) + +(defgeneric slot-item-p (item) + (:method ((item t)) + nil) + (:method ((item slot-item)) + t)) + +;;; Slot item methods. + +(defmethod display ((item slot-item) window x y) + (with-slots (name object max-name-width) item + (let ((name-pixel-width (* (+ 2 max-name-width) + (font-width *entry-font*)))) + (disp-string window x y name *entry-font*) + (multiple-value-bind (width height) (display-item object window (+ x name-pixel-width) y) + (values (+ name-pixel-width width border) + (max (+ (font-height *entry-font*) vsp) height)))))) + +(defmethod tracker ((item slot-item) x y) + (tracker (object item) x y)) + +(defmethod walker ((item slot-item) function) + (with-slots (object max-name-width) item + (walker object function) + (setf (width item) + (+ (* (+ 2 max-name-width) (font-width *entry-font*)) + (width object) + border)))) + + +(defclass list-item (view-item) + ((item-list :initarg :item-list :accessor item-list)) ; List of things to be displayed + (:documentation "List-Items are used to display several things on +the same line, one after the other.")) + +(defun make-list-item (list) + (make-instance 'list-item :item-list list)) + +;;; List item methods. + +;; If a thing in the item list is a string, we just Disp-String it. +;; That way, we don't have to cons lots of full string items all the +;; time. +(defmethod display ((item list-item) window x0 y0) + (let ((x x0) + (max-height 0)) + (dolist (item (item-list item)) + (multiple-value-bind (width height) + (if (stringp item) + (disp-string window x y0 item *entry-font*) + (display-item item window x y0)) + (incf x width) + (setq max-height (max max-height height)))) + (values (- x x0) max-height))) + +(defmethod tracker ((item list-item) x y) + (track-in-list (item-list item) x y)) + +(defmethod walker ((item list-item) function) + (dolist (element (item-list item)) + (when (view-item-p element) + (walker element function)))) + + +(defclass object-item (view-item) + ((object :initarg :object :accessor object) ; The Lisp object itself + (item-string :initarg :item-string :accessor item-string) ; String representation cache + (place :initarg :place :accessor place) ; Place where it came from + (index :initarg :index :accessor index) ; Index into where it came from + (ref :initarg :ref :accessor ref) ; Function to get object, given place and index + (setter :initarg :setter :accessor setter)) ; Function to set object, given place, index + ; and new value + (:documentation "Object-Items are used to display component Lisp +objects. They know where the object came from and how to get it again +(for decaching) and how to change it (for modification).")) + +(defun make-object-item (object place index ref set) + (make-instance 'object-item :object object :place place :index index :ref ref :setter set)) + +(defgeneric object-item-p (item) + (:method ((item t)) + nil) + (:method ((item object-item)) + t)) + +;;; Object item methods. + +(defmethod display ((item object-item) window x y) + (unless (and (slot-boundp item 'item-string) (item-string item)) + (setf (item-string item) (iprin1-to-string (object item)))) + (disp-string window x y (item-string item) *entry-font*)) + +(defmethod tracker ((item object-item) x y) + (when (update-current-item item x y) + (boxify-item item boole-1))) + +(defmethod untracker ((item object-item)) + (boxify-item item boole-c1)) + +(defmethod mouse-handler ((item object-item) view key-event) + (cond ((eq key-event #k"Leftdown") + ;; Open in current window + (push (cons (object view) + (view-item view)) + (stack view)) + (update-view-of-object view (object item))) + + ((eq key-event #k"Rightdown") + ;; Open in new window + (create-view-of-object (object item) (prin1 (type-of item)))) + + ((eq key-event #k"Middledown") + ;; Return object from inspect + (setq *inspect-result* (object item)) + (try-to-quit)) + + ((eq key-event #k"Super-Middledown") + ;; Return object but leave windows around + (setq *inspect-result* (object item)) + (try-to-proceed)))) + +(defmethod walker ((item object-item) function) + (funcall function item)) + +;;; Object* items. + +(defclass object*-item (object-item) + ((live :initarg :live :accessor live) + (string* :initarg :string* :accessor string*)) + (:documentation "Object*-Items are like Object-Items except that +sometimes they can be like string items and be not-selectable.")) + +(defun make-object*-item (string* object live place index ref set) + (make-instance 'object*-item + :string* string* + :object object + :live live + :place place + :index index + :ref ref + :setter set)) + +(defgeneric object*-item-p (item) + (:method ((item t)) + nil) + (:method ((item object*-item)) + t)) + +;;; Object* item methods. + +(defmethod display ((item object*-item) window x y) + (if (live item) + (call-next-method) + (disp-string window x y (string* item) *italic-font*))) + +(defmethod tracker ((item object*-item) x y) + (if (or (live item) (eq *tracking-mode* :destination)) + (boxifying-tracker item x y) + (update-current-item item x y))) + +(defmethod untracker ((item object*-item)) + (when (or (live item) (eq *tracking-mode* :destination)) + (boxifying-untracker item))) + +(defmethod mouse-handler ((item object*-item) view key-event) + (when (live item) + (call-next-method))) + + +;;;; Display stuff. This uses the methods defined above to actually +;;;; render the objects onto a visible window. + +;; Computing display items for Lisp objects. + + +(defgeneric plan-view (object &key header stream) + (:documentation "Plan-View returns a top-level View-Item for the + given Object.")) + +(defgeneric replan-view (object plan) + (:documentation "Replan-view tries to fix up the existing Plan if +possible, but might punt and just return a new View-Item if things +have changed too much.")) + +(defun replan (plan) + "Replan is for the update function. It sets up the right calling + convention for calling the generic replan-view function." + (let ((object (objects plan))) + (replan-view object plan))) + + +(defun replan-object-item (item) + "Replan-Object-Item is used at the leaves of the replanning walk." + (if (object*-item-p item) + (multiple-value-bind (decached-object live) + (funcall (ref item) (place item) (index item)) + (unless (and (eq live (live item)) + (eq decached-object (object item)) + (or (symbolp decached-object) (numberp decached-object) + ;; ... + )) + (setf (live item) live) + (setf (object item) decached-object) + (setf (item-string item) nil) + (redisplay-item item))) + (let ((decached-object (funcall (ref item) + (place item) (index item)))) + (unless (and (eq decached-object (object item)) + (or (symbolp decached-object) (numberp decached-object) + ;; ... any others that'll be the same? + )) + (setf (object item) decached-object) + (setf (item-string item) nil) + (redisplay-item item))))) + + +;; Figure out how long random list structures are. Deals with dotted +;; lists and circular lists. + +;; This routine is too simple --- I'm not sure it always works. In +;; particular, I doubt it gives an accurate count for every kind of +;; circular list. +(defun count-conses (list) + (if (atom list) + (values 0 :atom) + (do ((count 1 (1+ count)) + (tortoise list) + (tortoise-advance nil (not tortoise-advance)) + (hare (cdr list) (cdr hare))) + ((or (null hare) (not (listp hare)) (eq hare tortoise)) + (cond ((null hare) + (values count :proper-list)) + ((not (listp hare)) + (values count :dotted-list)) + ((eq hare tortoise) + (values count :circular-list)))) + (when tortoise-advance + (setf tortoise (cdr tortoise)))))) + + +;; For lists, what we stash in the Inspection-Item-Objects slot is the +;; list of the top level conses, rather than the conses themselves. +;; This lets us detect when conses "in the middle" of the list change. +(defmethod plan-view ((object list) &key &allow-other-keys) + (cond + ;; Display the list object as a "list": ( .... ) + ((or (and (< (size-item (make-string-item (iprin1-to-string object))) + (- max-window-width (* 2 border))) + (<= (count-conses object) inspect-length)) + (= (count-conses object) 1)) + (do ((list object (cdr list)) + (i 0 (1+ i)) + (items (list "("))) + ((or (not (consp (cdr list))) + ;; The following covers circular lists. + (> i (count-conses object))) + (push (make-object-item (car list) list nil 'lref 'lset) items) + (when (not (null (cdr list))) + (push " . " items) + (push (make-object-item (cdr list) list nil 'lref* 'lset*) items)) + (push ")" items) + (make-inspection-item + (copy-n-conses object (count-conses object)) + nil + (list (make-list-item (nreverse items))))) + (push (make-object-item (car list) list nil 'lref 'lset) items) + (push " " items))) + + ((<= (count-conses object) inspect-length) + (let ((items nil)) + (push (make-list-item (list "(" + (make-object-item + (car object) object nil 'lref 'lset))) + items) + (do ((list (cdr object) (cdr list))) + ((not (consp (cdr list))) + (cond ((null (cdr list)) + (push (make-list-item + (list " " + (make-object-item + (car list) list nil 'lref 'lset) + ")")) + items)) + (t + (push (make-list-item + (list " " + (make-object-item + (car list) list nil 'lref 'lset))) + items) + (push " ." items) + (push (make-list-item + (list " " + (make-object-item + (cdr list) list nil 'lref* 'lset*) + ")")) + items)))) + (push (make-list-item + (list " " + (make-object-item + (car list) list nil 'lref 'lset))) + items)) + (make-inspection-item (copy-n-conses object (count-conses object)) + nil (nreverse items)))) + + ;; This list is too long --- use a scrolling view. + (t + (let ((scrollbar + (let ((index 0) + (cons object) + (last (last object))) + (make-scrollbar + 0 + (+ (count-conses object) (if (cdr last) 1 0)) + inspect-length + #'(lambda (item) + (setf (item-list item) + `(,(cond ((eq cons object) "(") + ((not (consp cons)) " . ") + (t " ")) + ,(if (consp cons) + (make-object-item (car cons) cons nil 'lref 'lset) + (make-object-item cons last nil 'lref* 'lset*)) + ,@(if (or (and (eq cons last) (null (cdr cons))) + (atom cons)) + `(")")))) + (incf index) + (unless (atom cons) + (setq cons (cdr cons)))) + #'(lambda (item) + (setq index (first-index item)) + (setq cons (nthcdr index object))))))) + (setf (scrollee scrollbar) + (make-scrolling-inspection-item + (copy-n-conses object (count-conses object)) + nil + (let ((items nil)) + (dotimes (i inspect-length) + (push (make-scrolling-item scrollbar (make-list-item nil)) + items)) + (nreverse items)) + scrollbar))) + ))) + +;; This is kind of like (maplist #'identity list), except that it +;; doesn't choke on non-nil-terminated lists. +(defun copy-conses (list) + (do ((list list (cdr list)) + (conses nil)) + ((atom list) + (nreverse conses)) + (push list conses))) + + +;; This will copy "n" conses; this deals with circular lists. +(defun copy-n-conses (list n) + (do ((i 1 (1+ i)) + (list list (cdr list)) + (conses nil)) + ((or (atom list) (= i n)) (nreverse conses)) + (push list conses))) + + +(defmethod replan-view ((object list) plan) + (cond ((do ((list (car object) (cdr list)) + (conses object (cdr conses))) + ((or (null list) (null conses)) + (and (null list) (null conses))) + (unless (and (eq list (car conses)) + (eq (cdr list) (cadr conses))) + (return nil))) + (walker plan #'replan-object-item) + plan) + (t + (plan-view (car object))))) + +(defun lref (object ignore) (declare (ignore ignore)) + (car object)) +(defun lref* (object ignore) (declare (ignore ignore)) + (cdr object)) +(defun lset (object ignore new) (declare (ignore ignore)) + (setf (car object) new)) +(defun lset* (object ignore new) (declare (ignore ignore)) + (setf (cdr object) new)) + + +(defmethod plan-view ((object vector) &key &allow-other-keys) + (let* ((type (type-of object)) + (length (array-dimension object 0)) + (header + `(,(make-string-item (format nil "~A" (if (listp type) (car type) type)) + *header-font*) + ,(make-string-item (format nil "Length = ~D" length) + *header-font*) + ,@(if (array-has-fill-pointer-p object) + `(,(make-list-item (list "Fill-Pointer: " + (make-object-item + (fill-pointer object) + object nil 'fpref 'fpset)))))))) + (cond ((<= length inspect-length) + (make-inspection-item + object + header + (let ((items nil)) + (dotimes (i length) + (push (make-slot-item (prin1-to-string i) + (make-object-item + (aref object i) object i 'vref 'vset)) + items)) + (nreverse items)))) + (t + (let ((scrollbar + (let ((index 0)) + (make-scrollbar + 0 + length + inspect-length + #'(lambda (item) + (setf (name item) (prin1-to-string index)) + (let ((obj (object item))) + (setf (object obj) (aref object index)) + (setf (index obj) index) + (setf (item-string obj) nil)) + (incf index)) + #'(lambda (item) + (setq index (first-index item))))))) + (setf (scrollee scrollbar) + (make-scrolling-inspection-item + object + header + (let ((items nil) + (name-width (length (iprin1-to-string (1- length))))) + (dotimes (i inspect-length) + (let ((slot + (make-slot-item + nil + (make-object-item nil object nil 'vref 'vset)))) + (setf (max-name-width slot) name-width) + (push (make-scrolling-item scrollbar slot) items))) + (nreverse items)) + scrollbar))))))) + +(defmethod replan-view ((object vector) plan) + (cond ((= (length object) (length (objects plan))) + (walker plan #'replan-object-item) + plan) + (t + (plan-view object)))) + +(defun vref (object index) + (aref object index)) +(defun vset (object index new) + (setf (aref object index) new)) + +(defun fpref (object index) + (declare (ignore index)) + (fill-pointer object)) +(defun fpset (object index new) + (declare (ignore index)) + (setf (fill-pointer object) new)) + + +(defmethod plan-view ((object array) &key &allow-other-keys) + (lisp::with-array-data ((data object) + (start) + (end)) + (let* ((length (- end start)) + (dimensions (array-dimensions object)) + (rev-dimensions (reverse dimensions)) + (header + (list (make-string-item + (format nil "Array of ~A" (array-element-type object)) + *header-font*) + (make-string-item + (format nil "Dimensions = ~S" dimensions) + *header-font*)))) + (cond ((<= length inspect-length) + (make-inspection-item + object + header + (let ((items nil)) + (dotimes (i length) + (push (make-slot-item (index-string i rev-dimensions) + (make-object-item + (aref data (+ start i)) + object (+ start i) 'vref 'vset)) + items)) + (nreverse items)))) + (t + (let ((scrollbar + (let ((index 0)) + (make-scrollbar + 0 + length + inspect-length + #'(lambda (item) + (setf (name item) + (index-string index rev-dimensions)) + (let ((obj (object item))) + (setf (object obj) + (aref data (+ start index))) + (setf (index obj) (+ start index)) + (setf (item-string obj) nil)) + (incf index)) + #'(lambda (item) + (setq index (first-index item))))))) + (setf (scrollee scrollbar) + (make-scrolling-inspection-item + object + header + (let ((items nil) + (name-width (length (index-string (1- length) + rev-dimensions)))) + (dotimes (i inspect-length) + (let ((slot + (make-slot-item + nil + (make-object-item nil data nil 'vref 'vset)))) + (setf (max-name-width slot) name-width) + (push (make-scrolling-item scrollbar slot) items))) + (nreverse items)) + scrollbar)))))))) + +(defun index-string (index rev-dimensions) + (if (null rev-dimensions) + "[]" + (let ((list nil)) + (dolist (dim rev-dimensions) + (multiple-value-bind (q r) + (floor index dim) + (setq index q) + (push r list))) + (format nil "[~D~{,~D~}]" (car list) (cdr list))))) + +(defmethod replan-view ((object array) plan) + (cond ((and (equal (array-dimensions object) + (array-dimensions (objects plan))) + (lisp::with-array-data ((data1 object) + (start1) (end1)) + (lisp::with-array-data ((data2 (objects plan)) + (start2) (end2)) + (and (eq data1 data2) + (= start1 start2) + (= end1 end2))))) + (walker plan #'replan-object-item) + plan) + (t + (plan-view object)))) + + +(defmethod plan-view ((object t) &key &allow-other-keys) + (make-inspection-item + object + nil + (list (make-object-item object (list object) nil 'lref 'lset)))) + +(defmethod replan-view ((object t) plan) + (declare (ignore object)) + (walker plan #'replan-object-item) + plan) + + + +(defmethod plan-view ((object structure-object) &key &allow-other-keys) + (let* ((dd (kernel:layout-info (kernel:%instance-layout object))) + (dsds (kernel:dd-slots dd))) + (make-inspection-item + object + (list (make-string-item + (format nil "~A ~A" + (symbol-name (kernel:dd-name dd)) + object) + *header-font*)) + (let ((items nil)) + (dolist (dsd dsds) + (push (make-slot-item + (kernel:dsd-%name dsd) + (make-object-item + (funcall (fdefinition (kernel:dsd-accessor dsd)) object) + object (kernel:dsd-index dsd) + #'(lambda (str ignore) + (declare (ignore ignore)) + (funcall (fdefinition (kernel:dsd-accessor dsd)) + str)) + #'(lambda (str ignore val) + (declare (ignore ignore)) + (funcall (fdefinition `(setf ,(kernel:dsd-accessor dsd))) + val str)))) + items)) + (nreverse items))))) + +(defmethod replan-view ((object structure-object) plan) + (declare (ignore object)) + (walker plan #'replan-object-item) + plan) + + + +(defmethod plan-view ((object standard-object) &key &allow-other-keys) + (let ((class (pcl:class-of object))) + (make-inspection-item + object + (list (make-string-item (format nil "~S ~A" + (pcl:class-name class) + object) + *header-font*)) + (let ((slotds (pcl::slots-to-inspect class object)) + instance-slots class-slots other-slots) + (dolist (slotd slotds) + (with-slots ((slot pcl::name) (allocation pcl::allocation)) slotd + (let* ((boundp (slot-boundp object slot)) + (item (make-slot-item (prin1-to-string slot) + (make-object*-item + "Unbound" + (and boundp (slot-value object slot)) + boundp + object + slot + 'ref-slot + 'set-slot)))) + (case allocation + (:instance (push item instance-slots)) + (:class (push item class-slots)) + (otherwise + (setf (name item) + (format nil "~S [~S]" slot allocation)) + (push item other-slots)))))) + (append (unless (null instance-slots) + (cons (make-string-item "These slots have :INSTANCE allocation" + *entry-font*) + (nreverse instance-slots))) + (unless (null class-slots) + (cons (make-string-item "These slots have :CLASS allocation" + *entry-font*) + (nreverse class-slots))) + (unless (null other-slots) + (cons (make-string-item "These slots have allocation as shown" + *entry-font*) + (nreverse other-slots)))))))) + + +(defun ref-slot (object slot) + (if (slot-boundp object slot) + (values (slot-value object slot) t) + (values nil nil))) + +(defun set-slot (object slot val) + (setf (slot-value object slot) val)) + +;;; Should check to see if we need to redo the entire plan or not. +(defmethod replan-view ((object standard-object) plan) + (declare (ignore plan)) + (plan-view object)) + + + +(defmethod plan-view ((object symbol) &key &allow-other-keys) + (make-inspection-item + object + (list (make-string-item (format nil "Symbol ~A" object) *header-font*)) + (list (make-slot-item "Value" + (make-object*-item + "Unbound" (if (boundp object) (symbol-value object)) + (boundp object) object nil 'valref 'valset)) + (make-slot-item "Function" + (make-object*-item + "Undefined" (if (fboundp object) (symbol-function object)) + (fboundp object) object nil 'defref 'defset)) + (make-slot-item "Properties" + (make-object-item + (symbol-plist object) object nil 'plistref 'plistset)) + (make-slot-item "Package" + (make-object-item + (symbol-package object) object nil 'packref 'packset))))) + +(defmethod replan-view ((object symbol) plan) + (declare (ignore object)) + (walker plan #'replan-object-item) + plan) + +(defun valref (object ignore) (declare (ignore ignore)) + (if (boundp object) + (values (symbol-value object) t) + (values nil nil))) +(defun defref (object ignore) (declare (ignore ignore)) + (if (fboundp object) + (values (symbol-function object) t) + (values nil nil))) +(defun plistref (object ignore) (declare (ignore ignore)) + (symbol-plist object)) +(defun packref (object ignore) (declare (ignore ignore)) + (symbol-package object)) + +(defun valset (object ignore new) (declare (ignore ignore)) + (setf (symbol-value object) new)) +(defun defset (object ignore new) (declare (ignore ignore)) + (setf (symbol-function object) new)) +(defun plistset (object ignore new) (declare (ignore ignore)) + (setf (symbol-plist object) new)) +(defun packset (object ignore new) (declare (ignore ignore)) + (lisp::%set-symbol-package object new)) + + +;; This is all very gross and silly now, just so we can get something +;; working quickly. Eventually do this with a special stream that +;; listifies things as it goes along... +(defmethod plan-view ((object function) &key &allow-other-keys) + (let ((stream (make-string-output-stream))) + (let ((*standard-output* stream) + (ext:*describe-print-level* 30)) + (describe object)) + (close stream) + (with-input-from-string (in (get-output-stream-string stream)) + (plan-view-text + object + (list + (make-string-item (format nil "Function ~S" object) *header-font*) + (make-string-item + (format nil "Argument list: ~A" (kernel:%function-arglist object)))) + in)))) + + +(defun plan-view-text (object header stream) + (let ((list nil)) + (do ((line (read-line stream nil nil) (read-line stream nil nil))) + ((null line)) + (push line list)) + (setq list (nreverse list)) + (if (<= (length list) inspect-length) + (make-inspection-item + object + header + (mapcar #'make-string-item list)) + (let ((index 0) + (vector (coerce list 'vector))) + (let ((scrollbar (make-scrollbar + 0 (length list) inspect-length + #'(lambda (item) + (setf (item-string item) + (aref vector index)) + (incf index)) + #'(lambda (item) + (setq index + (first-index item)))))) + (setf (scrollee scrollbar) + (make-scrolling-inspection-item + object + header + (let ((items nil)) + (dotimes (i inspect-length) + (push + (make-scrolling-item + scrollbar + ;; This is to ensure that the slots in + ;; the string item are bound. + (let ((string-item (make-string-item ""))) + (setf (x string-item) 0 + (y string-item) 0 + (width string-item) 0 + (height string-item) 0) + string-item)) + items)) + (nreverse items)) + scrollbar))))))) + + +;;;; Displaying old and new plans in old and new windows. + +(defun new-plan-in-new-view (object plan &optional name) + (multiple-value-bind (width height) (size-item plan) + ;; add border + (incf width 10) + (incf height 10) + (multiple-value-bind (x y) (next-window-position width height) + (let* ((window (xlib:create-window :parent *root* :x x :y y + :width width :height height + :background *white-pixel* + :border-width 2)) + (view (make-view name object plan window))) + (xlib:set-wm-properties window + :name "Inspector Window" + :icon-name "Inspector Display" + :resource-name "Inspector" + :x x :y y :width width :height height + :user-specified-position-p t + :user-specified-size-p t + :min-width width :min-height height + :width-inc nil :height-inc nil) + (setf (xlib:wm-protocols window) `(:wm_delete_window)) + (add-window-view-mapping window view) + (xlib:map-window window) + (xlib:clear-area window) + (xlib:with-state (window) + (setf (xlib:window-event-mask window) important-xevents-mask) + (setf (xlib:window-cursor window) *cursor*)) + (xlib:display-finish-output *display*) + (display-item plan window 5 5) + (push view *views*) + (multiple-value-bind + (x y same-screen-p child mask root-x root-y root) + (xlib:query-pointer window) + (declare (ignore same-screen-p child mask root-x root-y root)) + (when (and (< 0 x (+ width 10)) (< 0 y (+ height 10))) + (tracker plan x y))) + (xlib:display-force-output *display*) + view)))) + +(defun create-view-of-object (object &optional name) + (new-plan-in-new-view object (plan-view object) name)) + +(defun new-plan-in-old-view (view old new) + (unless (eq new old) + (setf (view-item view) new) + (let ((window (window view))) + (when (and *current-item* + (eql (window *current-item*) window)) + (setq *current-item* nil)) + (multiple-value-bind (width height) + (size-item new) + (xlib:with-state (window) + (setf (xlib:drawable-width window) (+ width 10)) + (setf (xlib:drawable-height window) (+ height 10))) + (xlib:clear-area window) + (display-item new window 5 5) + (setf (window new) window + (x new) 5 + (y new) 5 + (width new) width + (height new) height) + (xlib:display-force-output *display*) + (multiple-value-bind + (x y same-screen-p child mask root-x root-y root) + (xlib:query-pointer window) + (declare (ignore same-screen-p child mask root-x root-y root)) + (when (and (< 0 x (+ width 10)) (< 0 y (+ height 10))) + (tracker new x y))))))) + +(defun update-view-of-object (view &optional (object (object view))) + (cond ((eq object (object view)) + (new-plan-in-old-view view + (view-item view) + (replan (view-item view)))) + (t + (setf (object view) object) + (new-plan-in-old-view view (view-item view) (plan-view object)))) + (xlib:display-force-output *display*)) + + +;; DELETING-WINDOW-DROP-EVENT checks for any events on win. If there +;; is one, it is removed from the queue, and t is returned. Otherwise, +;; returns nil. +(defun deleting-window-drop-event (display win) + (xlib:display-finish-output display) + (let ((result nil)) + (xlib:process-event + display :timeout 0 + :handler #'(lambda (&key event-window window &allow-other-keys) + (if (or (eq event-window win) (eq window win)) + (setf result t) + nil))) + result)) + +(defun remove-view-of-object (view) + (let (#+:mp (update-process (update-process view)) + (window (window view))) + #+:mp (mp:destroy-process update-process) + (setf (xlib:window-event-mask window) #.(xlib:make-event-mask)) + (xlib:display-finish-output *display*) + (loop (unless (deleting-window-drop-event *display* window) (return))) + (xlib:destroy-window window) + (xlib:display-finish-output *display*) + (delete-window-view-mapping window) + (setq *views* (delete view *views*)))) + + +;;;; The command interpreter. + +(defvar *can-quit* nil) +(defvar *can-proceed* nil) +(defvar *unwinding* t) + +(defun try-to-quit () + (setq *current-item* nil) + (when *can-quit* + (setq *unwinding* nil) + (ext:flush-display-events *display*) + (throw 'inspect-exit nil)) + (try-to-proceed)) + +(defun try-to-proceed () + (when *can-proceed* + (setq *unwinding* nil) + (ext:flush-display-events *display*) + (throw 'inspect-proceed nil))) + +(defvar *do-command* nil) + +(defun do-command (view key-event) + (cond (*do-command* + (funcall *do-command* view key-event)) + + ;; If we get scrollwheel down key events anywhere in the view, + ;; the scrollbar wants to know about them. Yes, a bit + ;; ad-hoc.... + ((and (or (eq key-event #k"Scrollupdown") + (eq key-event #k"Scrolldowndown")) + (typep (view-item view) 'scrolling-inspection-item)) + (dotimes (i 5) ; Simulate multiple clicks. + (mouse-handler (scrollbar (view-item view)) view key-event))) + + ((or (eq key-event #k"d") (eq key-event #k"D")) + ;; Delete current window. + (remove-view-of-object view) + (setq *current-item* nil) + (unless *views* + (try-to-quit) + (try-to-proceed))) + + ((or (eq key-event #k"h") (eq key-event #k"H") (eq key-event #k"?")) + (let ((inspect-length (max inspect-length 30))) + (with-open-file (stream help-file-pathname :direction :input) + (new-plan-in-new-view + nil + (plan-view-text nil + (list (make-string-item "Help" *header-font*)) + stream) + "Help Window")))) + + ((or (eq key-event #k"m") (eq key-event #k"M")) + ;; Modify something. + ;; Since the tracking stuff sets up event handlers that can + ;; throw past the CLX event dispatching form in + ;; INSPECTOR-EVENT-HANDLER, those handlers are responsible + ;; for discarding their events when throwing to this CATCH + ;; tag. + (catch 'quit-modify + (let* ((destination-item (track-for-destination)) + (source (cond + ((eq key-event #k"m") + (object (track-for-source))) + (t + (format *query-io* + "~&Form to evaluate for new contents: ") + (force-output *query-io*) + (eval (read *query-io*)))))) + (funcall (setter destination-item) + (place destination-item) + (index destination-item) + source) + (update-view-of-object view)))) + + ((or (eq key-event #k"q") (eq key-event #k"Q")) + ;; Quit. + (try-to-quit)) + + ((or (eq key-event #k"p") (eq key-event #k"P")) + ;; Proceed. + (try-to-proceed)) + + ((or (eq key-event #k"r") (eq key-event #k"R")) + ;; Recompute object (decache). + (update-view-of-object view)) + + ((or (eq key-event #k"u") (eq key-event #k"U")) + ;; Up (pop history stack). + (when (stack view) + (let ((parent (pop (stack view)))) + (setf (object view) (car parent)) + (new-plan-in-old-view view (view-item view) (cdr parent)) + (update-view-of-object view)))) + + ((or (eq key-event #k"Leftdown") + (eq key-event #k"Middledown") + (eq key-event #k"Rightdown") + (eq key-event #k"Super-Leftdown") + (eq key-event #k"Super-Middledown") + (eq key-event #k"Super-Rightdown") +;; (eq key-event #k"Scrollupdown") +;; (eq key-event #k"Scrolldowndown") +;; (eq key-event #k"Super-Scrollupdown") +;; (eq key-event #k"Super-Scrolldowndown") + ) + + (when *current-item* + (mouse-handler *current-item* view key-event))))) + + +;;;; Stuff to make modification work. + +(defun track-for-destination () + (track-for :destination *cursor-d*)) + +(defun track-for-source () + (track-for :source *cursor-s*)) + +;; TRACK-FOR loops over SYSTEM:SERVE-EVENT waiting for some event +;; handler to throw to this CATCH tag. Since any such handler throws +;; past SYSTEM:SERVE-EVENT, and therefore, past the CLX event +;; dispatching form in INSPECTOR-EVENT-HANDLER, it is that handler's +;; responsibility to discard its event. +(defun track-for (tracking-mode cursor) + (let ((*tracking-mode* tracking-mode) + (*do-command* #'track-for-do-command)) + (catch 'track-for + (unwind-protect + (progn + (dolist (view *views*) + (setf (xlib:window-cursor (window view)) + cursor)) + (xlib:display-force-output *display*) + (loop + (system:serve-event))) + (dolist (view *views*) + (setf (xlib:window-cursor (window view)) + *cursor*)) + (xlib:display-force-output *display*))))) + +;; TRACK-FOR-DO-COMMAND is the "DO-COMMAND" executed when tracking. +;; Since this throws past the CLX event handling form in +;; INSPECTOR-EVENT-HANDLER, the responsibility for discarding the +;; current event lies here. +(defun track-for-do-command (view key-event) + (declare (ignore view)) + (cond + ((or (eq key-event #k"q") (eq key-event #k"Q")) + (xlib:discard-current-event *display*) + (throw 'quit-modify t)) + ((or (eq key-event #k"Leftdown") + (eq key-event #k"Middledown") + (eq key-event #k"Rightdown")) + (when (object-item-p *current-item*) + (throw 'track-for + (prog1 *current-item* + (when (object*-item-p *current-item*) + (untracker *current-item*) + (setq *current-item* nil)) + (xlib:discard-current-event *display*))))))) + + + +;;;; Top-level program interface. + +(defun show-object (object &optional name) + (inspect-init) + (dolist (view *views*) + (when (if name + (eq name (name view)) + (eq object (object view))) + (update-view-of-object view object) + (return-from show-object nil))) + (create-view-of-object object name)) + +(defun remove-object-view (object &optional name) + (dolist (view *views*) + (when (if name + (eq name (name view)) + (eq object (object view))) + (remove-view-of-object view) + (return nil)))) + +(defun remove-all-views () + (dolist (view *views*) + (remove-view-of-object view))) + + + +;;;; Top-level user interface. + +(defvar *interface-style* :graphics + "This specifies the default value for the interface argument to INSPECT. The + default value of this is :graphics, indicating when running under X, INSPECT + should use a graphics interface instead of a command-line oriented one.") + +(defun inspect (&optional (object nil object-p) + (interface *interface-style*)) + "(inspect <object> <interface>) + +Interactively examine Lisp objects. + +Arguments: + +object: The object to examine. + +interface: one of [:window :windows :graphics :graphical :x + :command-line :tty] + +Any of [:window :windows :graphics :graphical :x] give a windowing +interface. Once you've got a window, type <h> or <H> to get a help +window explaining how to use it. + +Either of [:command-line :tty] gives a pure command-line inspector. + +If <interface> is not supplied, the default is to use a windowing +interface if running under X11, and a command-line interface if not. + +If neither argument is given, the windowing version of inspect will +resume inspection of items left active from previous uses if there are +any, otherwise give an error. The command-line interface will give an +error." + (cond ((or (member interface '(:command-line :tty)) + (not (assoc :display ext:*environment-list*))) + (when object-p (tty-inspect object))) + ((not (member interface '(:window :windows :graphics :graphical :x))) + (error "Interface must be one of :window, :windows, :graphics, ~ + :graphical, :x, :command-line, or :tty -- not ~S." + interface)) + (object-p + (inspect-init) + (let ((disembodied-views nil) + (*inspect-result* object) + (*x-constraint* max-window-width) + (*can-quit* t) + (*can-proceed* t)) + (let ((*views* nil)) + (create-view-of-object object "User Supplied Object") + (catch 'inspect-proceed + (unwind-protect + (progn + (catch 'inspect-exit + (loop + (system:serve-event))) + (setq *unwinding* t)) + (when *unwinding* + (do ((view (pop *views*) + (pop *views*))) + ((null view)) + (remove-view-of-object view))))) + (setq disembodied-views *views*)) + (dolist (view (reverse disembodied-views)) + (push view *views*)) + *inspect-result*)) + (*views* + (inspect-init) + (let ((*inspect-result* nil) + (*can-quit* t) + (*can-proceed* t)) + (catch 'inspect-proceed + (catch 'inspect-exit + (loop + (system:serve-event)))) + *inspect-result*)) + (t (error "No object supplied for inspection and no previous ~ + inspection object exists.")))) ===================================== src/contrib/clx-inspector/compile-clx-inspector.lisp ===================================== --- /dev/null +++ b/src/contrib/clx-inspector/compile-clx-inspector.lisp @@ -0,0 +1,2 @@ +(compile-file "modules:clx-inspector/clx-inspector" + :load t) ===================================== src/contrib/clx-inspector/inspect11-d.cursor ===================================== --- /dev/null +++ b/src/contrib/clx-inspector/inspect11-d.cursor @@ -0,0 +1,8 @@ +#define inspect-d_width 16 +#define inspect-d_height 16 +#define inspect-d_x_hot 1 +#define inspect-d_y_hot 1 +static char inspect-d_bits[] = { + 0x00,0x00,0x02,0x00,0x06,0x00,0x0e,0x00,0x1e,0x00,0x3e,0x00,0x7e,0x00,0xfe, + 0x00,0xfe,0x45,0x3e,0x6c,0x36,0x54,0x62,0x54,0x60,0x44,0xc0,0x44,0xc0,0x44, + 0x00,0x00}; ===================================== src/contrib/clx-inspector/inspect11-d.mask ===================================== --- /dev/null +++ b/src/contrib/clx-inspector/inspect11-d.mask @@ -0,0 +1,6 @@ +#define inspect-d_width 16 +#define inspect-d_height 16 +static char inspect-d_bits[] = { + 0x07,0x00,0x0f,0x00,0x1f,0x00,0x3f,0x00,0x7f,0x00,0xff,0x00,0xff,0x01,0xff, + 0xef,0xff,0xff,0x7f,0xfe,0xff,0xfe,0xff,0xfe,0xf7,0xef,0xe0,0xef,0xe0,0xef, + 0xe0,0xef}; ===================================== src/contrib/clx-inspector/inspect11-s.cursor ===================================== --- /dev/null +++ b/src/contrib/clx-inspector/inspect11-s.cursor @@ -0,0 +1,8 @@ +#define inspect-s_width 16 +#define inspect-s_height 16 +#define inspect-s_x_hot 1 +#define inspect-s_y_hot 1 +static char inspect-s_bits[] = { + 0x00,0x00,0x02,0x00,0x06,0x00,0x0e,0x00,0x1e,0x00,0x3e,0x00,0x7e,0x00,0xfe, + 0x00,0xfe,0x79,0x3e,0x44,0x36,0x04,0x62,0x38,0x60,0x40,0xc0,0x44,0xc0,0x3c, + 0x00,0x00}; ===================================== src/contrib/clx-inspector/inspect11-s.mask ===================================== --- /dev/null +++ b/src/contrib/clx-inspector/inspect11-s.mask @@ -0,0 +1,6 @@ +#define inspect-s_width 16 +#define inspect-s_height 16 +static char inspect-s_bits[] = { + 0x07,0x00,0x0f,0x00,0x1f,0x00,0x3f,0x00,0x7f,0x00,0xff,0x00,0xff,0x01,0xff, + 0xfd,0xff,0xff,0x7f,0xfe,0xff,0x7e,0xff,0xfc,0xf7,0xff,0xe0,0xff,0xe0,0x7f, + 0xe0,0x7f}; ===================================== src/contrib/clx-inspector/inspect11.cursor ===================================== --- /dev/null +++ b/src/contrib/clx-inspector/inspect11.cursor @@ -0,0 +1,8 @@ +#define inspect_width 16 +#define inspect_height 16 +#define inspect_x_hot 3 +#define inspect_y_hot 1 +static char inspect_bits[] = { + 0x00,0x00,0x08,0x00,0x18,0x00,0x38,0x00,0x78,0x00,0xf8,0x00,0xf8,0x01,0xf8, + 0x03,0xf8,0x07,0xf8,0x00,0xd8,0x00,0x88,0x01,0x80,0x01,0x00,0x03,0x00,0x03, + 0x00,0x00}; ===================================== src/contrib/clx-inspector/inspect11.mask ===================================== --- /dev/null +++ b/src/contrib/clx-inspector/inspect11.mask @@ -0,0 +1,6 @@ +#define inspect_width 16 +#define inspect_height 16 +static char inspect_bits[] = { + 0x0c,0x00,0x1c,0x00,0x3c,0x00,0x7c,0x00,0xfc,0x00,0xfc,0x01,0xfc,0x03,0xfc, + 0x07,0xfc,0x0f,0xfc,0x0f,0xfc,0x01,0xdc,0x03,0xcc,0x03,0x80,0x07,0x80,0x07, + 0x00,0x03}; ===================================== src/contrib/clx-inspector/inspector.help ===================================== --- /dev/null +++ b/src/contrib/clx-inspector/inspector.help @@ -0,0 +1,73 @@ +The component objects of the window's object will become highlighted +(surrounded by a box) as the mouse passes over them. In an inspector +window, keystrokes and mouse clicks are interpreted as follows: + + Left When the mouse is over a component object, + clicking Left will inspect that object in + the current inspector window. The "up" command + (below) can be used to return to the current + object. + + Middle When the mouse is over a component object, + clicking Middle will exit the inspector, deleting + all new windows, and returning the component + as the result of the call to Inspect. + + Right When the mouse is over a component object, + clicking Right will inspect that object in + a new inspector window. + + Shift-Middle When the mouse is over a component object, + clicking Shift-Middle will exit the inspector, + leaving all windows displayed, and returning the + component as the result of the call to Inspect. + + d, D Typing "d" or "D" inside an inspector window + will delete that window, and exit the inspector + if there are no more inspector windows. + + h, H, ? Typing "h", "H", or "?" inside an inspector + window will create a window with helpful + instructions. + + m, M Typing "m" or "M" inside an inspector window + will allow one to modify a component of an + object. The mouse cursor will change from an + arrow to an arrow with an "M" beside it, + indicating that one should select the component + to be modified. Clicking any mouse button while + the mouse is over a component will select that + component as a destination for modification. + + If one has typed "m", the source object will + also be selected by the mouse, with the mouse + cursor changed to an arrow with an "S" beside + it. The object will replace the destination + component. + + If one has typed "M", the source object will be + prompted for on the *Query-IO* stream. + + When choosing the destination or source with the + mouse, one may type "q" or "Q" to abort the + modify operation. + + q, Q Typing "q" or "Q" will quit the inspector, + deleting all new inspector windows. + + p, P Typing "p" or "P" will proceed from the + inspector, leaving all inspector windows intact. + + r, R Typing "r" or "R" will recompute the display for + the object in the window. This is used to + maintain a consistent display for an object that + may have changed since the display was computed. + + u, U Typing "u" or "U" takes one back up the chain of + investigation, to the object for which this + object was displayed as a component. This only + works for displays generated by modifying a + previously current display; this does not work + for a display generated as a new inspector + window. +DONE ===================================== src/general-info/release-21a.txt ===================================== --- a/src/general-info/release-21a.txt +++ b/src/general-info/release-21a.txt @@ -20,12 +20,25 @@ New in this release: * Known issues: * Feature enhancements + * The darwin/ppc port can create executables now. Current + implementation is rather buggy, though. * Changes * Micro-optimize SCALE-FLOAT to do multiplication when possible. * Update to ASDF 3.1.4. * The external-format :UTF is no longer an alias for :UTF-8. * :ELF feature added for solaris. + * LISP:WITH-STRING-CODEPOINT-ITERATOR added to iterate over the + codepoints in a string. This works the same as + WITH-HASH-TABLE-ITERATOR. + * LISP:WITH-STRING-GLYPH-ITERATOR added to iterate over the glyphs + in a string. Works like WITH-HASH-TABLE-ITERATOR. + * LOOP supports new extended keywords + * (loop for cp being the codepoint of string ...) + * codepoints, code-point, and code-points are aliases for + codepoint. + * (loop for g-string being the glpyh of string ...) + * glyphs is an alias for glpyh. * ANSI compliance fixes: @@ -42,17 +55,40 @@ New in this release: * Support for 64-bit time_t on NetBSD added. This allows cmucl to run on more recent versions of NetBSD. * The empty package LOOP has been removed. + * Executables on x86 can be created once again. This ability was + inadvertently broken when x86 support was removed. + * (log number base) no longer generates an error when one of the + args is a double-double. + * Fix bug in kernel::dd-%log2 which returned the wrong value. + * More accurate values for (log x 2) and (log x 10): + * Add log10 implementation for double-doubles so that log10(10^n) + = n for integer n. + * An accurate log2 function added so that log2(2^n) = n. + * All unit tests pass successfully on darwin/x86, linux/x86, and + solaris/sparc. Darwin/ppc fails most of the tests dealing with + exceptions for the special functions. + + * Trac Tickets: * Ticket #54 fixed. + * Ticket #95 fixed. + * Ticket #110 fixed. + * Ticket #112 fixed. * Other changes: * Cross compile scripts from x86 to sparc and ppc updated to work again to cross-compile from the current snapshot. + * motifd is a 64-bit binary on linux again, instead of 32-bit. + * Improvements to the PCL implementation of CLOS: * Changes to building procedure: + * Dependencies for motifd are autogenerated. + * Cross compile frox darwin/x86 to solaris/x86 fixed to work + correctly. + This release is not binary compatible with code compiled using CMUCL ===================================== src/lisp/Config.ppc_darwin ===================================== --- a/src/lisp/Config.ppc_darwin +++ b/src/lisp/Config.ppc_darwin @@ -1,8 +1,4 @@ # -*- Mode: makefile -*- -PATH1 = ../../src/lisp -vpath %.h $(PATH1) -vpath %.c $(PATH1) -vpath %.S $(PATH1) CPPFLAGS = -I. -I$(PATH1) # For Mac OS X 10.2, gcc3 is appropriate. For 10.4, gcc (gcc 4.0) is ok. But ===================================== src/lisp/Config.sparc_common ===================================== --- a/src/lisp/Config.sparc_common +++ b/src/lisp/Config.sparc_common @@ -2,19 +2,6 @@ # Common configuration for sparc/solaris builds. -# These tell gmake where to look for .h, .c and .S files. Mostly for -# building the binary outside of the src tree. - -PATH1 = ../../src/lisp -vpath %.h .:$(PATH1) -vpath %.c .:$(PATH1) -vpath %.S .:$(PATH1) - -CMULOCALE = ../../src/i18n/locale -vpath %.pot $(CMULOCALE) -vpath %.po $(CMULOCALE) -vpath %.mo $(CMULOCALE) - CPP_DEFINE_OPTIONS := -DSOLARIS -DSVR4 # Enable support for :linkage-table feature. ===================================== src/lisp/Config.x86_common ===================================== --- a/src/lisp/Config.x86_common +++ b/src/lisp/Config.x86_common @@ -1,18 +1,5 @@ # -*- Mode: makefile -*- -# These tell gmake where to look for .h, .c and .S files. Mostly for -# building the binary outside of the src tree. - -PATH1 = ../../src/lisp -vpath %.h $(PATH1) -vpath %.c $(PATH1) -vpath %.S $(PATH1) - -CMULOCALE = ../../src/i18n/locale -vpath %.pot $(CMULOCALE) -vpath %.po $(CMULOCALE) -vpath %.mo $(CMULOCALE) - CPP_DEFINE_OPTIONS := -Di386 # Enable support for :linkage-table feature. ===================================== src/lisp/GNUmakefile ===================================== --- a/src/lisp/GNUmakefile +++ b/src/lisp/GNUmakefile @@ -1,7 +1,21 @@ # $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/GNUmakefile,v 1.39 2010/10/14 17:47:12 rtoy Exp $ +# These tell gmake where to look for .h, .c and .S files. Mostly for +# building the binary outside of the src tree. + +PATH1 = ../../src/lisp +vpath %.h $(PATH1) +vpath %.c $(PATH1) +vpath %.S $(PATH1) + +CMULOCALE = ../../src/i18n/locale +vpath %.pot $(CMULOCALE) +vpath %.po $(CMULOCALE) +vpath %.mo $(CMULOCALE) + all: lisp.nm + -include internals.inc include Config @@ -130,3 +144,4 @@ translations-update: msgfmt -v ../../src/$$po/$$f.po -o ../$$po/$$f.mo; \ done; done + ===================================== src/lisp/globals.h ===================================== --- a/src/lisp/globals.h +++ b/src/lisp/globals.h @@ -64,7 +64,7 @@ extern void globals_init(void); #define EXTERN(name,bytes) .extern name bytes #endif #ifdef sparc -#ifdef SVR4 +#if defined(SVR4) || defined(FEATURE_ELF) #define EXTERN(name,bytes) .global name #else #define EXTERN(name,bytes) .global _ ## name ===================================== src/lisp/lisp.c ===================================== --- a/src/lisp/lisp.c +++ b/src/lisp/lisp.c @@ -470,7 +470,7 @@ main(int argc, const char *argv[], const char *envp[]) lispobj initial_function = 0; if (builtin_image_flag != 0) { -#if defined(SOLARIS) || (defined(i386) && (defined(__linux__) || defined(DARWIN) || defined(__FreeBSD__) || defined(__NetBSD__))) +#if defined(SOLARIS) || defined(DARWIN) || (defined(i386) && (defined(__linux__) || defined(__FreeBSD__) || defined(__NetBSD__))) initial_function = (lispobj) initial_function_addr; #else initial_function = (lispobj) & initial_function_addr; ===================================== src/lisp/os-common.c ===================================== --- a/src/lisp/os-common.c +++ b/src/lisp/os-common.c @@ -221,7 +221,7 @@ os_foreign_linkage_init(void) } #endif if (i == 0) { -#if defined(sparc) +#if defined(sparc) || (defined(DARWIN) && defined(__ppc__)) if (type != LINKAGE_CODE_TYPE || strcmp(c_symbol_name, EXTERN_ALIEN_NAME("call_into_c"))) { fprintf(stderr, "linkage_data is %s but expected %s\n", c_symbol_name, @@ -229,14 +229,6 @@ os_foreign_linkage_init(void) lose("First element of linkage_data is bogus.\n"); } arch_make_linkage_entry(i, (void*) call_into_c, 1); -#elif (defined(DARWIN) && defined(__ppc__)) - if (type != 1 || strcmp(c_symbol_name, EXTERN_ALIEN_NAME("call_into_c"))) { - fprintf(stderr, "linkage_data is %s but expected %s\n", - c_symbol_name, - EXTERN_ALIEN_NAME("call_into_c")); - lose("First element of linkage_data is bogus.\n"); - } - arch_make_linkage_entry(i, &call_into_c, 1); #else if (type != LINKAGE_CODE_TYPE || strcmp(c_symbol_name, EXTERN_ALIEN_NAME("resolve_linkage_tramp"))) { ===================================== src/lisp/ppc-assem.S ===================================== --- a/src/lisp/ppc-assem.S +++ b/src/lisp/ppc-assem.S @@ -236,7 +236,7 @@ x: * The 6 is vm:function-code-offset, the 4 is * the number of bytes in a lispobj. */ - addi reg_LIP,reg_CODE,6*4-type_FunctionPointer + addi reg_LIP,reg_CODE,FUNCTION_CODE_OFFSET mtctr reg_LIP slwi reg_NARGS,reg_NL2,2 bctr ===================================== src/lisp/sparc-assem.S ===================================== --- a/src/lisp/sparc-assem.S +++ b/src/lisp/sparc-assem.S @@ -4,43 +4,12 @@ #include <sys/asm_linkage.h> #include <sys/psw.h> #include <sys/trap.h> -#define _current_binding_stack_pointer current_binding_stack_pointer -#define _current_control_stack_pointer current_control_stack_pointer -#define _current_dynamic_space_free_pointer current_dynamic_space_free_pointer -#define _foreign_function_call_active foreign_function_call_active -#define _current_control_frame_pointer current_control_frame_pointer -#define _call_into_lisp call_into_lisp -#define _function_end_breakpoint_end function_end_breakpoint_end -#define _closure_tramp closure_tramp -#define _undefined_tramp undefined_tramp -#define _function_end_breakpoint_trap function_end_breakpoint_trap -#define _function_end_breakpoint_guts function_end_breakpoint_guts -#define _call_into_c call_into_c -#define _flush_icache flush_icache -#define _do_pending_interrupt do_pending_interrupt -#define _do_dynamic_space_overflow_error do_dynamic_space_overflow_error -#define _do_dynamic_space_overflow_warning do_dynamic_space_overflow_warning -#ifdef GENCGC -/*#define _collect_garbage collect_garbage*/ -#define _fpu_save fpu_save -#define _fpu_restore fpu_restore -#endif -#ifdef LINKAGE_TABLE -#define _resolve_linkage_tramp resolve_linkage_tramp -#define _lazy_resolve_linkage lazy_resolve_linkage -#define _undefined_foreign_symbol_trap undefined_foreign_symbol_trap -#endif #ifdef __STDC__ #define FUNCDEF(x) .type x, \#function #else #define FUNCDEF(x) .type x, #function #endif #else -#include <machine/asm_linkage.h> -#include <machine/psl.h> -#include <machine/trap.h> -#define FUNCDEF(x) /* nothing */ -#define SET_SIZE(x) /* nothing */ #endif #define LANGUAGE_ASSEMBLY @@ -68,9 +37,9 @@ #define FRAMESIZE (SA(MINFRAME)) #endif .seg "text" - .global _call_into_lisp - FUNCDEF(_call_into_lisp) -_call_into_lisp: + .global call_into_lisp + FUNCDEF(call_into_lisp) +call_into_lisp: save %sp, -FRAMESIZE, %sp /* Flush all of C's register windows to the stack. */ ta ST_FLUSH_WINDOWS @@ -96,15 +65,15 @@ _call_into_lisp: set pseudo_atomic_Value, reg_ALLOC /* Turn off foreign function call. */ - sethi %hi(_foreign_function_call_active), reg_NL0 - st reg_ZERO, [reg_NL0+%lo(_foreign_function_call_active)] + sethi %hi(foreign_function_call_active), reg_NL0 + st reg_ZERO, [reg_NL0+%lo(foreign_function_call_active)] /* Load the rest of lisp state. */ - load(_current_dynamic_space_free_pointer, reg_NL0) + load(current_dynamic_space_free_pointer, reg_NL0) add reg_NL0, reg_ALLOC, reg_ALLOC - load(_current_binding_stack_pointer, reg_BSP) - load(_current_control_stack_pointer, reg_CSP) - load(_current_control_frame_pointer, reg_OCFP) + load(current_binding_stack_pointer, reg_BSP) + load(current_control_stack_pointer, reg_CSP) + load(current_control_frame_pointer, reg_OCFP) /* No longer atomic, and check for interrupt. */ andn reg_ALLOC, pseudo_atomic_Value, reg_ALLOC @@ -147,13 +116,13 @@ lra: /* Store LISP state */ andn reg_ALLOC, lowtag_Mask, reg_NL1 - store(reg_NL1,_current_dynamic_space_free_pointer) - store(reg_BSP,_current_binding_stack_pointer) - store(reg_CSP,_current_control_stack_pointer) - store(reg_CFP,_current_control_frame_pointer) + store(reg_NL1,current_dynamic_space_free_pointer) + store(reg_BSP,current_binding_stack_pointer) + store(reg_CSP,current_control_stack_pointer) + store(reg_CFP,current_control_frame_pointer) /* No longer in Lisp. */ - store(reg_NL1,_foreign_function_call_active) + store(reg_NL1,foreign_function_call_active) /* Were we interrupted? */ andn reg_ALLOC, pseudo_atomic_Value, reg_ALLOC @@ -164,13 +133,13 @@ lra: ld [%sp+FRAMESIZE-4], %i7 ret restore %sp, FRAMESIZE, %sp - SET_SIZE(_call_into_lisp) + SET_SIZE(call_into_lisp) - .global _call_into_c - FUNCDEF(_call_into_c) -_call_into_c: + .global call_into_c + FUNCDEF(call_into_c) +call_into_c: #ifdef v8plus stx %o2, [%fp - 8 - 1*8] stx %o3, [%fp - 8 - 2*8] @@ -195,17 +164,17 @@ _call_into_c: st reg_L0, [reg_CFP+4] /* Store LISP state */ - store(reg_BSP,_current_binding_stack_pointer) - store(reg_CSP,_current_control_stack_pointer) - store(reg_CFP,_current_control_frame_pointer) + store(reg_BSP,current_binding_stack_pointer) + store(reg_CSP,current_control_stack_pointer) + store(reg_CFP,current_control_frame_pointer) /* Use reg_CFP as a work register, and restore it */ andn reg_ALLOC, lowtag_Mask, reg_CFP - store(reg_CFP,_current_dynamic_space_free_pointer) - load(_current_control_frame_pointer, reg_CFP) + store(reg_CFP,current_dynamic_space_free_pointer) + load(current_control_frame_pointer, reg_CFP) /* No longer in Lisp. */ - store(reg_CSP,_foreign_function_call_active) + store(reg_CSP,foreign_function_call_active) /* Were we interrupted? */ andn reg_ALLOC, pseudo_atomic_Value, reg_ALLOC @@ -229,15 +198,15 @@ _call_into_c: set pseudo_atomic_Value, reg_ALLOC /* No longer in foreign function call. */ - sethi %hi(_foreign_function_call_active), reg_NL2 - st reg_ZERO, [reg_NL2+%lo(_foreign_function_call_active)] + sethi %hi(foreign_function_call_active), reg_NL2 + st reg_ZERO, [reg_NL2+%lo(foreign_function_call_active)] /* Load the rest of lisp state. */ - load(_current_dynamic_space_free_pointer, reg_NL2) + load(current_dynamic_space_free_pointer, reg_NL2) add reg_NL2, reg_ALLOC, reg_ALLOC - load(_current_binding_stack_pointer, reg_BSP) - load(_current_control_stack_pointer, reg_CSP) - load(_current_control_frame_pointer, reg_CFP) + load(current_binding_stack_pointer, reg_BSP) + load(current_control_stack_pointer, reg_CSP) + load(current_control_frame_pointer, reg_CFP) /* Get the return address back. */ ld [reg_CFP+4], reg_LIP @@ -267,7 +236,7 @@ _call_into_c: ret nop - SET_SIZE(_call_into_c) + SET_SIZE(call_into_c) #if 0 /* undefined_tramp and closure_tramp are now Lisp assembly routines. @@ -332,8 +301,8 @@ _closure_tramp: .text .align 8 - .global _function_end_breakpoint_guts -_function_end_breakpoint_guts: + .global function_end_breakpoint_guts +function_end_breakpoint_guts: .word type_ReturnPcHeader b 1f nop @@ -347,18 +316,18 @@ _function_end_breakpoint_guts: mov reg_NIL, reg_A5 1: - .global _function_end_breakpoint_trap -_function_end_breakpoint_trap: + .global function_end_breakpoint_trap +function_end_breakpoint_trap: unimp trap_FunctionEndBreakpoint b 1b nop - .global _function_end_breakpoint_end -_function_end_breakpoint_end: + .global function_end_breakpoint_end +function_end_breakpoint_end: - .global _flush_icache - FUNCDEF(_flush_icache) -_flush_icache: + .global flush_icache + FUNCDEF(flush_icache) +flush_icache: add %o0,%o1,%o2 1: iflush %o0 ! flush instruction cache add %o0,8,%o0 @@ -367,34 +336,34 @@ _flush_icache: nop retl ! return from leaf routine nop - SET_SIZE(_flush_icache) + SET_SIZE(flush_icache) - .global _do_pending_interrupt - FUNCDEF(_do_pending_interrupt) -_do_pending_interrupt: + .global do_pending_interrupt + FUNCDEF(do_pending_interrupt) +do_pending_interrupt: unimp trap_PendingInterrupt retl nop - SET_SIZE(_do_pending_interrupt) + SET_SIZE(do_pending_interrupt) #ifdef trap_DynamicSpaceOverflowError - .global _do_dynamic_space_overflow_error - FUNCDEF(_do_dynamic_space_overflow_error) -_do_dynamic_space_overflow_error: + .global do_dynamic_space_overflow_error + FUNCDEF(do_dynamic_space_overflow_error) +do_dynamic_space_overflow_error: unimp trap_DynamicSpaceOverflowError retl nop - SET_SIZE(_do_dynamic_space_overflow_error) + SET_SIZE(do_dynamic_space_overflow_error) #endif #ifdef trap_DynamicSpaceOverflowWarning - .global _do_dynamic_space_overflow_warning - FUNCDEF(_do_dynamic_space_overflow_warning) -_do_dynamic_space_overflow_warning: + .global do_dynamic_space_overflow_warning + FUNCDEF(do_dynamic_space_overflow_warning) +do_dynamic_space_overflow_warning: unimp trap_DynamicSpaceOverflowWarning retl nop - SET_SIZE(_do_dynamic_space_overflow_warning) + SET_SIZE(do_dynamic_space_overflow_warning) #endif #ifdef LINKAGE_TABLE @@ -411,10 +380,10 @@ _do_dynamic_space_overflow_warning: * registers have been saved, including FP registers. Hence, no need * to save them. */ - .global _lazy_resolve_linkage - .global _resolve_linkage_tramp - FUNCDEF(_resolve_linkage_tramp) -_resolve_linkage_tramp: + .global lazy_resolve_linkage + .global resolve_linkage_tramp + FUNCDEF(resolve_linkage_tramp) +resolve_linkage_tramp: /* * At this point, all of the global %g registers have been * saved by call_into_c, so we can use them as temps. %g2, @@ -433,7 +402,7 @@ _resolve_linkage_tramp: save %sp, -FRAMESIZE, %sp /* %g2 tells where we came from in the linkage table */ - call _lazy_resolve_linkage + call lazy_resolve_linkage mov reg_NIL, %o0 ! in the delay slot mov %o0, reg_NIL @@ -443,15 +412,15 @@ _resolve_linkage_tramp: jmp reg_NIL nop - SET_SIZE(_resolve_linkage_tramp) + SET_SIZE(resolve_linkage_tramp) - .global _undefined_foreign_symbol_trap - FUNCDEF(_undefined_foreign_symbol_trap) + .global undefined_foreign_symbol_trap + FUNCDEF(undefined_foreign_symbol_trap) /* * When we get called, %o0 contains the address of the data_vector object * which is a string naming the bad symbol. */ -_undefined_foreign_symbol_trap: +undefined_foreign_symbol_trap: /* Need to restore all the global registers with the Lisp values that were saved away in call_into_c. (This routine is only called from @@ -463,10 +432,10 @@ _undefined_foreign_symbol_trap: */ - load(_current_dynamic_space_free_pointer, reg_ALLOC) - load(_current_binding_stack_pointer, reg_BSP) - load(_current_control_stack_pointer, reg_CSP) - load(_current_control_frame_pointer, reg_CFP) + load(current_dynamic_space_free_pointer, reg_ALLOC) + load(current_binding_stack_pointer, reg_BSP) + load(current_control_stack_pointer, reg_CSP) + load(current_control_frame_pointer, reg_CFP) set NIL, reg_NIL @@ -493,9 +462,9 @@ _undefined_foreign_symbol_trap: * a sparc v9, the Lisp code can actually use all 32 double-float * registers. For later. */ - .global _fpu_save - FUNCDEF(_fpu_save) -_fpu_save: + .global fpu_save + FUNCDEF(fpu_save) +fpu_save: std %f0, [%o0 + 4*0] std %f2, [%o0 + 4*2] std %f4, [%o0 + 4*4] @@ -535,11 +504,11 @@ _fpu_save: #endif retl nop - SET_SIZE(_fpu_save) + SET_SIZE(fpu_save) - .global _fpu_restore - FUNCDEF(_fpu_restore) -_fpu_restore: + .global fpu_restore + FUNCDEF(fpu_restore) +fpu_restore: ldd [%o0 + 4*0], %f0 ldd [%o0 + 4*2], %f2 ldd [%o0 + 4*4], %f4 @@ -579,254 +548,8 @@ _fpu_restore: #endif retl nop - SET_SIZE(_fpu_restore) - -#ifndef SOLARIS - -/****************************************************************\ -* State saving and restoring. -\****************************************************************/ - - - .global _call_on_stack -_call_on_stack: - call %o0 - sub %o1, SA(MINFRAME), %sp - unimp 0 + SET_SIZE(fpu_restore) - .global _save_state -_save_state: - save %sp, -(SA(8*4)+SA(MINFRAME)), %sp - ta ST_FLUSH_WINDOWS - st %i7, [%sp+SA(MINFRAME)] - st %g1, [%sp+SA(MINFRAME)+4] - std %g2, [%sp+SA(MINFRAME)+8] - std %g4, [%sp+SA(MINFRAME)+16] - std %g6, [%sp+SA(MINFRAME)+24] - ! ### Should also save the FP state. - mov %i1, %o1 - call %i0 - mov %sp, %o0 - mov %o0, %i0 -restore_state: - ld [%sp+SA(MINFRAME)+4], %g1 - ldd [%sp+SA(MINFRAME)+8], %g2 - ldd [%sp+SA(MINFRAME)+16], %g4 - ldd [%sp+SA(MINFRAME)+24], %g6 - ret - restore - - .global _restore_state -_restore_state: - ta ST_FLUSH_WINDOWS - mov %o0, %fp - mov %o1, %i0 - restore - ld [%sp+SA(MINFRAME)], %i7 - b restore_state - mov %o0, %i0 - - - -/****************************************************************\ - -We need our own version of sigtramp. - -\****************************************************************/ - - .global __sigtramp, __sigfunc -__sigtramp: - ! - ! On entry sp points to: - ! 0 - 63: window save area - ! 64: signal number - ! 68: signal code - ! 72: pointer to sigcontext - ! 76: addr parameter - ! - ! A sigcontext looks like: -#define SC_ONSTACK 0 -#define SC_MASK 4 -#define SC_SP 8 -#define SC_PC 12 -#define SC_NPC 16 -#define SC_PSR 20 -#define SC_G1 24 -#define SC_O0 28 - ! - ! We change sc_g1 to point to a reg save area: -#define IREGS_SAVE 0 -#define FPREGS_SAVE (32*4) -#define Y_SAVE (64*4) -#define FSR_SAVE (65*4) -#define REGSAVESIZE (66*4) - ! - ! After we allocate space for the reg save area, the stack looks like: - ! < window save area, etc > -#define REGSAVEOFF SA(MINFRAME) -#define IREGSOFF REGSAVEOFF+IREGS_SAVE -#define FPREGSOFF REGSAVEOFF+FPREGS_SAVE -#define YOFF REGSAVEOFF+Y_SAVE -#define FSROFF REGSAVEOFF+FSR_SAVE -#define ORIGSIGNUMOFF REGSAVEOFF+REGSAVESIZE -#define ORIGCODEOFF ORIGSIGNUMOFF+4 -#define ORIGSCPOFF ORIGSIGNUMOFF+8 -#define ORIGADDROFF ORIGSIGNUMOFF+12 - - ! Allocate space for the reg save area. - sub %sp, REGSAVESIZE+SA(MINFRAME)-64, %sp - - ! Save integer registers. - ! Note: the globals and outs are good, but the locals and ins have - ! been trashed. But luckly, they have been saved on the stack. - ! So we need to extract the saved stack pointer from the sigcontext - ! to determine where they are. - std %g0, [%sp+IREGSOFF] - std %g2, [%sp+IREGSOFF+8] - std %g4, [%sp+IREGSOFF+16] - std %g6, [%sp+IREGSOFF+24] - std %o0, [%sp+IREGSOFF+32] - std %o2, [%sp+IREGSOFF+40] - ld [%sp+ORIGSCPOFF], %o2 - ld [%o2+SC_SP], %o0 - std %o4, [%sp+IREGSOFF+48] - st %o0, [%sp+IREGSOFF+56] - st %o7, [%sp+IREGSOFF+60] - - ldd [%o0], %l0 - ldd [%o0+8], %l2 - ldd [%o0+16], %l4 - ldd [%o0+24], %l6 - ldd [%o0+32], %i0 - ldd [%o0+40], %i2 - ldd [%o0+48], %i4 - ldd [%o0+56], %i6 - std %l0, [%sp+IREGSOFF+64] - std %l2, [%sp+IREGSOFF+72] - std %l4, [%sp+IREGSOFF+80] - std %l6, [%sp+IREGSOFF+88] - std %i0, [%sp+IREGSOFF+96] - std %i2, [%sp+IREGSOFF+104] - std %i4, [%sp+IREGSOFF+112] - std %i6, [%sp+IREGSOFF+120] - - ! Check to see if we need to save the fp regs. - ld [%o2+SC_PSR], %l5 ! get psr - set PSR_EF, %l0 - mov %y, %l2 ! save y - btst %l0, %l5 ! is FPU enabled? - bz 1f ! if not skip FPU save - st %l2, [%sp + YOFF] - - ! save all fpu registers. - std %f0, [%sp+FPREGSOFF+(0*4)] - std %f2, [%sp+FPREGSOFF+(2*4)] - std %f4, [%sp+FPREGSOFF+(4*4)] - std %f6, [%sp+FPREGSOFF+(6*4)] - std %f8, [%sp+FPREGSOFF+(8*4)] - std %f10, [%sp+FPREGSOFF+(10*4)] - std %f12, [%sp+FPREGSOFF+(12*4)] - std %f14, [%sp+FPREGSOFF+(14*4)] - std %f16, [%sp+FPREGSOFF+(16*4)] - std %f18, [%sp+FPREGSOFF+(18*4)] - std %f20, [%sp+FPREGSOFF+(20*4)] - std %f22, [%sp+FPREGSOFF+(22*4)] - std %f24, [%sp+FPREGSOFF+(24*4)] - std %f26, [%sp+FPREGSOFF+(26*4)] - std %f28, [%sp+FPREGSOFF+(28*4)] - std %f30, [%sp+FPREGSOFF+(30*4)] - st %fsr, [%sp+FSROFF] ! save old fsr -1: - - ld [%sp+ORIGSIGNUMOFF], %o0! get signal number - set __sigfunc, %g1 ! get array of function ptrs - sll %o0, 2, %g2 ! scale signal number for index - ld [%g1+%g2], %g1 ! get func - ld [%sp+ORIGCODEOFF], %o1 ! get code - ! %o2 is already loaded with scp - add %sp, REGSAVEOFF, %o3 ! compute pointer to reg save area - st %o3, [%o2 + SC_G1] ! save in sc_g1. - call %g1 ! (*_sigfunc[sig])(sig,code,scp,addr) - ld [%sp+ORIGADDROFF], %o3 ! get addr - - ! Recompute scp, and drop into _sigreturn - ld [%sp+ORIGSCPOFF], %o0 ! get scp - - .global _sigreturn -_sigreturn: - ! Load g1 with addr of reg save area (from sc_g1) - ld [%o0+SC_G1], %g1 - - ! Move values we cannot restore directory into real sigcontext. - ld [%g1+IREGS_SAVE+(4*1)], %l0 ! g1 - ld [%g1+IREGS_SAVE+(4*8)], %l1 ! o0 - ld [%g1+IREGS_SAVE+(4*14)], %l2 ! sp - st %l0, [%o0+SC_G1] - st %l1, [%o0+SC_O0] - st %l2, [%o0+SC_SP] - - ld [%o0+SC_PSR], %l2 ! get psr - set PSR_EF, %l0 - ld [%g1+Y_SAVE], %l1 ! restore y - btst %l0, %l2 ! is FPU enabled? - bz 2f ! if not skip FPU restore - mov %l1, %y - - ldd [%g1+FPREGS_SAVE+(0*4)], %f0 ! restore all fpu registers. - ldd [%g1+FPREGS_SAVE+(2*4)], %f2 - ldd [%g1+FPREGS_SAVE+(4*4)], %f4 - ldd [%g1+FPREGS_SAVE+(6*4)], %f6 - ldd [%g1+FPREGS_SAVE+(8*4)], %f8 - ldd [%g1+FPREGS_SAVE+(10*4)], %f10 - ldd [%g1+FPREGS_SAVE+(12*4)], %f12 - ldd [%g1+FPREGS_SAVE+(14*4)], %f14 - ldd [%g1+FPREGS_SAVE+(16*4)], %f16 - ldd [%g1+FPREGS_SAVE+(18*4)], %f18 - ldd [%g1+FPREGS_SAVE+(20*4)], %f20 - ldd [%g1+FPREGS_SAVE+(22*4)], %f22 - ldd [%g1+FPREGS_SAVE+(24*4)], %f24 - ldd [%g1+FPREGS_SAVE+(26*4)], %f26 - ldd [%g1+FPREGS_SAVE+(28*4)], %f28 - ldd [%g1+FPREGS_SAVE+(30*4)], %f30 - ld [%g1+FSR_SAVE], %fsr ! restore old fsr -2: - - ! The locals and in are restored from the stack, so we have to put - ! them there. - ld [%o0+SC_SP], %o1 - ldd [%g1+IREGS_SAVE+(16*4)], %l0 - ldd [%g1+IREGS_SAVE+(18*4)], %l2 - ldd [%g1+IREGS_SAVE+(20*4)], %l4 - ldd [%g1+IREGS_SAVE+(22*4)], %l6 - ldd [%g1+IREGS_SAVE+(24*4)], %i0 - ldd [%g1+IREGS_SAVE+(26*4)], %i2 - ldd [%g1+IREGS_SAVE+(28*4)], %i4 - ldd [%g1+IREGS_SAVE+(30*4)], %i6 - std %l0, [%o1+(0*4)] - std %l2, [%o1+(2*4)] - std %l4, [%o1+(4*4)] - std %l6, [%o1+(6*4)] - std %i0, [%o1+(8*4)] - std %i2, [%o1+(10*4)] - std %i4, [%o1+(12*4)] - std %i6, [%o1+(14*4)] - - ! Restore the globals and outs. Do not restore %g1, %o0, or %sp - ! because they get restored from the sigcontext. - ldd [%g1+IREGS_SAVE+(2*4)], %g2 - ldd [%g1+IREGS_SAVE+(4*4)], %g4 - ldd [%g1+IREGS_SAVE+(6*4)], %g6 - ld [%g1+IREGS_SAVE+(9*4)], %o1 - ldd [%g1+IREGS_SAVE+(10*4)], %o2 - ldd [%g1+IREGS_SAVE+(12*4)], %o4 - ld [%g1+IREGS_SAVE+(15*4)], %o7 - - set 139, %g1 ! sigcleanup system call - t 0 - unimp 0 ! just in case it returns - /*NOTREACHED*/ - -#else /* SOLARIS */ .global save_context FUNCDEF(save_context) save_context: @@ -834,8 +557,6 @@ save_context: retl ! return from leaf routine nop SET_SIZE(save_context) - -#endif /* * Local variables: * tab-width: 8 View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/compare/822beed88eed7cbdd5e63e33…

1 0

[cmucl/cmucl][master] 2 commits: Remove old sunos stuff from sparc-assem.S
by Raymond Toy 10 Apr '15

10 Apr '15

Raymond Toy pushed to master at cmucl / cmucl Commits: 01777725 by Raymond Toy at 2015-01-17T10:16:39Z Remove old sunos stuff from sparc-assem.S We only support Solaris now so remove the old SunOS stuff. (Besides we haven't built for SunOS in decades.) * globals.h: * Solaris uses ELF, so don't prefix names with _. * sparc-assem.S: * Remove SunOS support. * Don't prefix names with _. - - - - - 419cdec6 by Raymond Toy at 2015-03-07T21:35:05Z Add clx-inspector contrib module. Submitted by Fred Gilham, who updated and enhanced the version from Bill Chiles, Christopher Hoover, and Skef Wholey. - - - - - 13 changed files: - + src/contrib/clx-inspector/clx-inspector.asd - + src/contrib/clx-inspector/clx-inspector.catalog - + src/contrib/clx-inspector/clx-inspector.lisp - + src/contrib/clx-inspector/compile-clx-inspector.lisp - + src/contrib/clx-inspector/inspect11-d.cursor - + src/contrib/clx-inspector/inspect11-d.mask - + src/contrib/clx-inspector/inspect11-s.cursor - + src/contrib/clx-inspector/inspect11-s.mask - + src/contrib/clx-inspector/inspect11.cursor - + src/contrib/clx-inspector/inspect11.mask - + src/contrib/clx-inspector/inspector.help - src/lisp/globals.h - src/lisp/sparc-assem.S Changes: ===================================== src/contrib/clx-inspector/clx-inspector.asd ===================================== --- /dev/null +++ b/src/contrib/clx-inspector/clx-inspector.asd @@ -0,0 +1,18 @@ +;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*- + +(in-package :asdf) + +(require :clx) + +(defsystem :clx-inspector + :name "INSPECT" + :author "Skef Wholey et. al." + :maintainer "Fred Gilham" + :license "Public Domain" + :description "Graphical Inspector" + :long-description "Inspector that uses pop-up windows to display the + objects. Updates the values of the objects in the background." + :components + ((:file "clx-inspector"))) + + ===================================== src/contrib/clx-inspector/clx-inspector.catalog ===================================== --- /dev/null +++ b/src/contrib/clx-inspector/clx-inspector.catalog @@ -0,0 +1,39 @@ +Name: + CLX Inspector. + +Package Name: + INSPECT + +Description: + Adds another inspector style as an alternative to the console + inspector. Inspecting objects pops up windows with the + contents of the object. The values of the object are updated + in the background. Multiple windows can be displayed at the + same time. + + +Author: + Original by Skef Wholey. Ported to CLX by Christopher Hoover + with "minor tweaks" by Bill Chiles. Updated and enhanced by + Fred Gilham. + +Net Address: + fred(a)sunbot.homedns.org + +Copyright Status: + CMUCL public domain code. No Warranty. + +Files: + clx-inspector.lisp + + +How to Get: + Comes with CMUCL contrib library. + +Portability: + Depends on CMUCL-specific features. + +Instructions: + (require :clx-inspector) + (inspect <object>) Once the window pops up, you can type "h" + to pop up a window of instructions. ===================================== src/contrib/clx-inspector/clx-inspector.lisp ===================================== --- /dev/null +++ b/src/contrib/clx-inspector/clx-inspector.lisp @@ -0,0 +1,2214 @@ +;;; -*- Mode: Lisp; Package: INSPECT; Log:code.log -*- +;;; +;;; ********************************************************************** +;;; This code was written as part of the CMU Common Lisp project at +;;; Carnegie Mellon University, and has been placed in the public domain. +;;; If you want to use this code or any part of CMU Common Lisp, please contact +;;; Scott Fahlman or slisp-group(a)cs.cmu.edu. +;;; +#+cmu +(ext:file-comment + "$Header: clx-inspector.lisp,v 1.1 2004/03/12 10:02:30 fmg $") +;;; +;;; ********************************************************************** +;;; +;;; An inspector for CMU Common Lisp. +;;; +;;; Written by Skef Wholey. +;;; Ported to CLX by Christopher Hoover with minor tweaks by Bill Chiles. +;;; +;;; Each Lisp object is displayed in its own X window, and components +;;; of each object are "mouse sensitive" items that may be selected +;;; for further investigation. +;;; +;;; Some cleanup by FMG plus adding dynamic updating of values when +;;; multiprocessing is present. (2000-2002) +;;; +;;; Converted former "home-made object system" to CLOS. FMG Oct 2002. +;;; +;;; Fix inability to deal with circular lists. Paper over problem with +;;; PCL and uninitialized slots. FMG March 2004. +;;; +;;; Cleanup and minor fixes. FMG 2015. Haha.. ten years.. still works.... +;;; Add scroll wheel support. FMG 2015. + +(declaim (optimize (speed 2) (safety 3) (debug 3) (space 1.5) (ext:inhibit-warnings 3))) + +(eval-when (:compile-toplevel :load-toplevel :execute) + (provide :clx-inspector)) + +(eval-when (:compile-toplevel :load-toplevel :execute) + (setf lisp::*enable-package-locked-errors* nil)) + +(in-package "COMMON-LISP-USER") + +(eval-when (:compile-toplevel :load-toplevel :execute) + (require :clx #+cmu "library:subsystems/clx-library")) + +(defpackage "INSPECT" + (:use "COMMON-LISP" "LISP" "EXTENSIONS" "KERNEL") + (:export inspect show-object remove-object-display remove-all-displays *interface-style*)) + +(in-package "INSPECT") + + +;;;; Parameters and stuff. + +(defvar *inspect-result*) + +(defparameter *update-interval* .5 + "Seconds between item window background updates.") + +;;; CLX specials + +(defvar *display* nil) +(defvar *screen* nil) +(defvar *root* nil) +(defvar *gcontext* nil) +(defvar *black-pixel* nil) +(defvar *white-pixel* nil) + +;; Inspect-Length is the number of components that will be displayed in a +;; window at any one time. If an object has more than Inspect-Length +;; components, we generally put it in a scrolling window. Inspect-Level +;; might someday correspond to Print-Level, controlling the amount of +;; detail and mouse-sensitivity we get inside components, but for now +;; it's ignored. +(defparameter inspect-length 30) +(defparameter inspect-level 1) + +;; Inspect-Print-Level and Inspect-Print-Length are used by +;; IPrin1-To-String to generate the textual representation of +;; components. +(defparameter inspect-print-length 10) +(defparameter inspect-print-level 3) + + +;; The handler-case is an easy way to handle unbound slots. From what +;; previous versions said, using slot-boundp didn't always work. +(defun iprin1-to-string (object) + (let ((*print-length* inspect-print-length) + (*print-level* inspect-print-level) + (*print-pretty* nil)) + + (handler-case (prin1-to-string object) + (unbound-slot () "Unbound")))) + + +;;;; Setting up fonts and cursors and stuff. + +;; We use Font structures to keep stuff like the character height and +;; width of a font around for quick and easy size calculations. For +;; variable width fonts, the Width slot will be Nil. + +(defstruct (font (:constructor make-font (name font height ascent width))) + name + font + height + ascent + width) + +;; The *Header-Font* is a big font usually used for displaying stuff +;; in the header portion of an object view. *Entry-Font* is used as +;; the main "body font" for an object, and *Italic-Font* is used for +;; special stuff. + +;; You can go crazy with fonts here. +;;(defparameter header-font-name "*-*-bold-r-*-sans-14-*-*") +(defparameter header-font-name "-adobe-helvetica-bold-r-*-*-14-*-*") +(defvar *header-font*) + +;; XXX You must use a fixed-width font here. Variable-width fonts +;; cause the tracking to fail miserably. +(defparameter entry-font-name "*-courier-medium-r-normal--12-*-*") +(defvar *entry-font*) + +;; XXX Better to use a fixed-width font here --- a variable-width font +;; tends to result in bits and pieces of letters getting chopped off. +(defparameter italic-font-name "*-courier-medium-o-normal--12-*-*") +(defvar *italic-font*) + +;; The *Cursor* is a normal arrow thing used most of the time. During +;; modification operations, we change the cursor to *Cursor-D* (while +;; the destination for the modification is being chosen) and +;; *Cursor-S* (while the source is being chosen). + +(defparameter cursor-name "library:contrib/clx-inspector/inspect11.cursor") +(defvar *cursor*) +(defparameter cursor-d-name "library:contrib/clx-inspector/inspect11-d.cursor") +(defvar *cursor-d*) +(defparameter cursor-s-name "library:contrib/clx-inspector/inspect11-s.cursor") +(defvar *cursor-s*) + +;; This file contains the help message for the inspector. The text in +;; the file must not extend past the 72nd column, and any initial +;; whitespace on a line must be built on the space character only. The +;; window that displays this text is too small in height for easy +;; reading of this text. +(defparameter help-file-pathname "library:contrib/clx-inspector/inspector.help") + + +;;;; CLX stuff + +;; Max-Window-Width is used to constrain the width of our views. + +(declaim (fixnum max-window-width)) +(defparameter max-window-width 1000) + +;; Border is the number of pixels between an object view and the box +;; we draw around it. VSP is the number of pixels we leave between +;; lines of text. (We should put VSP in the fonts structure sometime +;; so we can have font-specific vertical spacing.) + +(defparameter border 3) +(defparameter vsp 2) + +;; The arrow bitmaps are used inside scrollbars. + +(defvar *up-arrow*) +(defvar *down-arrow*) +(defvar *up-arrow-i*) +(defvar *down-arrow-i*) + +(defparameter arrow-bits + '(#*0000000000000000 + #*0111111111111110 + #*0100000000000010 + #*0100000110000010 + #*0100001111000010 + #*0100011111100010 + #*0100111111110010 + #*0101111111111010 + #*0100001111000010 + #*0100001111000010 + #*0100001111000010 + #*0100001111000010 + #*0100001111000010 + #*0100000000000010 + #*0111111111111110 + #*0000000000000000)) + + +;; Font and cursor support + +(defun open-font (name) + (let* ((font (xlib:open-font *display* name)) + (max-width (xlib:max-char-width font)) + (min-width (xlib:min-char-width font)) + (width (if (= max-width min-width) max-width nil)) + (ascent (xlib:max-char-ascent font)) + (height (+ (xlib:max-char-descent font) ascent))) + (make-font name font height ascent width))) + +(defun get-cursor-pixmap-from-file (name) + (let ((pathname (probe-file name))) + (if pathname + (let* ((image (xlib:read-bitmap-file pathname)) + (pixmap (xlib:create-pixmap :width 16 :height 16 + :depth 1 :drawable *root*)) + (gc (xlib:create-gcontext :drawable pixmap + :function boole-1 + :foreground *black-pixel* + :background *white-pixel*))) + (xlib:put-image pixmap gc image :x 0 :y 0 :width 16 :height 16) + (xlib:free-gcontext gc) + (values pixmap (xlib:image-x-hot image) (xlib:image-y-hot image))) + (values nil nil nil)))) + +(defun open-cursor (name) + (multiple-value-bind + (cursor-pixmap cursor-x-hot cursor-y-hot) + (get-cursor-pixmap-from-file name) + (multiple-value-bind + (mask-pixmap mask-x-hot mask-y-hot) + (get-cursor-pixmap-from-file (make-pathname :type "mask" :defaults name)) + (declare (ignore mask-x-hot mask-y-hot)) + (let* ((white (xlib:make-color :red 1.0 :green 1.0 :blue 1.0)) + (black (xlib:make-color :red 0.0 :green 0.0 :blue 0.0)) + (cursor (xlib:create-cursor :source cursor-pixmap :mask mask-pixmap + :x cursor-x-hot :y cursor-y-hot + :foreground black :background white))) + (xlib:free-pixmap mask-pixmap) + (xlib:free-pixmap cursor-pixmap) + cursor)))) + +(defun bitvec-list-to-pixmap (bvl width height) + (let* ((image (apply #'xlib:bitmap-image bvl)) + (pixmap (xlib:create-pixmap :width width :height height + :drawable *root* + :depth (xlib:screen-root-depth *screen*))) + (gc (xlib:create-gcontext :drawable pixmap + :function boole-1 + :foreground *black-pixel* + :background *white-pixel*))) + (xlib:put-image pixmap gc image :x 0 :y 0 :width 16 :height 16 :bitmap-p t) + (xlib:free-gcontext gc) + pixmap)) + +(defun invert-pixmap (pixmap) + (let* ((width (xlib:drawable-width pixmap)) + (height (xlib:drawable-height pixmap)) + (inv-pixmap (xlib:create-pixmap :width width :height height + :drawable *root* + :depth (xlib:screen-root-depth *screen*))) + (gc (xlib:create-gcontext :drawable inv-pixmap + :function boole-c1 + :foreground *black-pixel* + :background *white-pixel*))) + (xlib:copy-area pixmap gc 0 0 width height inv-pixmap 0 0) + (xlib:free-gcontext gc) + inv-pixmap)) + +;;; Draw-Bitmap, Draw-Box, and Draw-Block --- thin wrapper over X +;;; drawing primitives. + +(defun draw-bitmap (window x y pixmap) + (xlib:copy-area pixmap *gcontext* 0 0 16 16 window x y)) + +(defun draw-box (window x1 y1 x2 y2) + (declare (fixnum x1 y1 x2 y2)) + (xlib:draw-rectangle window *gcontext* x1 y1 (- x2 x1) (- y2 y1))) + +(defun draw-block (window x1 y1 x2 y2) + (declare (fixnum x1 y1 x2 y2)) + (xlib:draw-rectangle window *gcontext* x1 y1 (- x2 x1) (- y2 y1) t)) + +;;; *X-Constraint* is used by Disp-String to truncate long strings so that +;;; they stay inside windows of reasonable width. + +(defvar *x-constraint* nil) + +;;; Disp-String draws a string in an X window, trying to constrain it +;;; to not run beyond the *X-Constraint*. For variable width fonts, +;;; we can only guess about the right length... + +(defun disp-string (window x y string disp-font) + (declare (simple-string string)) + (let ((font (font-font disp-font)) + (font-width (font-width disp-font)) + (font-height (font-height disp-font)) + (length (length string)) + (max-width (if *x-constraint* (- *x-constraint* x) max-window-width))) + (cond (font-width + ;; fixed width font + (let ((end (if (<= (* length font-width) max-width) + length + (max 0 (truncate max-width font-width))))) + (when window + (xlib:with-gcontext (*gcontext* :font font) + (xlib:draw-image-glyphs window *gcontext* + x (+ y (font-ascent disp-font)) + string :end end))) + (values (* end font-width) (+ font-height vsp)))) + (t + ;; this is hackish... + (multiple-value-bind (end width) + (do* ((index length (1- index)) + (width (xlib:text-width font string :end index) + (xlib:text-width font string :end index))) + ((or (= index 0) (<= width max-width)) + (values index width))) + (when window + (xlib:with-gcontext (*gcontext* :font font) + (xlib:draw-image-glyphs window *gcontext* + x (+ y (font-ascent disp-font)) + string :end end))) + (values width (+ font-height vsp))))))) + + + +;;;; Inspect-Init + +;;; Inspect-Init sets all this stuff up, using *Inspect-Initialized* to +;;; know when it's already been done. + +(defvar *inspect-initialized* nil) + +(defun inspect-init () + (unless *inspect-initialized* + + (multiple-value-setq (*display* *screen*) (ext:open-clx-display)) + (ext:carefully-add-font-paths + *display* + (mapcar #'(lambda (x) + (concatenate 'string (namestring x) "fonts/")) + (ext:search-list "library:"))) + (setq *root* (xlib:screen-root *screen*)) + (setq *black-pixel* (xlib:screen-black-pixel *screen*)) + (setq *white-pixel* (xlib:screen-white-pixel *screen*)) + (setq *gcontext* (xlib:create-gcontext :drawable *root* :function boole-1 + :foreground *black-pixel* + :background *white-pixel*)) + (setq *cursor* (open-cursor cursor-name)) + (setq *cursor-d* (open-cursor cursor-d-name)) + (setq *cursor-s* (open-cursor cursor-s-name)) + (setq *header-font* (open-font header-font-name)) + (setq *entry-font* (open-font entry-font-name)) + (setq *italic-font* (open-font italic-font-name)) + (setq *up-arrow* (bitvec-list-to-pixmap arrow-bits 16 16)) + (setq *up-arrow-i* (invert-pixmap *up-arrow*)) + (setq *down-arrow* (bitvec-list-to-pixmap (reverse arrow-bits) 16 16)) + (setq *down-arrow-i* (invert-pixmap *down-arrow*)) + (ext:enable-clx-event-handling *display* 'inspector-event-handler) + (setq *inspect-initialized* t))) + +#| +;;; For debugging... +;;; +(defun inspect-reinit (&optional (host "unix:0.0")) + (let ((win nil)) + (setq *inspect-initialized* nil) + (when *display* + (ext:disable-clx-event-handling *display*) + (xlib:close-display *display*))) + (unwind-protect + (progn + (multiple-value-setq + (*display* *screen*) + (ext:open-clx-display host)) + (setf (xlib:display-after-function *display*) + #'xlib:display-finish-output) + (setq *root* (xlib:screen-root *screen*)) + (setq *black-pixel* (xlib:screen-black-pixel *screen*)) + (setq *white-pixel* (xlib:screen-white-pixel *screen*)) + (setq *gcontext* (xlib:create-gcontext :drawable *root* + :function boole-1 + :foreground *black-pixel* + :background *white-pixel*)) + (setq *cursor* (open-cursor cursor-name)) + (setq *cursor-d* (open-cursor cursor-d-name)) + (setq *cursor-s* (open-cursor cursor-s-name)) + (setq *header-font* (open-font header-font-name)) + (setq *entry-font* (open-font entry-font-name)) + (setq *italic-font* (open-font italic-font-name)) + (setq *up-arrow* (bitvec-list-to-pixmap arrow-bits 16 16)) + (setq *up-arrow-i* (invert-pixmap *up-arrow*)) + (setq *down-arrow* (bitvec-list-to-pixmap (reverse arrow-bits) 16 16)) + (setq *down-arrow-i* (invert-pixmap *down-arrow*)) + (setf (xlib:display-after-function *display*) nil) + (setf win t)) + (cond (win + (ext:enable-clx-event-handling *display* 'inspector-event-handler) + (setq *inspect-initialized* t)) + (*display* + (xlib:close-display *display*)))))) +|# + + +;;;; Mid-level interface between inspector and window system. + +(defclass view () + ((name :initarg :name :accessor name) + (object :initarg :object :accessor object) + (view-item :initarg :view-item :accessor view-item) + (window :initarg :window :accessor window) + #+:mp (update-process :initarg :update-process :accessor update-process :initform nil) + (stack :initarg :stack :accessor stack :initform nil)) + (:documentation "We use view classes to associate objects with their +graphical images (View-Items, see below), the X windows that they're +displayed in, and maybe even a user-supplied Name for the whole +thing.")) + +#+:mp +(defun make-view (name object view-item window) + (let* ((new-view (make-instance 'view + :name name + :object object + :view-item view-item + :window window))) + ;; Create a background process to update the view once per second. + (setf (update-process new-view) + (mp:make-process + #'(lambda () + (loop + (update-view-of-object new-view) + (sleep *update-interval*))) + :name (format nil "Background update process for ~A" name))) + new-view)) + +#-:mp +(defun make-view (name object view-item window) + (make-instance 'view + :name name + :object object + :view-item view-item + :window window)) + + +;;; *views* is a list of all the live views of objects. +;;; +(defvar *views* nil) + +;;; CLX window to view object mapping. +;;; +(defvar *windows-to-views* (make-hash-table :test #'eq)) + +(defun add-window-view-mapping (window view) + (setf (gethash window *windows-to-views*) view)) + +(defun delete-window-view-mapping (window) + (remhash window *windows-to-views*)) + +(defun map-window-to-view (window) + (multiple-value-bind (view found-p) + (gethash window *windows-to-views*) + (unless found-p (error "No such window as ~S in mapping!" window)) + view)) + +;; *Tracking-Mode* is a kind of hack used so things know what to do +;; during modify operations. If it's :Source, only objects that are +;; really there will be selectable. If it's :Destination, objects that +;; aren't necessarily really there (like the values of unbound +;; symbols) will be selectable. +(declaim (type (member '(:source :destination) *tracking-mode*))) +(defvar *tracking-mode* :source) + +;; *Mouse-X* and *Mouse-Y* are a good approximation of where the mouse +;; is in the window that the mouse is in. + +(declaim (fixnum *mouse-x* *mouse-y*)) +(defvar *mouse-x* 0) +(defvar *mouse-y* 0) + + +;;;; Event Handling for CLX. Translates events in X windows to +;;;; commands operating on views. + +;; We're interested in these events: + +(eval-when (:compile-toplevel :load-toplevel :execute) + (defconstant important-xevents + '(:key-press :button-press :exposure :pointer-motion + :enter-window :leave-window #+notready :structure-notify)) + + (defconstant important-xevents-mask + (apply #'xlib:make-event-mask important-xevents))) + + +;; We need to add some mouse key translations to handle the scroll +;; wheel. XXX These should be in CMUCL, not here. + +(ext:define-mouse-keysym 4 25607 "Scrollupdown" "Super" :button-press) +(ext:define-mouse-keysym 4 25608 "Scrollupup" "Super" :button-release) + +(ext:define-mouse-keysym 5 25609 "Scrolldowndown" "Super" :button-press) +(ext:define-mouse-keysym 5 25610 "Scrolldownup" "Super" :button-release) + + +(defun inspector-event-handler (display) + (xlib:event-case (display :discard-p t :force-output-p t :timeout .1) + ((:exposure) (event-window count) + (when (zerop (the fixnum count)) + (redisplay-item + (view-item (map-window-to-view event-window)))) + t) + ((:key-press) (event-window state code) + (do-command (map-window-to-view event-window) + (ext:translate-key-event display code state)) + t) + ((:button-press :button-release) (event-key event-window state code) + (do-command (map-window-to-view event-window) + (ext:translate-mouse-key-event code state event-key)) + t) + ((:enter-notify :motion-notify) (event-window x y) + (cond ((xlib:event-listen display) + ;; if there are other things in the queue, blow this event off... + nil) + (t + ;; This is the alternative to the background update + ;; process. When the mouse enters the window, its values + ;; get updated. + #-:mp (update-view-of-object (map-window-to-view event-window)) + (setf *mouse-x* x) + (setf *mouse-y* y) + (tracker (view-item (map-window-to-view event-window)) x y) + t))) + ((:leave-notify) (event-window) + (tracker (view-item (map-window-to-view event-window)) -1 -1) + t) + + ((:no-exposure) () + ;; just ignore this one + t) + ((:client-message) (event-window display data) + ;; User used the window manager to close a window. + (when (eq (xlib:atom-name display (aref data 0)) :wm_delete_window) + ;; Make the program think the user hit the "D" key in the event + ;; window. + (do-command (map-window-to-view event-window) #k"D")) + t) + (t (event-key) + (format t "Inspector received unexpected event, ~S, recieved." event-key) + t))) + +#| + +;;; Some debugging code... + + (xlib:event-cond (display :timeout 0 :peek-p t) + (t (event-key) + (unless (eq event-key :motion-notify) + (format t "Event received: ~S~%" event-key)))) + +(defun discard-event-on-window (display window type) + (loop + (unless (xlib:process-event display :timeout 0 + :handler #'(lambda (&key event-window event-type &allow-other-keys) + (and (eq event-window window) + (eq event-type type)))) + (return)))) + +|# + + +;;;; More stuff that interfaces between X and the view stuff. + +;; NEXT-WINDOW-POSITION currently uses a very dumb heuristic to decide +;; where the next inspector window ought to go. If there aren't any +;; windows, it puts the view of an object in the upper left hand +;; corner. Otherwise, it'll put it underneath the last one created. +;; When putting the new window below the last one, if it should extend +;; below the bottom of the screen, we position it to just fit on the +;; bottom. Thus, all future windows created in this fashion will "pile +;; up" on the bottom of the screen. +;; +(defun next-window-position (width height) + (declare (ignore width)) + (if *views* + (let ((window (window (car *views*)))) + (xlib:with-state (window) + (let ((drawable-x (xlib:drawable-x window)) + (drawable-y (xlib:drawable-y window)) + (drawable-height (xlib:drawable-height window)) + (border-width (xlib:drawable-border-width window))) + (declare (fixnum drawable-y drawable-height border-width)) + (multiple-value-bind (children parent root) (xlib:query-tree window) + (declare (ignore children)) + (let ((root-height (xlib:drawable-height root))) + (declare (fixnum root-height)) + (multiple-value-bind + (new-x new-y) + (if (eq parent root) + (values drawable-x (+ drawable-y drawable-height + (* 2 border-width))) + ;; Deal with reparented windows... + (multiple-value-bind (root-x root-y) + (xlib:translate-coordinates + parent drawable-x drawable-y root) + (declare (fixnum root-y)) + (values root-x (+ root-y drawable-height + (* 2 border-width))))) + (declare (fixnum new-y)) + (values new-x + (if (> (+ new-y height border-width) root-height) + (- root-height height border-width) + new-y)))))))) + (values 200 20))) + + +;;;; View-Item. A view item is the object that contains the actual +;;;; underlying object being inspected as well as the window being +;;;; used to display it and some other information about the window. + +(defclass view-item () + ((window :initarg :window :accessor window) + (x :initarg :x :accessor x) + (y :initarg :y :accessor y) + (width :initarg :width :accessor width) + (height :initarg :height :accessor height)) + (:documentation "View-Items are objects with methods to display +themselves, track the mouse inside their boundries, handle mouse +clicks on themselves, and so on. Everything we put up on the screen is +backed in some way by a View-Item. These are the components of the +total view of an object as described in a view object.")) + +(defmethod print-object ((item view-item) stream) + (format stream "#<~S {~8,'0X}>" (type-of item) + (kernel:get-lisp-obj-address item))) + +(defgeneric view-item-p (item) + (:method ((item t)) + nil) + (:method ((item view-item)) + t)) + +;; The following generic functions constitute the interface to the +;; view-item objects. Subclasses of view-item implement behavior by +;; overriding these methods. + +(defgeneric display (item window x y)) + +(defgeneric tracker (item x y) + (:method ((item view-item) x y) + (update-current-item item x y))) + +(defgeneric untracker (item) + (:method ((item view-item)) + nil)) + +(defgeneric mouse-handler (item view key-event) + (:method ((item view-item) view key-event) + (declare (ignore view key-event)) + nil)) + +(defgeneric walker (item function) + (:method ((item view-item) function) + (declare (ignore function)) + nil)) + + +;;;; The following are functions that apply to all view-items. + +;; The *Current-Item* is the view item that is currently under the +;; mouse, to the best of our knowledge, or Nil if the mouse isn't over +;; an item that does anything with its Tracker method. + +(defvar *current-item* nil) + +;; Display-Item invokes the Display method of an item to put it up on +;; the specified window. The window, position, and size are all set, +;; and the size is returned. + +(defun display-item (item window x y) + (setf (window item) window + (x item) x + (y item) y) + (multiple-value-bind (width height) + (display item window x y) + (setf (width item) width) + (setf (height item) height) + (values width height))) + +;; Redisplay-Item redraws an item (if, say, it's changed, or if its +;; window has received an exposure event). If the item is the +;; *Current-Item*, we call its tracker method to make sure it gets +;; highlighted if it's supposed to be. + +(defun redisplay-item (item) + (when (window item) + (xlib:clear-area (window item) + :x (x item) :y (y item) + :width (width item) + :height (height item)) + (multiple-value-bind (width height) + (display item (window item) (x item) (y item)) + (setf (width item) width) + (setf (height item) height)) + (xlib:display-force-output *display*) + (when (and *current-item* + (eq (window *current-item*) + (window item))) + (tracker *current-item* *mouse-x* *mouse-y*)))) + +;; Size-Item uses the Display method to calculate the size of an item +;; once displayed. If the window supplied to View-Item is Nil, all the +;; size calculation will get done, but no graphical output will +;; happen. + +(defun size-item (item) + (if (slot-boundp item 'width) + (values (width item) (height item)) + (display-item item nil 0 0))) + + +;;;; Tracking and untracking. + +;; Update-Current-Item is used by trackers to figure out if an item is +;; really under the mouse. If it is, and it's not the same as the +;; *Current-Item*, the *Current-Item* gets untracked. If the mouse is +;; inside the current item, Update-Current-Item returns T. + +(defun update-current-item (item x0 y0) + (let ((old-current *current-item*)) + (with-slots (x y width height) item + (if (and (<= x x0 (+ x width)) + (<= y y0 (+ y height))) + (setq *current-item* item) + (setq *current-item* nil)) + (when (and old-current (not (eq *current-item* old-current))) + (untracker old-current))) + (eq item *current-item*))) + +;; The Boxifying-Tracker and Boxifying-Untracker highlight and +;; unhighlight an item by drawing or erasing a box around the object. + +(defun boxifying-tracker (item x y) + (when (update-current-item item x y) + (boxify-item item boole-1))) + +(defun boxifying-untracker (item) + (boxify-item item boole-c1)) + +(defun boxify-item (item function) + (when (view-item-p item) + (with-slots (x y width height window) item + (xlib:with-gcontext (*gcontext* :function function) + (xlib:draw-rectangle window *gcontext* (1- x) y (1+ width) (- height 2))) + (xlib:display-force-output *display*)))) + +;; Track-In-List tries to track inside of each item in the List. + +(defun track-in-list (list x0 y0) + (dolist (item list) + (when (view-item-p item) + (with-slots (x y width height) item + (when (and (<= x x0 (+ x width)) + (<= y y0 (+ y height))) + (tracker item x0 y0) + (return-from track-in-list nil))))) + (when *current-item* + (untracker *current-item*) + (setq *current-item* nil))) + + +;;;; Specialized View-Item definitions. + +(defclass inspection-item (view-item) + ((objects :initarg :objects :accessor objects) ; Objects being inspected (for decaching) + (headers :initarg :headers :accessor headers) ; List of items in header, may be Nil + (entries :initarg :entries :accessor entries)) ; List of items below header + (:documentation "Inspection-Items are used as the `top-level' items +in the display of an object. They've got a list of header items and a +list of entry items.")) + +(defun make-inspection-item (objects headers entries) + (make-instance 'inspection-item :objects objects :headers headers :entries entries)) + +;; Inspection item methods + +(defmethod display ((item inspection-item) window x0 y0) + (let ((y (+ y0 border)) + (x (+ x0 border)) + (max-width 0) + (max-x 0) + (first-entry-y nil) + (header-end-y nil) + (sb (when (scrolling-inspection-item-p item) + (scrollbar item)))) + (when sb + (funcall (reset-index sb) sb)) + ;; First, header items. + (when (headers item) + (dolist (element (headers item)) + (multiple-value-bind (width height) + (display-item element window x y) + (incf y height) + (setq max-width (max max-width width)))) + (setq header-end-y y) + (incf y vsp)) + (when sb + (incf x (+ 16 border)) + (funcall (reset-index sb) sb)) + ;; Then do entry items. + (let ((max-name-width 0)) + (setq first-entry-y y) + ;; Figure out width of widest entry slot name. + (dolist (element (entries item)) + (when (slot-item-p element) + (setq max-name-width + (max max-name-width (length (name element)))))) + (dolist (element (entries item)) + (when (slot-item-p element) + (unless (slot-boundp element 'max-name-width) + (setf (max-name-width element) max-name-width))) + (multiple-value-bind (width height) + (display-item element window x y) + (incf y height) + (setq max-width (max max-width (+ width (if sb (+ 16 border) 0))))))) + (setq max-x (+ x0 border max-width border)) + ;; Display scrollbar, if any. + (when sb + (setf (bottom sb) y) + (display-item sb window (+ x0 border) first-entry-y) + (unless (slot-boundp sb 'window-width) + (setf (window-width sb) (- max-width 16 border)))) + ;; Finally, draw a box around the whole thing. + (when window + (draw-box window x0 y0 max-x y) + (when header-end-y + (xlib:draw-line window *gcontext* x0 header-end-y max-x header-end-y))) + ;; And return size. + (values (- max-x x0) (- (+ y border) y0)))) + +(defmethod tracker ((inspection-item inspection-item) x0 y0) + (dolist (item (headers inspection-item)) + (with-slots (x y width height) item + (when (and (<= x x0 (+ x width)) + (<= y y0 (+ y height))) + (tracker item x0 y0) + (return-from tracker nil)))) + (track-in-list (entries inspection-item) x0 y0)) + +(defmethod walker ((item inspection-item) function) + (flet ((walk-item-list (list function) + (dolist (item list) + (walker item function)))) + (with-slots (x width) item + (let ((*x-constraint* (if (slot-boundp item 'width) + (+ x width (- border)) + max-window-width))) + (walk-item-list (headers item) function) + (walk-item-list (entries item) function))))) + + +(defclass scrolling-inspection-item (inspection-item) + ((scrollbar :initarg :scrollbar :accessor scrollbar) ; Scrollbar display item + (set-next :initarg :set-next :accessor set-next) ; To set next state + (next :initarg :next :accessor next)) ; To get & increment next state + (:documentation "Scrolling-Inspection-Items are used as the +'top-level' of display of objects that have lots of components and so +have to scroll. In addition to headers and entries, they've got a +scrollbar item and stuff so that the entries can lazily compute where +they are and what they should display.")) + +(defun make-scrolling-inspection-item (objects headers entries scrollbar) + (make-instance 'scrolling-inspection-item + :objects objects + :headers headers + :entries entries + :scrollbar scrollbar)) + +(defgeneric scrolling-inspection-item-p (item) + (:method ((item t)) + nil) + (:method ((item scrolling-inspection-item)) + t)) + +;; Scrolling-inspection-item methods. + +(defmethod tracker ((item scrolling-inspection-item) x0 y0) + (dolist (element (headers item)) + (with-slots (x y height width) element + (when (and (<= x x0 (+ x width)) + (<= y y0 (+ y height))) + (tracker element x0 y0) + (return-from tracker nil)))) + (let ((sb (scrollbar item))) + (with-slots (x y width height) sb + (if (and (<= x x0 (+ x width)) + (<= y y0 (+ y height))) + (tracker sb x0 y0) + (track-in-list (entries item) x0 y0))))) + + + +(defclass scrollbar (view-item) + ((scrollee :initarg :scrollee :accessor scrollee) ; Item for which this guy's a scrollbar + (bottom :initarg bottom :accessor bottom) ; Y coordinate of end (hack, hack) + (active-button :initarg :active-button :accessor active-button :initform nil) + (first-index :initarg :first-index :accessor first-index) ; Index of first thing to + ; be displayed + (next-element :initarg :next-element :accessor next-element) ; Function to extract next + ; element to be displayed + (reset-index :initarg :reset-index :accessor reset-index) ; Function to reset internal + ; index for next-element + (window-width :initarg :window-width :accessor window-width) ; Max X for scrollees + (bar-height :initarg :bar-height :accessor bar-height) ; Height of bar in pixels + (bar-top :initarg :bar-top :accessor bar-top) + (bar-bottom :initarg :bar-bottom :accessor bar-bottom) + (num-elements :initarg :num-elements :accessor num-elements) ; Number of elements in scrollee + (num-elements-displayed :initarg :num-elements-displayed + :accessor num-elements-displayed )) ; Number of elements displayed + ; at once + (:documentation "A Scrollbar has buttons and a thumb bar and the +stuff it needs to figure out whatever it needs to figure out.")) + +(defun make-scrollbar (first-index num-elements num-elements-displayed + next-element reset-index) + (make-instance 'scrollbar + :first-index first-index :num-elements num-elements + :num-elements-displayed num-elements-displayed + :next-element next-element :reset-index reset-index)) + +;;; Scrollbar methods. + +;; Yeah, we use a hard-wired constant 16 here, which is the width and +;; height of the buttons. Grody, yeah, but hey, "16" is only two +;; keystrokes... + +(defmethod display ((scrollbar scrollbar) window x y) + (with-slots (active-button bottom bar-bottom bar-top bar-height + first-index num-elements num-elements-displayed) + scrollbar + (when window + (draw-bitmap window x y + (if (eq active-button :top) + *up-arrow-i* *up-arrow*)) + (draw-bitmap window x (- bottom 16) + (if (eq active-button :bottom) + *down-arrow-i* *down-arrow*)) + (draw-box window x (+ y 16) (+ x 15) (- bottom 17)) + (setf bar-top (+ y 17) + bar-bottom (- bottom 17) + bar-height (- bar-bottom bar-top)) + (draw-block window x + (+ bar-top (truncate (* first-index bar-height) num-elements)) + (+ x 16) + (- bar-bottom + (truncate (* (- num-elements (+ first-index num-elements-displayed)) + bar-height) + num-elements))) + (xlib:display-force-output *display*)) + (values 16 (- bottom y)))) + +(defmethod tracker ((scrollbar scrollbar) x0 y0) + (with-slots (active-button window x y bottom) scrollbar + (update-current-item scrollbar x0 y0) + (cond ((<= y y0 (+ y 16)) + (setf active-button :top) + (draw-bitmap window x y *up-arrow-i*)) + ((<= (- bottom 16) y0 bottom) + (setf active-button :bottom) + (draw-bitmap window x (- bottom 16) *down-arrow-i*)) + (t + (untracker scrollbar))) + (xlib:display-force-output *display*))) + +(defmethod untracker ((scrollbar scrollbar)) + (with-slots (active-button window x y bottom) scrollbar + (cond ((eq active-button :top) + (draw-bitmap window x y *up-arrow*)) + ((eq active-button :bottom) + (draw-bitmap window x (- bottom 16) *down-arrow*))) + (xlib:display-force-output *display*) + (setf active-button nil))) + +(defmethod mouse-handler ((scrollbar scrollbar) view key-event) + (declare (ignore view)) + (with-slots (first-index active-button num-elements num-elements-displayed + bar-top bar-bottom bar-height scrollee) + scrollbar + (let* ((old-first first-index) + (new-first old-first)) + (cond ((or (eq key-event #k"Scrolldowndown") + (eq active-button :bottom)) + (incf new-first + (if (eq key-event #k"Rightdown") + num-elements-displayed + 1))) + ((or (eq key-event #k"Scrollupdown") + (eq active-button :top)) + (decf new-first + (if (eq key-event #k"Rightdown") + num-elements-displayed + 1))) + ((<= bar-top *mouse-y* bar-bottom) + (setq new-first + (truncate (* (- *mouse-y* bar-top) + num-elements) + bar-height)))) + (setq new-first (max new-first 0)) + (setq new-first (min new-first (- num-elements num-elements-displayed))) + (unless (= new-first old-first) + (setf first-index new-first) + (funcall (reset-index scrollbar) scrollbar) + (dolist (element (entries scrollee)) + (redisplay-item element)) + (redisplay-item scrollbar))))) + + +(defclass scrolling-item (view-item) + ((scrollbar :initarg :scrollbar :accessor scrollbar) + (item :initarg :item :accessor item)) + (:documentation "Scrolling-Items are used as the entries in +Scrolling-Inspection-Items. They know the scrollbar that moves them +around so they can lazily do their stuff.")) + +(defun make-scrolling-item (scrollbar item) + (make-instance 'scrolling-item :scrollbar scrollbar :item item)) + +;; Scrolling item methods. + +(defmethod display ((item scrolling-item) window x y) + (with-slots (scrollbar item) item + (funcall (next-element scrollbar) item) + (let ((*x-constraint* (if (slot-boundp scrollbar 'window-width) + (+ (window-width scrollbar) x) + max-window-width))) + (multiple-value-bind (width height) (display item window x y) + (values + (or (and (slot-boundp scrollbar 'window-width) + (window-width scrollbar)) + width) + height))))) + +(defmethod tracker :before ((scrolling-item scrolling-item) x y) + (update-current-item scrolling-item x y)) + +(defmethod tracker ((scrolling-item scrolling-item) x y) + (tracker (item scrolling-item) x y)) + +(defmethod walker ((scrolling-item scrolling-item) function) + (walker (item scrolling-item) function)) + + +(defclass string-item (view-item) + ((item-string :initarg :item-string :accessor item-string) ; String to be displayed + (font :initarg :font :accessor font)) ; Font in which to display it + (:documentation "String-Items just have a string of text and a font +that it gets displayed in.")) + +(defun make-string-item (string &optional (font *entry-font*)) + (make-instance 'string-item :item-string string :font font)) + +;;; String item method. + +(defmethod display ((item string-item) window x y) + (disp-string window x y (item-string item) (font item))) + + +(defclass slot-item (view-item) + ((name :initarg :name :accessor name) ; String name of slot + (object :initarg :object :accessor object) ; Display item for contents of slot + (max-name-width :initarg :max-name-width + :accessor max-name-width)) ; Length of longest slot name in structure + (:documentation "Slot-Items have a string name for the slot (e.g., +structure slot name or vector index) and an object item for the +contents of the slot. The Max-Name-Width is used so that all the slots +in an inspection item can line their objects up nicely in a +left-justified column.")) + +(defun make-slot-item (name object) + (make-instance 'slot-item :name name :object object)) + +(defgeneric slot-item-p (item) + (:method ((item t)) + nil) + (:method ((item slot-item)) + t)) + +;;; Slot item methods. + +(defmethod display ((item slot-item) window x y) + (with-slots (name object max-name-width) item + (let ((name-pixel-width (* (+ 2 max-name-width) + (font-width *entry-font*)))) + (disp-string window x y name *entry-font*) + (multiple-value-bind (width height) (display-item object window (+ x name-pixel-width) y) + (values (+ name-pixel-width width border) + (max (+ (font-height *entry-font*) vsp) height)))))) + +(defmethod tracker ((item slot-item) x y) + (tracker (object item) x y)) + +(defmethod walker ((item slot-item) function) + (with-slots (object max-name-width) item + (walker object function) + (setf (width item) + (+ (* (+ 2 max-name-width) (font-width *entry-font*)) + (width object) + border)))) + + +(defclass list-item (view-item) + ((item-list :initarg :item-list :accessor item-list)) ; List of things to be displayed + (:documentation "List-Items are used to display several things on +the same line, one after the other.")) + +(defun make-list-item (list) + (make-instance 'list-item :item-list list)) + +;;; List item methods. + +;; If a thing in the item list is a string, we just Disp-String it. +;; That way, we don't have to cons lots of full string items all the +;; time. +(defmethod display ((item list-item) window x0 y0) + (let ((x x0) + (max-height 0)) + (dolist (item (item-list item)) + (multiple-value-bind (width height) + (if (stringp item) + (disp-string window x y0 item *entry-font*) + (display-item item window x y0)) + (incf x width) + (setq max-height (max max-height height)))) + (values (- x x0) max-height))) + +(defmethod tracker ((item list-item) x y) + (track-in-list (item-list item) x y)) + +(defmethod walker ((item list-item) function) + (dolist (element (item-list item)) + (when (view-item-p element) + (walker element function)))) + + +(defclass object-item (view-item) + ((object :initarg :object :accessor object) ; The Lisp object itself + (item-string :initarg :item-string :accessor item-string) ; String representation cache + (place :initarg :place :accessor place) ; Place where it came from + (index :initarg :index :accessor index) ; Index into where it came from + (ref :initarg :ref :accessor ref) ; Function to get object, given place and index + (setter :initarg :setter :accessor setter)) ; Function to set object, given place, index + ; and new value + (:documentation "Object-Items are used to display component Lisp +objects. They know where the object came from and how to get it again +(for decaching) and how to change it (for modification).")) + +(defun make-object-item (object place index ref set) + (make-instance 'object-item :object object :place place :index index :ref ref :setter set)) + +(defgeneric object-item-p (item) + (:method ((item t)) + nil) + (:method ((item object-item)) + t)) + +;;; Object item methods. + +(defmethod display ((item object-item) window x y) + (unless (and (slot-boundp item 'item-string) (item-string item)) + (setf (item-string item) (iprin1-to-string (object item)))) + (disp-string window x y (item-string item) *entry-font*)) + +(defmethod tracker ((item object-item) x y) + (when (update-current-item item x y) + (boxify-item item boole-1))) + +(defmethod untracker ((item object-item)) + (boxify-item item boole-c1)) + +(defmethod mouse-handler ((item object-item) view key-event) + (cond ((eq key-event #k"Leftdown") + ;; Open in current window + (push (cons (object view) + (view-item view)) + (stack view)) + (update-view-of-object view (object item))) + + ((eq key-event #k"Rightdown") + ;; Open in new window + (create-view-of-object (object item) (prin1 (type-of item)))) + + ((eq key-event #k"Middledown") + ;; Return object from inspect + (setq *inspect-result* (object item)) + (try-to-quit)) + + ((eq key-event #k"Super-Middledown") + ;; Return object but leave windows around + (setq *inspect-result* (object item)) + (try-to-proceed)))) + +(defmethod walker ((item object-item) function) + (funcall function item)) + +;;; Object* items. + +(defclass object*-item (object-item) + ((live :initarg :live :accessor live) + (string* :initarg :string* :accessor string*)) + (:documentation "Object*-Items are like Object-Items except that +sometimes they can be like string items and be not-selectable.")) + +(defun make-object*-item (string* object live place index ref set) + (make-instance 'object*-item + :string* string* + :object object + :live live + :place place + :index index + :ref ref + :setter set)) + +(defgeneric object*-item-p (item) + (:method ((item t)) + nil) + (:method ((item object*-item)) + t)) + +;;; Object* item methods. + +(defmethod display ((item object*-item) window x y) + (if (live item) + (call-next-method) + (disp-string window x y (string* item) *italic-font*))) + +(defmethod tracker ((item object*-item) x y) + (if (or (live item) (eq *tracking-mode* :destination)) + (boxifying-tracker item x y) + (update-current-item item x y))) + +(defmethod untracker ((item object*-item)) + (when (or (live item) (eq *tracking-mode* :destination)) + (boxifying-untracker item))) + +(defmethod mouse-handler ((item object*-item) view key-event) + (when (live item) + (call-next-method))) + + +;;;; Display stuff. This uses the methods defined above to actually +;;;; render the objects onto a visible window. + +;; Computing display items for Lisp objects. + + +(defgeneric plan-view (object &key header stream) + (:documentation "Plan-View returns a top-level View-Item for the + given Object.")) + +(defgeneric replan-view (object plan) + (:documentation "Replan-view tries to fix up the existing Plan if +possible, but might punt and just return a new View-Item if things +have changed too much.")) + +(defun replan (plan) + "Replan is for the update function. It sets up the right calling + convention for calling the generic replan-view function." + (let ((object (objects plan))) + (replan-view object plan))) + + +(defun replan-object-item (item) + "Replan-Object-Item is used at the leaves of the replanning walk." + (if (object*-item-p item) + (multiple-value-bind (decached-object live) + (funcall (ref item) (place item) (index item)) + (unless (and (eq live (live item)) + (eq decached-object (object item)) + (or (symbolp decached-object) (numberp decached-object) + ;; ... + )) + (setf (live item) live) + (setf (object item) decached-object) + (setf (item-string item) nil) + (redisplay-item item))) + (let ((decached-object (funcall (ref item) + (place item) (index item)))) + (unless (and (eq decached-object (object item)) + (or (symbolp decached-object) (numberp decached-object) + ;; ... any others that'll be the same? + )) + (setf (object item) decached-object) + (setf (item-string item) nil) + (redisplay-item item))))) + + +;; Figure out how long random list structures are. Deals with dotted +;; lists and circular lists. + +;; This routine is too simple --- I'm not sure it always works. In +;; particular, I doubt it gives an accurate count for every kind of +;; circular list. +(defun count-conses (list) + (if (atom list) + (values 0 :atom) + (do ((count 1 (1+ count)) + (tortoise list) + (tortoise-advance nil (not tortoise-advance)) + (hare (cdr list) (cdr hare))) + ((or (null hare) (not (listp hare)) (eq hare tortoise)) + (cond ((null hare) + (values count :proper-list)) + ((not (listp hare)) + (values count :dotted-list)) + ((eq hare tortoise) + (values count :circular-list)))) + (when tortoise-advance + (setf tortoise (cdr tortoise)))))) + + +;; For lists, what we stash in the Inspection-Item-Objects slot is the +;; list of the top level conses, rather than the conses themselves. +;; This lets us detect when conses "in the middle" of the list change. +(defmethod plan-view ((object list) &key &allow-other-keys) + (cond + ;; Display the list object as a "list": ( .... ) + ((or (and (< (size-item (make-string-item (iprin1-to-string object))) + (- max-window-width (* 2 border))) + (<= (count-conses object) inspect-length)) + (= (count-conses object) 1)) + (do ((list object (cdr list)) + (i 0 (1+ i)) + (items (list "("))) + ((or (not (consp (cdr list))) + ;; The following covers circular lists. + (> i (count-conses object))) + (push (make-object-item (car list) list nil 'lref 'lset) items) + (when (not (null (cdr list))) + (push " . " items) + (push (make-object-item (cdr list) list nil 'lref* 'lset*) items)) + (push ")" items) + (make-inspection-item + (copy-n-conses object (count-conses object)) + nil + (list (make-list-item (nreverse items))))) + (push (make-object-item (car list) list nil 'lref 'lset) items) + (push " " items))) + + ((<= (count-conses object) inspect-length) + (let ((items nil)) + (push (make-list-item (list "(" + (make-object-item + (car object) object nil 'lref 'lset))) + items) + (do ((list (cdr object) (cdr list))) + ((not (consp (cdr list))) + (cond ((null (cdr list)) + (push (make-list-item + (list " " + (make-object-item + (car list) list nil 'lref 'lset) + ")")) + items)) + (t + (push (make-list-item + (list " " + (make-object-item + (car list) list nil 'lref 'lset))) + items) + (push " ." items) + (push (make-list-item + (list " " + (make-object-item + (cdr list) list nil 'lref* 'lset*) + ")")) + items)))) + (push (make-list-item + (list " " + (make-object-item + (car list) list nil 'lref 'lset))) + items)) + (make-inspection-item (copy-n-conses object (count-conses object)) + nil (nreverse items)))) + + ;; This list is too long --- use a scrolling view. + (t + (let ((scrollbar + (let ((index 0) + (cons object) + (last (last object))) + (make-scrollbar + 0 + (+ (count-conses object) (if (cdr last) 1 0)) + inspect-length + #'(lambda (item) + (setf (item-list item) + `(,(cond ((eq cons object) "(") + ((not (consp cons)) " . ") + (t " ")) + ,(if (consp cons) + (make-object-item (car cons) cons nil 'lref 'lset) + (make-object-item cons last nil 'lref* 'lset*)) + ,@(if (or (and (eq cons last) (null (cdr cons))) + (atom cons)) + `(")")))) + (incf index) + (unless (atom cons) + (setq cons (cdr cons)))) + #'(lambda (item) + (setq index (first-index item)) + (setq cons (nthcdr index object))))))) + (setf (scrollee scrollbar) + (make-scrolling-inspection-item + (copy-n-conses object (count-conses object)) + nil + (let ((items nil)) + (dotimes (i inspect-length) + (push (make-scrolling-item scrollbar (make-list-item nil)) + items)) + (nreverse items)) + scrollbar))) + ))) + +;; This is kind of like (maplist #'identity list), except that it +;; doesn't choke on non-nil-terminated lists. +(defun copy-conses (list) + (do ((list list (cdr list)) + (conses nil)) + ((atom list) + (nreverse conses)) + (push list conses))) + + +;; This will copy "n" conses; this deals with circular lists. +(defun copy-n-conses (list n) + (do ((i 1 (1+ i)) + (list list (cdr list)) + (conses nil)) + ((or (atom list) (= i n)) (nreverse conses)) + (push list conses))) + + +(defmethod replan-view ((object list) plan) + (cond ((do ((list (car object) (cdr list)) + (conses object (cdr conses))) + ((or (null list) (null conses)) + (and (null list) (null conses))) + (unless (and (eq list (car conses)) + (eq (cdr list) (cadr conses))) + (return nil))) + (walker plan #'replan-object-item) + plan) + (t + (plan-view (car object))))) + +(defun lref (object ignore) (declare (ignore ignore)) + (car object)) +(defun lref* (object ignore) (declare (ignore ignore)) + (cdr object)) +(defun lset (object ignore new) (declare (ignore ignore)) + (setf (car object) new)) +(defun lset* (object ignore new) (declare (ignore ignore)) + (setf (cdr object) new)) + + +(defmethod plan-view ((object vector) &key &allow-other-keys) + (let* ((type (type-of object)) + (length (array-dimension object 0)) + (header + `(,(make-string-item (format nil "~A" (if (listp type) (car type) type)) + *header-font*) + ,(make-string-item (format nil "Length = ~D" length) + *header-font*) + ,@(if (array-has-fill-pointer-p object) + `(,(make-list-item (list "Fill-Pointer: " + (make-object-item + (fill-pointer object) + object nil 'fpref 'fpset)))))))) + (cond ((<= length inspect-length) + (make-inspection-item + object + header + (let ((items nil)) + (dotimes (i length) + (push (make-slot-item (prin1-to-string i) + (make-object-item + (aref object i) object i 'vref 'vset)) + items)) + (nreverse items)))) + (t + (let ((scrollbar + (let ((index 0)) + (make-scrollbar + 0 + length + inspect-length + #'(lambda (item) + (setf (name item) (prin1-to-string index)) + (let ((obj (object item))) + (setf (object obj) (aref object index)) + (setf (index obj) index) + (setf (item-string obj) nil)) + (incf index)) + #'(lambda (item) + (setq index (first-index item))))))) + (setf (scrollee scrollbar) + (make-scrolling-inspection-item + object + header + (let ((items nil) + (name-width (length (iprin1-to-string (1- length))))) + (dotimes (i inspect-length) + (let ((slot + (make-slot-item + nil + (make-object-item nil object nil 'vref 'vset)))) + (setf (max-name-width slot) name-width) + (push (make-scrolling-item scrollbar slot) items))) + (nreverse items)) + scrollbar))))))) + +(defmethod replan-view ((object vector) plan) + (cond ((= (length object) (length (objects plan))) + (walker plan #'replan-object-item) + plan) + (t + (plan-view object)))) + +(defun vref (object index) + (aref object index)) +(defun vset (object index new) + (setf (aref object index) new)) + +(defun fpref (object index) + (declare (ignore index)) + (fill-pointer object)) +(defun fpset (object index new) + (declare (ignore index)) + (setf (fill-pointer object) new)) + + +(defmethod plan-view ((object array) &key &allow-other-keys) + (lisp::with-array-data ((data object) + (start) + (end)) + (let* ((length (- end start)) + (dimensions (array-dimensions object)) + (rev-dimensions (reverse dimensions)) + (header + (list (make-string-item + (format nil "Array of ~A" (array-element-type object)) + *header-font*) + (make-string-item + (format nil "Dimensions = ~S" dimensions) + *header-font*)))) + (cond ((<= length inspect-length) + (make-inspection-item + object + header + (let ((items nil)) + (dotimes (i length) + (push (make-slot-item (index-string i rev-dimensions) + (make-object-item + (aref data (+ start i)) + object (+ start i) 'vref 'vset)) + items)) + (nreverse items)))) + (t + (let ((scrollbar + (let ((index 0)) + (make-scrollbar + 0 + length + inspect-length + #'(lambda (item) + (setf (name item) + (index-string index rev-dimensions)) + (let ((obj (object item))) + (setf (object obj) + (aref data (+ start index))) + (setf (index obj) (+ start index)) + (setf (item-string obj) nil)) + (incf index)) + #'(lambda (item) + (setq index (first-index item))))))) + (setf (scrollee scrollbar) + (make-scrolling-inspection-item + object + header + (let ((items nil) + (name-width (length (index-string (1- length) + rev-dimensions)))) + (dotimes (i inspect-length) + (let ((slot + (make-slot-item + nil + (make-object-item nil data nil 'vref 'vset)))) + (setf (max-name-width slot) name-width) + (push (make-scrolling-item scrollbar slot) items))) + (nreverse items)) + scrollbar)))))))) + +(defun index-string (index rev-dimensions) + (if (null rev-dimensions) + "[]" + (let ((list nil)) + (dolist (dim rev-dimensions) + (multiple-value-bind (q r) + (floor index dim) + (setq index q) + (push r list))) + (format nil "[~D~{,~D~}]" (car list) (cdr list))))) + +(defmethod replan-view ((object array) plan) + (cond ((and (equal (array-dimensions object) + (array-dimensions (objects plan))) + (lisp::with-array-data ((data1 object) + (start1) (end1)) + (lisp::with-array-data ((data2 (objects plan)) + (start2) (end2)) + (and (eq data1 data2) + (= start1 start2) + (= end1 end2))))) + (walker plan #'replan-object-item) + plan) + (t + (plan-view object)))) + + +(defmethod plan-view ((object t) &key &allow-other-keys) + (make-inspection-item + object + nil + (list (make-object-item object (list object) nil 'lref 'lset)))) + +(defmethod replan-view ((object t) plan) + (declare (ignore object)) + (walker plan #'replan-object-item) + plan) + + + +(defmethod plan-view ((object structure-object) &key &allow-other-keys) + (let* ((dd (kernel:layout-info (kernel:%instance-layout object))) + (dsds (kernel:dd-slots dd))) + (make-inspection-item + object + (list (make-string-item + (format nil "~A ~A" + (symbol-name (kernel:dd-name dd)) + object) + *header-font*)) + (let ((items nil)) + (dolist (dsd dsds) + (push (make-slot-item + (kernel:dsd-%name dsd) + (make-object-item + (funcall (fdefinition (kernel:dsd-accessor dsd)) object) + object (kernel:dsd-index dsd) + #'(lambda (str ignore) + (declare (ignore ignore)) + (funcall (fdefinition (kernel:dsd-accessor dsd)) + str)) + #'(lambda (str ignore val) + (declare (ignore ignore)) + (funcall (fdefinition `(setf ,(kernel:dsd-accessor dsd))) + val str)))) + items)) + (nreverse items))))) + +(defmethod replan-view ((object structure-object) plan) + (declare (ignore object)) + (walker plan #'replan-object-item) + plan) + + + +(defmethod plan-view ((object standard-object) &key &allow-other-keys) + (let ((class (pcl:class-of object))) + (make-inspection-item + object + (list (make-string-item (format nil "~S ~A" + (pcl:class-name class) + object) + *header-font*)) + (let ((slotds (pcl::slots-to-inspect class object)) + instance-slots class-slots other-slots) + (dolist (slotd slotds) + (with-slots ((slot pcl::name) (allocation pcl::allocation)) slotd + (let* ((boundp (slot-boundp object slot)) + (item (make-slot-item (prin1-to-string slot) + (make-object*-item + "Unbound" + (and boundp (slot-value object slot)) + boundp + object + slot + 'ref-slot + 'set-slot)))) + (case allocation + (:instance (push item instance-slots)) + (:class (push item class-slots)) + (otherwise + (setf (name item) + (format nil "~S [~S]" slot allocation)) + (push item other-slots)))))) + (append (unless (null instance-slots) + (cons (make-string-item "These slots have :INSTANCE allocation" + *entry-font*) + (nreverse instance-slots))) + (unless (null class-slots) + (cons (make-string-item "These slots have :CLASS allocation" + *entry-font*) + (nreverse class-slots))) + (unless (null other-slots) + (cons (make-string-item "These slots have allocation as shown" + *entry-font*) + (nreverse other-slots)))))))) + + +(defun ref-slot (object slot) + (if (slot-boundp object slot) + (values (slot-value object slot) t) + (values nil nil))) + +(defun set-slot (object slot val) + (setf (slot-value object slot) val)) + +;;; Should check to see if we need to redo the entire plan or not. +(defmethod replan-view ((object standard-object) plan) + (declare (ignore plan)) + (plan-view object)) + + + +(defmethod plan-view ((object symbol) &key &allow-other-keys) + (make-inspection-item + object + (list (make-string-item (format nil "Symbol ~A" object) *header-font*)) + (list (make-slot-item "Value" + (make-object*-item + "Unbound" (if (boundp object) (symbol-value object)) + (boundp object) object nil 'valref 'valset)) + (make-slot-item "Function" + (make-object*-item + "Undefined" (if (fboundp object) (symbol-function object)) + (fboundp object) object nil 'defref 'defset)) + (make-slot-item "Properties" + (make-object-item + (symbol-plist object) object nil 'plistref 'plistset)) + (make-slot-item "Package" + (make-object-item + (symbol-package object) object nil 'packref 'packset))))) + +(defmethod replan-view ((object symbol) plan) + (declare (ignore object)) + (walker plan #'replan-object-item) + plan) + +(defun valref (object ignore) (declare (ignore ignore)) + (if (boundp object) + (values (symbol-value object) t) + (values nil nil))) +(defun defref (object ignore) (declare (ignore ignore)) + (if (fboundp object) + (values (symbol-function object) t) + (values nil nil))) +(defun plistref (object ignore) (declare (ignore ignore)) + (symbol-plist object)) +(defun packref (object ignore) (declare (ignore ignore)) + (symbol-package object)) + +(defun valset (object ignore new) (declare (ignore ignore)) + (setf (symbol-value object) new)) +(defun defset (object ignore new) (declare (ignore ignore)) + (setf (symbol-function object) new)) +(defun plistset (object ignore new) (declare (ignore ignore)) + (setf (symbol-plist object) new)) +(defun packset (object ignore new) (declare (ignore ignore)) + (lisp::%set-symbol-package object new)) + + +;; This is all very gross and silly now, just so we can get something +;; working quickly. Eventually do this with a special stream that +;; listifies things as it goes along... +(defmethod plan-view ((object function) &key &allow-other-keys) + (let ((stream (make-string-output-stream))) + (let ((*standard-output* stream) + (ext:*describe-print-level* 30)) + (describe object)) + (close stream) + (with-input-from-string (in (get-output-stream-string stream)) + (plan-view-text + object + (list + (make-string-item (format nil "Function ~S" object) *header-font*) + (make-string-item + (format nil "Argument list: ~A" (kernel:%function-arglist object)))) + in)))) + + +(defun plan-view-text (object header stream) + (let ((list nil)) + (do ((line (read-line stream nil nil) (read-line stream nil nil))) + ((null line)) + (push line list)) + (setq list (nreverse list)) + (if (<= (length list) inspect-length) + (make-inspection-item + object + header + (mapcar #'make-string-item list)) + (let ((index 0) + (vector (coerce list 'vector))) + (let ((scrollbar (make-scrollbar + 0 (length list) inspect-length + #'(lambda (item) + (setf (item-string item) + (aref vector index)) + (incf index)) + #'(lambda (item) + (setq index + (first-index item)))))) + (setf (scrollee scrollbar) + (make-scrolling-inspection-item + object + header + (let ((items nil)) + (dotimes (i inspect-length) + (push + (make-scrolling-item + scrollbar + ;; This is to ensure that the slots in + ;; the string item are bound. + (let ((string-item (make-string-item ""))) + (setf (x string-item) 0 + (y string-item) 0 + (width string-item) 0 + (height string-item) 0) + string-item)) + items)) + (nreverse items)) + scrollbar))))))) + + +;;;; Displaying old and new plans in old and new windows. + +(defun new-plan-in-new-view (object plan &optional name) + (multiple-value-bind (width height) (size-item plan) + ;; add border + (incf width 10) + (incf height 10) + (multiple-value-bind (x y) (next-window-position width height) + (let* ((window (xlib:create-window :parent *root* :x x :y y + :width width :height height + :background *white-pixel* + :border-width 2)) + (view (make-view name object plan window))) + (xlib:set-wm-properties window + :name "Inspector Window" + :icon-name "Inspector Display" + :resource-name "Inspector" + :x x :y y :width width :height height + :user-specified-position-p t + :user-specified-size-p t + :min-width width :min-height height + :width-inc nil :height-inc nil) + (setf (xlib:wm-protocols window) `(:wm_delete_window)) + (add-window-view-mapping window view) + (xlib:map-window window) + (xlib:clear-area window) + (xlib:with-state (window) + (setf (xlib:window-event-mask window) important-xevents-mask) + (setf (xlib:window-cursor window) *cursor*)) + (xlib:display-finish-output *display*) + (display-item plan window 5 5) + (push view *views*) + (multiple-value-bind + (x y same-screen-p child mask root-x root-y root) + (xlib:query-pointer window) + (declare (ignore same-screen-p child mask root-x root-y root)) + (when (and (< 0 x (+ width 10)) (< 0 y (+ height 10))) + (tracker plan x y))) + (xlib:display-force-output *display*) + view)))) + +(defun create-view-of-object (object &optional name) + (new-plan-in-new-view object (plan-view object) name)) + +(defun new-plan-in-old-view (view old new) + (unless (eq new old) + (setf (view-item view) new) + (let ((window (window view))) + (when (and *current-item* + (eql (window *current-item*) window)) + (setq *current-item* nil)) + (multiple-value-bind (width height) + (size-item new) + (xlib:with-state (window) + (setf (xlib:drawable-width window) (+ width 10)) + (setf (xlib:drawable-height window) (+ height 10))) + (xlib:clear-area window) + (display-item new window 5 5) + (setf (window new) window + (x new) 5 + (y new) 5 + (width new) width + (height new) height) + (xlib:display-force-output *display*) + (multiple-value-bind + (x y same-screen-p child mask root-x root-y root) + (xlib:query-pointer window) + (declare (ignore same-screen-p child mask root-x root-y root)) + (when (and (< 0 x (+ width 10)) (< 0 y (+ height 10))) + (tracker new x y))))))) + +(defun update-view-of-object (view &optional (object (object view))) + (cond ((eq object (object view)) + (new-plan-in-old-view view + (view-item view) + (replan (view-item view)))) + (t + (setf (object view) object) + (new-plan-in-old-view view (view-item view) (plan-view object)))) + (xlib:display-force-output *display*)) + + +;; DELETING-WINDOW-DROP-EVENT checks for any events on win. If there +;; is one, it is removed from the queue, and t is returned. Otherwise, +;; returns nil. +(defun deleting-window-drop-event (display win) + (xlib:display-finish-output display) + (let ((result nil)) + (xlib:process-event + display :timeout 0 + :handler #'(lambda (&key event-window window &allow-other-keys) + (if (or (eq event-window win) (eq window win)) + (setf result t) + nil))) + result)) + +(defun remove-view-of-object (view) + (let (#+:mp (update-process (update-process view)) + (window (window view))) + #+:mp (mp:destroy-process update-process) + (setf (xlib:window-event-mask window) #.(xlib:make-event-mask)) + (xlib:display-finish-output *display*) + (loop (unless (deleting-window-drop-event *display* window) (return))) + (xlib:destroy-window window) + (xlib:display-finish-output *display*) + (delete-window-view-mapping window) + (setq *views* (delete view *views*)))) + + +;;;; The command interpreter. + +(defvar *can-quit* nil) +(defvar *can-proceed* nil) +(defvar *unwinding* t) + +(defun try-to-quit () + (setq *current-item* nil) + (when *can-quit* + (setq *unwinding* nil) + (ext:flush-display-events *display*) + (throw 'inspect-exit nil)) + (try-to-proceed)) + +(defun try-to-proceed () + (when *can-proceed* + (setq *unwinding* nil) + (ext:flush-display-events *display*) + (throw 'inspect-proceed nil))) + +(defvar *do-command* nil) + +(defun do-command (view key-event) + (cond (*do-command* + (funcall *do-command* view key-event)) + + ;; If we get scrollwheel down key events anywhere in the view, + ;; the scrollbar wants to know about them. Yes, a bit + ;; ad-hoc.... + ((and (or (eq key-event #k"Scrollupdown") + (eq key-event #k"Scrolldowndown")) + (typep (view-item view) 'scrolling-inspection-item)) + (dotimes (i 5) ; Simulate multiple clicks. + (mouse-handler (scrollbar (view-item view)) view key-event))) + + ((or (eq key-event #k"d") (eq key-event #k"D")) + ;; Delete current window. + (remove-view-of-object view) + (setq *current-item* nil) + (unless *views* + (try-to-quit) + (try-to-proceed))) + + ((or (eq key-event #k"h") (eq key-event #k"H") (eq key-event #k"?")) + (let ((inspect-length (max inspect-length 30))) + (with-open-file (stream help-file-pathname :direction :input) + (new-plan-in-new-view + nil + (plan-view-text nil + (list (make-string-item "Help" *header-font*)) + stream) + "Help Window")))) + + ((or (eq key-event #k"m") (eq key-event #k"M")) + ;; Modify something. + ;; Since the tracking stuff sets up event handlers that can + ;; throw past the CLX event dispatching form in + ;; INSPECTOR-EVENT-HANDLER, those handlers are responsible + ;; for discarding their events when throwing to this CATCH + ;; tag. + (catch 'quit-modify + (let* ((destination-item (track-for-destination)) + (source (cond + ((eq key-event #k"m") + (object (track-for-source))) + (t + (format *query-io* + "~&Form to evaluate for new contents: ") + (force-output *query-io*) + (eval (read *query-io*)))))) + (funcall (setter destination-item) + (place destination-item) + (index destination-item) + source) + (update-view-of-object view)))) + + ((or (eq key-event #k"q") (eq key-event #k"Q")) + ;; Quit. + (try-to-quit)) + + ((or (eq key-event #k"p") (eq key-event #k"P")) + ;; Proceed. + (try-to-proceed)) + + ((or (eq key-event #k"r") (eq key-event #k"R")) + ;; Recompute object (decache). + (update-view-of-object view)) + + ((or (eq key-event #k"u") (eq key-event #k"U")) + ;; Up (pop history stack). + (when (stack view) + (let ((parent (pop (stack view)))) + (setf (object view) (car parent)) + (new-plan-in-old-view view (view-item view) (cdr parent)) + (update-view-of-object view)))) + + ((or (eq key-event #k"Leftdown") + (eq key-event #k"Middledown") + (eq key-event #k"Rightdown") + (eq key-event #k"Super-Leftdown") + (eq key-event #k"Super-Middledown") + (eq key-event #k"Super-Rightdown") +;; (eq key-event #k"Scrollupdown") +;; (eq key-event #k"Scrolldowndown") +;; (eq key-event #k"Super-Scrollupdown") +;; (eq key-event #k"Super-Scrolldowndown") + ) + + (when *current-item* + (mouse-handler *current-item* view key-event))))) + + +;;;; Stuff to make modification work. + +(defun track-for-destination () + (track-for :destination *cursor-d*)) + +(defun track-for-source () + (track-for :source *cursor-s*)) + +;; TRACK-FOR loops over SYSTEM:SERVE-EVENT waiting for some event +;; handler to throw to this CATCH tag. Since any such handler throws +;; past SYSTEM:SERVE-EVENT, and therefore, past the CLX event +;; dispatching form in INSPECTOR-EVENT-HANDLER, it is that handler's +;; responsibility to discard its event. +(defun track-for (tracking-mode cursor) + (let ((*tracking-mode* tracking-mode) + (*do-command* #'track-for-do-command)) + (catch 'track-for + (unwind-protect + (progn + (dolist (view *views*) + (setf (xlib:window-cursor (window view)) + cursor)) + (xlib:display-force-output *display*) + (loop + (system:serve-event))) + (dolist (view *views*) + (setf (xlib:window-cursor (window view)) + *cursor*)) + (xlib:display-force-output *display*))))) + +;; TRACK-FOR-DO-COMMAND is the "DO-COMMAND" executed when tracking. +;; Since this throws past the CLX event handling form in +;; INSPECTOR-EVENT-HANDLER, the responsibility for discarding the +;; current event lies here. +(defun track-for-do-command (view key-event) + (declare (ignore view)) + (cond + ((or (eq key-event #k"q") (eq key-event #k"Q")) + (xlib:discard-current-event *display*) + (throw 'quit-modify t)) + ((or (eq key-event #k"Leftdown") + (eq key-event #k"Middledown") + (eq key-event #k"Rightdown")) + (when (object-item-p *current-item*) + (throw 'track-for + (prog1 *current-item* + (when (object*-item-p *current-item*) + (untracker *current-item*) + (setq *current-item* nil)) + (xlib:discard-current-event *display*))))))) + + + +;;;; Top-level program interface. + +(defun show-object (object &optional name) + (inspect-init) + (dolist (view *views*) + (when (if name + (eq name (name view)) + (eq object (object view))) + (update-view-of-object view object) + (return-from show-object nil))) + (create-view-of-object object name)) + +(defun remove-object-view (object &optional name) + (dolist (view *views*) + (when (if name + (eq name (name view)) + (eq object (object view))) + (remove-view-of-object view) + (return nil)))) + +(defun remove-all-views () + (dolist (view *views*) + (remove-view-of-object view))) + + + +;;;; Top-level user interface. + +(defvar *interface-style* :graphics + "This specifies the default value for the interface argument to INSPECT. The + default value of this is :graphics, indicating when running under X, INSPECT + should use a graphics interface instead of a command-line oriented one.") + +(defun inspect (&optional (object nil object-p) + (interface *interface-style*)) + "(inspect <object> <interface>) + +Interactively examine Lisp objects. + +Arguments: + +object: The object to examine. + +interface: one of [:window :windows :graphics :graphical :x + :command-line :tty] + +Any of [:window :windows :graphics :graphical :x] give a windowing +interface. Once you've got a window, type <h> or <H> to get a help +window explaining how to use it. + +Either of [:command-line :tty] gives a pure command-line inspector. + +If <interface> is not supplied, the default is to use a windowing +interface if running under X11, and a command-line interface if not. + +If neither argument is given, the windowing version of inspect will +resume inspection of items left active from previous uses if there are +any, otherwise give an error. The command-line interface will give an +error." + (cond ((or (member interface '(:command-line :tty)) + (not (assoc :display ext:*environment-list*))) + (when object-p (tty-inspect object))) + ((not (member interface '(:window :windows :graphics :graphical :x))) + (error "Interface must be one of :window, :windows, :graphics, ~ + :graphical, :x, :command-line, or :tty -- not ~S." + interface)) + (object-p + (inspect-init) + (let ((disembodied-views nil) + (*inspect-result* object) + (*x-constraint* max-window-width) + (*can-quit* t) + (*can-proceed* t)) + (let ((*views* nil)) + (create-view-of-object object "User Supplied Object") + (catch 'inspect-proceed + (unwind-protect + (progn + (catch 'inspect-exit + (loop + (system:serve-event))) + (setq *unwinding* t)) + (when *unwinding* + (do ((view (pop *views*) + (pop *views*))) + ((null view)) + (remove-view-of-object view))))) + (setq disembodied-views *views*)) + (dolist (view (reverse disembodied-views)) + (push view *views*)) + *inspect-result*)) + (*views* + (inspect-init) + (let ((*inspect-result* nil) + (*can-quit* t) + (*can-proceed* t)) + (catch 'inspect-proceed + (catch 'inspect-exit + (loop + (system:serve-event)))) + *inspect-result*)) + (t (error "No object supplied for inspection and no previous ~ + inspection object exists.")))) ===================================== src/contrib/clx-inspector/compile-clx-inspector.lisp ===================================== --- /dev/null +++ b/src/contrib/clx-inspector/compile-clx-inspector.lisp @@ -0,0 +1,2 @@ +(compile-file "modules:clx-inspector/clx-inspector" + :load t) ===================================== src/contrib/clx-inspector/inspect11-d.cursor ===================================== --- /dev/null +++ b/src/contrib/clx-inspector/inspect11-d.cursor @@ -0,0 +1,8 @@ +#define inspect-d_width 16 +#define inspect-d_height 16 +#define inspect-d_x_hot 1 +#define inspect-d_y_hot 1 +static char inspect-d_bits[] = { + 0x00,0x00,0x02,0x00,0x06,0x00,0x0e,0x00,0x1e,0x00,0x3e,0x00,0x7e,0x00,0xfe, + 0x00,0xfe,0x45,0x3e,0x6c,0x36,0x54,0x62,0x54,0x60,0x44,0xc0,0x44,0xc0,0x44, + 0x00,0x00}; ===================================== src/contrib/clx-inspector/inspect11-d.mask ===================================== --- /dev/null +++ b/src/contrib/clx-inspector/inspect11-d.mask @@ -0,0 +1,6 @@ +#define inspect-d_width 16 +#define inspect-d_height 16 +static char inspect-d_bits[] = { + 0x07,0x00,0x0f,0x00,0x1f,0x00,0x3f,0x00,0x7f,0x00,0xff,0x00,0xff,0x01,0xff, + 0xef,0xff,0xff,0x7f,0xfe,0xff,0xfe,0xff,0xfe,0xf7,0xef,0xe0,0xef,0xe0,0xef, + 0xe0,0xef}; ===================================== src/contrib/clx-inspector/inspect11-s.cursor ===================================== --- /dev/null +++ b/src/contrib/clx-inspector/inspect11-s.cursor @@ -0,0 +1,8 @@ +#define inspect-s_width 16 +#define inspect-s_height 16 +#define inspect-s_x_hot 1 +#define inspect-s_y_hot 1 +static char inspect-s_bits[] = { + 0x00,0x00,0x02,0x00,0x06,0x00,0x0e,0x00,0x1e,0x00,0x3e,0x00,0x7e,0x00,0xfe, + 0x00,0xfe,0x79,0x3e,0x44,0x36,0x04,0x62,0x38,0x60,0x40,0xc0,0x44,0xc0,0x3c, + 0x00,0x00}; ===================================== src/contrib/clx-inspector/inspect11-s.mask ===================================== --- /dev/null +++ b/src/contrib/clx-inspector/inspect11-s.mask @@ -0,0 +1,6 @@ +#define inspect-s_width 16 +#define inspect-s_height 16 +static char inspect-s_bits[] = { + 0x07,0x00,0x0f,0x00,0x1f,0x00,0x3f,0x00,0x7f,0x00,0xff,0x00,0xff,0x01,0xff, + 0xfd,0xff,0xff,0x7f,0xfe,0xff,0x7e,0xff,0xfc,0xf7,0xff,0xe0,0xff,0xe0,0x7f, + 0xe0,0x7f}; ===================================== src/contrib/clx-inspector/inspect11.cursor ===================================== --- /dev/null +++ b/src/contrib/clx-inspector/inspect11.cursor @@ -0,0 +1,8 @@ +#define inspect_width 16 +#define inspect_height 16 +#define inspect_x_hot 3 +#define inspect_y_hot 1 +static char inspect_bits[] = { + 0x00,0x00,0x08,0x00,0x18,0x00,0x38,0x00,0x78,0x00,0xf8,0x00,0xf8,0x01,0xf8, + 0x03,0xf8,0x07,0xf8,0x00,0xd8,0x00,0x88,0x01,0x80,0x01,0x00,0x03,0x00,0x03, + 0x00,0x00}; ===================================== src/contrib/clx-inspector/inspect11.mask ===================================== --- /dev/null +++ b/src/contrib/clx-inspector/inspect11.mask @@ -0,0 +1,6 @@ +#define inspect_width 16 +#define inspect_height 16 +static char inspect_bits[] = { + 0x0c,0x00,0x1c,0x00,0x3c,0x00,0x7c,0x00,0xfc,0x00,0xfc,0x01,0xfc,0x03,0xfc, + 0x07,0xfc,0x0f,0xfc,0x0f,0xfc,0x01,0xdc,0x03,0xcc,0x03,0x80,0x07,0x80,0x07, + 0x00,0x03}; ===================================== src/contrib/clx-inspector/inspector.help ===================================== --- /dev/null +++ b/src/contrib/clx-inspector/inspector.help @@ -0,0 +1,73 @@ +The component objects of the window's object will become highlighted +(surrounded by a box) as the mouse passes over them. In an inspector +window, keystrokes and mouse clicks are interpreted as follows: + + Left When the mouse is over a component object, + clicking Left will inspect that object in + the current inspector window. The "up" command + (below) can be used to return to the current + object. + + Middle When the mouse is over a component object, + clicking Middle will exit the inspector, deleting + all new windows, and returning the component + as the result of the call to Inspect. + + Right When the mouse is over a component object, + clicking Right will inspect that object in + a new inspector window. + + Shift-Middle When the mouse is over a component object, + clicking Shift-Middle will exit the inspector, + leaving all windows displayed, and returning the + component as the result of the call to Inspect. + + d, D Typing "d" or "D" inside an inspector window + will delete that window, and exit the inspector + if there are no more inspector windows. + + h, H, ? Typing "h", "H", or "?" inside an inspector + window will create a window with helpful + instructions. + + m, M Typing "m" or "M" inside an inspector window + will allow one to modify a component of an + object. The mouse cursor will change from an + arrow to an arrow with an "M" beside it, + indicating that one should select the component + to be modified. Clicking any mouse button while + the mouse is over a component will select that + component as a destination for modification. + + If one has typed "m", the source object will + also be selected by the mouse, with the mouse + cursor changed to an arrow with an "S" beside + it. The object will replace the destination + component. + + If one has typed "M", the source object will be + prompted for on the *Query-IO* stream. + + When choosing the destination or source with the + mouse, one may type "q" or "Q" to abort the + modify operation. + + q, Q Typing "q" or "Q" will quit the inspector, + deleting all new inspector windows. + + p, P Typing "p" or "P" will proceed from the + inspector, leaving all inspector windows intact. + + r, R Typing "r" or "R" will recompute the display for + the object in the window. This is used to + maintain a consistent display for an object that + may have changed since the display was computed. + + u, U Typing "u" or "U" takes one back up the chain of + investigation, to the object for which this + object was displayed as a component. This only + works for displays generated by modifying a + previously current display; this does not work + for a display generated as a new inspector + window. +DONE ===================================== src/lisp/globals.h ===================================== --- a/src/lisp/globals.h +++ b/src/lisp/globals.h @@ -64,7 +64,7 @@ extern void globals_init(void); #define EXTERN(name,bytes) .extern name bytes #endif #ifdef sparc -#ifdef SVR4 +#if defined(SVR4) || defined(FEATURE_ELF) #define EXTERN(name,bytes) .global name #else #define EXTERN(name,bytes) .global _ ## name ===================================== src/lisp/sparc-assem.S ===================================== --- a/src/lisp/sparc-assem.S +++ b/src/lisp/sparc-assem.S @@ -4,43 +4,12 @@ #include <sys/asm_linkage.h> #include <sys/psw.h> #include <sys/trap.h> -#define _current_binding_stack_pointer current_binding_stack_pointer -#define _current_control_stack_pointer current_control_stack_pointer -#define _current_dynamic_space_free_pointer current_dynamic_space_free_pointer -#define _foreign_function_call_active foreign_function_call_active -#define _current_control_frame_pointer current_control_frame_pointer -#define _call_into_lisp call_into_lisp -#define _function_end_breakpoint_end function_end_breakpoint_end -#define _closure_tramp closure_tramp -#define _undefined_tramp undefined_tramp -#define _function_end_breakpoint_trap function_end_breakpoint_trap -#define _function_end_breakpoint_guts function_end_breakpoint_guts -#define _call_into_c call_into_c -#define _flush_icache flush_icache -#define _do_pending_interrupt do_pending_interrupt -#define _do_dynamic_space_overflow_error do_dynamic_space_overflow_error -#define _do_dynamic_space_overflow_warning do_dynamic_space_overflow_warning -#ifdef GENCGC -/*#define _collect_garbage collect_garbage*/ -#define _fpu_save fpu_save -#define _fpu_restore fpu_restore -#endif -#ifdef LINKAGE_TABLE -#define _resolve_linkage_tramp resolve_linkage_tramp -#define _lazy_resolve_linkage lazy_resolve_linkage -#define _undefined_foreign_symbol_trap undefined_foreign_symbol_trap -#endif #ifdef __STDC__ #define FUNCDEF(x) .type x, \#function #else #define FUNCDEF(x) .type x, #function #endif #else -#include <machine/asm_linkage.h> -#include <machine/psl.h> -#include <machine/trap.h> -#define FUNCDEF(x) /* nothing */ -#define SET_SIZE(x) /* nothing */ #endif #define LANGUAGE_ASSEMBLY @@ -68,9 +37,9 @@ #define FRAMESIZE (SA(MINFRAME)) #endif .seg "text" - .global _call_into_lisp - FUNCDEF(_call_into_lisp) -_call_into_lisp: + .global call_into_lisp + FUNCDEF(call_into_lisp) +call_into_lisp: save %sp, -FRAMESIZE, %sp /* Flush all of C's register windows to the stack. */ ta ST_FLUSH_WINDOWS @@ -96,15 +65,15 @@ _call_into_lisp: set pseudo_atomic_Value, reg_ALLOC /* Turn off foreign function call. */ - sethi %hi(_foreign_function_call_active), reg_NL0 - st reg_ZERO, [reg_NL0+%lo(_foreign_function_call_active)] + sethi %hi(foreign_function_call_active), reg_NL0 + st reg_ZERO, [reg_NL0+%lo(foreign_function_call_active)] /* Load the rest of lisp state. */ - load(_current_dynamic_space_free_pointer, reg_NL0) + load(current_dynamic_space_free_pointer, reg_NL0) add reg_NL0, reg_ALLOC, reg_ALLOC - load(_current_binding_stack_pointer, reg_BSP) - load(_current_control_stack_pointer, reg_CSP) - load(_current_control_frame_pointer, reg_OCFP) + load(current_binding_stack_pointer, reg_BSP) + load(current_control_stack_pointer, reg_CSP) + load(current_control_frame_pointer, reg_OCFP) /* No longer atomic, and check for interrupt. */ andn reg_ALLOC, pseudo_atomic_Value, reg_ALLOC @@ -147,13 +116,13 @@ lra: /* Store LISP state */ andn reg_ALLOC, lowtag_Mask, reg_NL1 - store(reg_NL1,_current_dynamic_space_free_pointer) - store(reg_BSP,_current_binding_stack_pointer) - store(reg_CSP,_current_control_stack_pointer) - store(reg_CFP,_current_control_frame_pointer) + store(reg_NL1,current_dynamic_space_free_pointer) + store(reg_BSP,current_binding_stack_pointer) + store(reg_CSP,current_control_stack_pointer) + store(reg_CFP,current_control_frame_pointer) /* No longer in Lisp. */ - store(reg_NL1,_foreign_function_call_active) + store(reg_NL1,foreign_function_call_active) /* Were we interrupted? */ andn reg_ALLOC, pseudo_atomic_Value, reg_ALLOC @@ -164,13 +133,13 @@ lra: ld [%sp+FRAMESIZE-4], %i7 ret restore %sp, FRAMESIZE, %sp - SET_SIZE(_call_into_lisp) + SET_SIZE(call_into_lisp) - .global _call_into_c - FUNCDEF(_call_into_c) -_call_into_c: + .global call_into_c + FUNCDEF(call_into_c) +call_into_c: #ifdef v8plus stx %o2, [%fp - 8 - 1*8] stx %o3, [%fp - 8 - 2*8] @@ -195,17 +164,17 @@ _call_into_c: st reg_L0, [reg_CFP+4] /* Store LISP state */ - store(reg_BSP,_current_binding_stack_pointer) - store(reg_CSP,_current_control_stack_pointer) - store(reg_CFP,_current_control_frame_pointer) + store(reg_BSP,current_binding_stack_pointer) + store(reg_CSP,current_control_stack_pointer) + store(reg_CFP,current_control_frame_pointer) /* Use reg_CFP as a work register, and restore it */ andn reg_ALLOC, lowtag_Mask, reg_CFP - store(reg_CFP,_current_dynamic_space_free_pointer) - load(_current_control_frame_pointer, reg_CFP) + store(reg_CFP,current_dynamic_space_free_pointer) + load(current_control_frame_pointer, reg_CFP) /* No longer in Lisp. */ - store(reg_CSP,_foreign_function_call_active) + store(reg_CSP,foreign_function_call_active) /* Were we interrupted? */ andn reg_ALLOC, pseudo_atomic_Value, reg_ALLOC @@ -229,15 +198,15 @@ _call_into_c: set pseudo_atomic_Value, reg_ALLOC /* No longer in foreign function call. */ - sethi %hi(_foreign_function_call_active), reg_NL2 - st reg_ZERO, [reg_NL2+%lo(_foreign_function_call_active)] + sethi %hi(foreign_function_call_active), reg_NL2 + st reg_ZERO, [reg_NL2+%lo(foreign_function_call_active)] /* Load the rest of lisp state. */ - load(_current_dynamic_space_free_pointer, reg_NL2) + load(current_dynamic_space_free_pointer, reg_NL2) add reg_NL2, reg_ALLOC, reg_ALLOC - load(_current_binding_stack_pointer, reg_BSP) - load(_current_control_stack_pointer, reg_CSP) - load(_current_control_frame_pointer, reg_CFP) + load(current_binding_stack_pointer, reg_BSP) + load(current_control_stack_pointer, reg_CSP) + load(current_control_frame_pointer, reg_CFP) /* Get the return address back. */ ld [reg_CFP+4], reg_LIP @@ -267,7 +236,7 @@ _call_into_c: ret nop - SET_SIZE(_call_into_c) + SET_SIZE(call_into_c) #if 0 /* undefined_tramp and closure_tramp are now Lisp assembly routines. @@ -332,8 +301,8 @@ _closure_tramp: .text .align 8 - .global _function_end_breakpoint_guts -_function_end_breakpoint_guts: + .global function_end_breakpoint_guts +function_end_breakpoint_guts: .word type_ReturnPcHeader b 1f nop @@ -347,18 +316,18 @@ _function_end_breakpoint_guts: mov reg_NIL, reg_A5 1: - .global _function_end_breakpoint_trap -_function_end_breakpoint_trap: + .global function_end_breakpoint_trap +function_end_breakpoint_trap: unimp trap_FunctionEndBreakpoint b 1b nop - .global _function_end_breakpoint_end -_function_end_breakpoint_end: + .global function_end_breakpoint_end +function_end_breakpoint_end: - .global _flush_icache - FUNCDEF(_flush_icache) -_flush_icache: + .global flush_icache + FUNCDEF(flush_icache) +flush_icache: add %o0,%o1,%o2 1: iflush %o0 ! flush instruction cache add %o0,8,%o0 @@ -367,34 +336,34 @@ _flush_icache: nop retl ! return from leaf routine nop - SET_SIZE(_flush_icache) + SET_SIZE(flush_icache) - .global _do_pending_interrupt - FUNCDEF(_do_pending_interrupt) -_do_pending_interrupt: + .global do_pending_interrupt + FUNCDEF(do_pending_interrupt) +do_pending_interrupt: unimp trap_PendingInterrupt retl nop - SET_SIZE(_do_pending_interrupt) + SET_SIZE(do_pending_interrupt) #ifdef trap_DynamicSpaceOverflowError - .global _do_dynamic_space_overflow_error - FUNCDEF(_do_dynamic_space_overflow_error) -_do_dynamic_space_overflow_error: + .global do_dynamic_space_overflow_error + FUNCDEF(do_dynamic_space_overflow_error) +do_dynamic_space_overflow_error: unimp trap_DynamicSpaceOverflowError retl nop - SET_SIZE(_do_dynamic_space_overflow_error) + SET_SIZE(do_dynamic_space_overflow_error) #endif #ifdef trap_DynamicSpaceOverflowWarning - .global _do_dynamic_space_overflow_warning - FUNCDEF(_do_dynamic_space_overflow_warning) -_do_dynamic_space_overflow_warning: + .global do_dynamic_space_overflow_warning + FUNCDEF(do_dynamic_space_overflow_warning) +do_dynamic_space_overflow_warning: unimp trap_DynamicSpaceOverflowWarning retl nop - SET_SIZE(_do_dynamic_space_overflow_warning) + SET_SIZE(do_dynamic_space_overflow_warning) #endif #ifdef LINKAGE_TABLE @@ -411,10 +380,10 @@ _do_dynamic_space_overflow_warning: * registers have been saved, including FP registers. Hence, no need * to save them. */ - .global _lazy_resolve_linkage - .global _resolve_linkage_tramp - FUNCDEF(_resolve_linkage_tramp) -_resolve_linkage_tramp: + .global lazy_resolve_linkage + .global resolve_linkage_tramp + FUNCDEF(resolve_linkage_tramp) +resolve_linkage_tramp: /* * At this point, all of the global %g registers have been * saved by call_into_c, so we can use them as temps. %g2, @@ -433,7 +402,7 @@ _resolve_linkage_tramp: save %sp, -FRAMESIZE, %sp /* %g2 tells where we came from in the linkage table */ - call _lazy_resolve_linkage + call lazy_resolve_linkage mov reg_NIL, %o0 ! in the delay slot mov %o0, reg_NIL @@ -443,15 +412,15 @@ _resolve_linkage_tramp: jmp reg_NIL nop - SET_SIZE(_resolve_linkage_tramp) + SET_SIZE(resolve_linkage_tramp) - .global _undefined_foreign_symbol_trap - FUNCDEF(_undefined_foreign_symbol_trap) + .global undefined_foreign_symbol_trap + FUNCDEF(undefined_foreign_symbol_trap) /* * When we get called, %o0 contains the address of the data_vector object * which is a string naming the bad symbol. */ -_undefined_foreign_symbol_trap: +undefined_foreign_symbol_trap: /* Need to restore all the global registers with the Lisp values that were saved away in call_into_c. (This routine is only called from @@ -463,10 +432,10 @@ _undefined_foreign_symbol_trap: */ - load(_current_dynamic_space_free_pointer, reg_ALLOC) - load(_current_binding_stack_pointer, reg_BSP) - load(_current_control_stack_pointer, reg_CSP) - load(_current_control_frame_pointer, reg_CFP) + load(current_dynamic_space_free_pointer, reg_ALLOC) + load(current_binding_stack_pointer, reg_BSP) + load(current_control_stack_pointer, reg_CSP) + load(current_control_frame_pointer, reg_CFP) set NIL, reg_NIL @@ -493,9 +462,9 @@ _undefined_foreign_symbol_trap: * a sparc v9, the Lisp code can actually use all 32 double-float * registers. For later. */ - .global _fpu_save - FUNCDEF(_fpu_save) -_fpu_save: + .global fpu_save + FUNCDEF(fpu_save) +fpu_save: std %f0, [%o0 + 4*0] std %f2, [%o0 + 4*2] std %f4, [%o0 + 4*4] @@ -535,11 +504,11 @@ _fpu_save: #endif retl nop - SET_SIZE(_fpu_save) + SET_SIZE(fpu_save) - .global _fpu_restore - FUNCDEF(_fpu_restore) -_fpu_restore: + .global fpu_restore + FUNCDEF(fpu_restore) +fpu_restore: ldd [%o0 + 4*0], %f0 ldd [%o0 + 4*2], %f2 ldd [%o0 + 4*4], %f4 @@ -579,254 +548,8 @@ _fpu_restore: #endif retl nop - SET_SIZE(_fpu_restore) - -#ifndef SOLARIS - -/****************************************************************\ -* State saving and restoring. -\****************************************************************/ - - - .global _call_on_stack -_call_on_stack: - call %o0 - sub %o1, SA(MINFRAME), %sp - unimp 0 + SET_SIZE(fpu_restore) - .global _save_state -_save_state: - save %sp, -(SA(8*4)+SA(MINFRAME)), %sp - ta ST_FLUSH_WINDOWS - st %i7, [%sp+SA(MINFRAME)] - st %g1, [%sp+SA(MINFRAME)+4] - std %g2, [%sp+SA(MINFRAME)+8] - std %g4, [%sp+SA(MINFRAME)+16] - std %g6, [%sp+SA(MINFRAME)+24] - ! ### Should also save the FP state. - mov %i1, %o1 - call %i0 - mov %sp, %o0 - mov %o0, %i0 -restore_state: - ld [%sp+SA(MINFRAME)+4], %g1 - ldd [%sp+SA(MINFRAME)+8], %g2 - ldd [%sp+SA(MINFRAME)+16], %g4 - ldd [%sp+SA(MINFRAME)+24], %g6 - ret - restore - - .global _restore_state -_restore_state: - ta ST_FLUSH_WINDOWS - mov %o0, %fp - mov %o1, %i0 - restore - ld [%sp+SA(MINFRAME)], %i7 - b restore_state - mov %o0, %i0 - - - -/****************************************************************\ - -We need our own version of sigtramp. - -\****************************************************************/ - - .global __sigtramp, __sigfunc -__sigtramp: - ! - ! On entry sp points to: - ! 0 - 63: window save area - ! 64: signal number - ! 68: signal code - ! 72: pointer to sigcontext - ! 76: addr parameter - ! - ! A sigcontext looks like: -#define SC_ONSTACK 0 -#define SC_MASK 4 -#define SC_SP 8 -#define SC_PC 12 -#define SC_NPC 16 -#define SC_PSR 20 -#define SC_G1 24 -#define SC_O0 28 - ! - ! We change sc_g1 to point to a reg save area: -#define IREGS_SAVE 0 -#define FPREGS_SAVE (32*4) -#define Y_SAVE (64*4) -#define FSR_SAVE (65*4) -#define REGSAVESIZE (66*4) - ! - ! After we allocate space for the reg save area, the stack looks like: - ! < window save area, etc > -#define REGSAVEOFF SA(MINFRAME) -#define IREGSOFF REGSAVEOFF+IREGS_SAVE -#define FPREGSOFF REGSAVEOFF+FPREGS_SAVE -#define YOFF REGSAVEOFF+Y_SAVE -#define FSROFF REGSAVEOFF+FSR_SAVE -#define ORIGSIGNUMOFF REGSAVEOFF+REGSAVESIZE -#define ORIGCODEOFF ORIGSIGNUMOFF+4 -#define ORIGSCPOFF ORIGSIGNUMOFF+8 -#define ORIGADDROFF ORIGSIGNUMOFF+12 - - ! Allocate space for the reg save area. - sub %sp, REGSAVESIZE+SA(MINFRAME)-64, %sp - - ! Save integer registers. - ! Note: the globals and outs are good, but the locals and ins have - ! been trashed. But luckly, they have been saved on the stack. - ! So we need to extract the saved stack pointer from the sigcontext - ! to determine where they are. - std %g0, [%sp+IREGSOFF] - std %g2, [%sp+IREGSOFF+8] - std %g4, [%sp+IREGSOFF+16] - std %g6, [%sp+IREGSOFF+24] - std %o0, [%sp+IREGSOFF+32] - std %o2, [%sp+IREGSOFF+40] - ld [%sp+ORIGSCPOFF], %o2 - ld [%o2+SC_SP], %o0 - std %o4, [%sp+IREGSOFF+48] - st %o0, [%sp+IREGSOFF+56] - st %o7, [%sp+IREGSOFF+60] - - ldd [%o0], %l0 - ldd [%o0+8], %l2 - ldd [%o0+16], %l4 - ldd [%o0+24], %l6 - ldd [%o0+32], %i0 - ldd [%o0+40], %i2 - ldd [%o0+48], %i4 - ldd [%o0+56], %i6 - std %l0, [%sp+IREGSOFF+64] - std %l2, [%sp+IREGSOFF+72] - std %l4, [%sp+IREGSOFF+80] - std %l6, [%sp+IREGSOFF+88] - std %i0, [%sp+IREGSOFF+96] - std %i2, [%sp+IREGSOFF+104] - std %i4, [%sp+IREGSOFF+112] - std %i6, [%sp+IREGSOFF+120] - - ! Check to see if we need to save the fp regs. - ld [%o2+SC_PSR], %l5 ! get psr - set PSR_EF, %l0 - mov %y, %l2 ! save y - btst %l0, %l5 ! is FPU enabled? - bz 1f ! if not skip FPU save - st %l2, [%sp + YOFF] - - ! save all fpu registers. - std %f0, [%sp+FPREGSOFF+(0*4)] - std %f2, [%sp+FPREGSOFF+(2*4)] - std %f4, [%sp+FPREGSOFF+(4*4)] - std %f6, [%sp+FPREGSOFF+(6*4)] - std %f8, [%sp+FPREGSOFF+(8*4)] - std %f10, [%sp+FPREGSOFF+(10*4)] - std %f12, [%sp+FPREGSOFF+(12*4)] - std %f14, [%sp+FPREGSOFF+(14*4)] - std %f16, [%sp+FPREGSOFF+(16*4)] - std %f18, [%sp+FPREGSOFF+(18*4)] - std %f20, [%sp+FPREGSOFF+(20*4)] - std %f22, [%sp+FPREGSOFF+(22*4)] - std %f24, [%sp+FPREGSOFF+(24*4)] - std %f26, [%sp+FPREGSOFF+(26*4)] - std %f28, [%sp+FPREGSOFF+(28*4)] - std %f30, [%sp+FPREGSOFF+(30*4)] - st %fsr, [%sp+FSROFF] ! save old fsr -1: - - ld [%sp+ORIGSIGNUMOFF], %o0! get signal number - set __sigfunc, %g1 ! get array of function ptrs - sll %o0, 2, %g2 ! scale signal number for index - ld [%g1+%g2], %g1 ! get func - ld [%sp+ORIGCODEOFF], %o1 ! get code - ! %o2 is already loaded with scp - add %sp, REGSAVEOFF, %o3 ! compute pointer to reg save area - st %o3, [%o2 + SC_G1] ! save in sc_g1. - call %g1 ! (*_sigfunc[sig])(sig,code,scp,addr) - ld [%sp+ORIGADDROFF], %o3 ! get addr - - ! Recompute scp, and drop into _sigreturn - ld [%sp+ORIGSCPOFF], %o0 ! get scp - - .global _sigreturn -_sigreturn: - ! Load g1 with addr of reg save area (from sc_g1) - ld [%o0+SC_G1], %g1 - - ! Move values we cannot restore directory into real sigcontext. - ld [%g1+IREGS_SAVE+(4*1)], %l0 ! g1 - ld [%g1+IREGS_SAVE+(4*8)], %l1 ! o0 - ld [%g1+IREGS_SAVE+(4*14)], %l2 ! sp - st %l0, [%o0+SC_G1] - st %l1, [%o0+SC_O0] - st %l2, [%o0+SC_SP] - - ld [%o0+SC_PSR], %l2 ! get psr - set PSR_EF, %l0 - ld [%g1+Y_SAVE], %l1 ! restore y - btst %l0, %l2 ! is FPU enabled? - bz 2f ! if not skip FPU restore - mov %l1, %y - - ldd [%g1+FPREGS_SAVE+(0*4)], %f0 ! restore all fpu registers. - ldd [%g1+FPREGS_SAVE+(2*4)], %f2 - ldd [%g1+FPREGS_SAVE+(4*4)], %f4 - ldd [%g1+FPREGS_SAVE+(6*4)], %f6 - ldd [%g1+FPREGS_SAVE+(8*4)], %f8 - ldd [%g1+FPREGS_SAVE+(10*4)], %f10 - ldd [%g1+FPREGS_SAVE+(12*4)], %f12 - ldd [%g1+FPREGS_SAVE+(14*4)], %f14 - ldd [%g1+FPREGS_SAVE+(16*4)], %f16 - ldd [%g1+FPREGS_SAVE+(18*4)], %f18 - ldd [%g1+FPREGS_SAVE+(20*4)], %f20 - ldd [%g1+FPREGS_SAVE+(22*4)], %f22 - ldd [%g1+FPREGS_SAVE+(24*4)], %f24 - ldd [%g1+FPREGS_SAVE+(26*4)], %f26 - ldd [%g1+FPREGS_SAVE+(28*4)], %f28 - ldd [%g1+FPREGS_SAVE+(30*4)], %f30 - ld [%g1+FSR_SAVE], %fsr ! restore old fsr -2: - - ! The locals and in are restored from the stack, so we have to put - ! them there. - ld [%o0+SC_SP], %o1 - ldd [%g1+IREGS_SAVE+(16*4)], %l0 - ldd [%g1+IREGS_SAVE+(18*4)], %l2 - ldd [%g1+IREGS_SAVE+(20*4)], %l4 - ldd [%g1+IREGS_SAVE+(22*4)], %l6 - ldd [%g1+IREGS_SAVE+(24*4)], %i0 - ldd [%g1+IREGS_SAVE+(26*4)], %i2 - ldd [%g1+IREGS_SAVE+(28*4)], %i4 - ldd [%g1+IREGS_SAVE+(30*4)], %i6 - std %l0, [%o1+(0*4)] - std %l2, [%o1+(2*4)] - std %l4, [%o1+(4*4)] - std %l6, [%o1+(6*4)] - std %i0, [%o1+(8*4)] - std %i2, [%o1+(10*4)] - std %i4, [%o1+(12*4)] - std %i6, [%o1+(14*4)] - - ! Restore the globals and outs. Do not restore %g1, %o0, or %sp - ! because they get restored from the sigcontext. - ldd [%g1+IREGS_SAVE+(2*4)], %g2 - ldd [%g1+IREGS_SAVE+(4*4)], %g4 - ldd [%g1+IREGS_SAVE+(6*4)], %g6 - ld [%g1+IREGS_SAVE+(9*4)], %o1 - ldd [%g1+IREGS_SAVE+(10*4)], %o2 - ldd [%g1+IREGS_SAVE+(12*4)], %o4 - ld [%g1+IREGS_SAVE+(15*4)], %o7 - - set 139, %g1 ! sigcleanup system call - t 0 - unimp 0 ! just in case it returns - /*NOTREACHED*/ - -#else /* SOLARIS */ .global save_context FUNCDEF(save_context) save_context: @@ -834,8 +557,6 @@ save_context: retl ! return from leaf routine nop SET_SIZE(save_context) - -#endif /* * Local variables: * tab-width: 8 View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/compare/b038df8de36e85365670a50b…

1 0

[git] CMU Common Lisp branch master updated. begin-x87-removal-21-gecd7d26
by rtoy＠common-lisp.net 08 Apr '15

08 Apr '15

This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "CMU Common Lisp". The branch, master has been updated via ecd7d26d363b65a174ab04a1c2a802fe8ca96ddc (commit) from 5abd66f6073fabd08af8e0155f74cd338a28d280 (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit ecd7d26d363b65a174ab04a1c2a802fe8ca96ddc Author: Raymond Toy <toy.raymond(a)gmail.com> Date: Tue Apr 29 22:44:04 2014 -0700 Oops. Only compile float-sse2 on x86 machines! diff --git a/src/tools/comcom.lisp b/src/tools/comcom.lisp index b75a588..9ad7973 100644 --- a/src/tools/comcom.lisp +++ b/src/tools/comcom.lisp @@ -173,8 +173,9 @@ (when *load-stuff* (load (vmdir "target:assembly/support"))) (comf (vmdir "target:compiler/move")) -(comf (vmdir "target:compiler/float-sse2") - :byte-compile *byte-compile*) +(when (c:target-featurep :x86) + (comf (vmdir "target:compiler/float-sse2") + :byte-compile *byte-compile*)) (comf (vmdir "target:compiler/sap") :byte-compile *byte-compile*) (when (c:target-featurep :x86) (comf (vmdir "target:compiler/sse2-sap") ----------------------------------------------------------------------- Summary of changes: src/tools/comcom.lisp | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) hooks/post-receive -- CMU Common Lisp

1 0

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

cmucl-cvs April 2015