Raymond Toy pushed to branch rtoy-mmap-anon-control-and-binding-stacks at cmucl / cmucl

Commits: 1d604dc6 by Raymond Toy at 2015-12-19T09:32:37-08:00 Add tests for asinh, taken from fdlibm-js.

- - - - - 9e8b92a9 by Raymond Toy at 2015-12-19T09:38:25-08:00 Add acosh tests.

- - - - - fab01803 by Raymond Toy at 2015-12-19T09:46:21-08:00 Add atanh tests.

- - - - - aeff3c51 by Raymond Toy at 2015-12-19T09:55:25-08:00 Add cosh tests.

- - - - - 4c29796b by Raymond Toy at 2015-12-19T10:29:09-08:00 Add exp tests.

- - - - - 106b9498 by Raymond Toy at 2015-12-20T12:18:26-08:00 Add log tests.

- - - - - d1ef807a by Raymond Toy at 2015-12-20T12:33:05-08:00 Add sinh tests.

- - - - - 4b556124 by Raymond Toy at 2015-12-20T12:38:54-08:00 Add tanh tests.

- - - - - 507f6d9e by Raymond Toy at 2015-12-22T21:35:14-08:00 Add inexact exception test for asinh.

- - - - - a53d7ef4 by Raymond Toy at 2015-12-23T14:14:13-08:00 Use setexception to raise the inexact exception.

o Update fdlibm.h and setexception.c to support the inexact execption. o Use this in asinh.

Tests pass.

- - - - - 0d53bc7f by Raymond Toy at 2015-12-23T14:24:49-08:00 Merge branch 'master' into rtoy-setexception-inexact

- - - - - e655d017 by Raymond Toy at 2015-12-23T14:30:10-08:00 Use setexception to raise the inexact exception for asin.

o Add tests for this o Use setexception for inexact in e_asin.c.

- - - - - 8b36c06e by Raymond Toy at 2015-12-23T15:48:58-08:00 Group the inexact exception test with the exceptions tests.

- - - - - b4c91767 by Raymond Toy at 2015-12-23T15:55:19-08:00 Use setexception to raise the inexact exception for exp.

o Add tests for this o Use setexception for inexact in e_exp.c.

- - - - - e90e91d4 by Raymond Toy at 2015-12-23T19:43:17-08:00 Use setexception to raise the inexact exception for sinh.

- - - - - d448ca78 by Raymond Toy at 2015-12-23T19:49:21-08:00 Use setexception to raise the inexact exception for cos.

- - - - - 71bdff74 by Raymond Toy at 2015-12-24T08:54:03-08:00 Use setexception to raise the inexact exception for sin.

- - - - - a31150c5 by Raymond Toy at 2015-12-24T08:59:29-08:00 Use setexception to raise the inexact exception for tan.

- - - - - ae70cdd3 by Raymond Toy at 2015-12-24T09:06:54-08:00 Use setexception to raise the inexact exception for atan.

- - - - - 89097cd0 by Raymond Toy at 2015-12-24T09:15:27-08:00 Use setexception to raise the inexact exception for %expm1.

- - - - - 91ff3607 by Raymond Toy at 2015-12-24T09:23:06-08:00 Use setexception to raise the inexact exception for %log1p.

- - - - - b9e3a511 by Raymond Toy at 2015-12-24T09:29:08-08:00 Use setexception to raise the inexact exception for tanh.

Note that original code didn't actually signal inexact probably because the compiler constant-folded one - tiny to one.

- - - - - 97bd0eaa by Raymond Toy at 2015-12-24T10:37:57-08:00 Add WITH-FLOAT-TRAPS-ENABLED to enable specific traps.

This works like WITH-FLOAT-TRAPS-MASKED, except that the specified traps are enabled.

Use this in fdlibm to enable the inexact trap.

- - - - - 5721ddd2 by Raymond Toy at 2015-12-24T11:46:36-08:00 Simplify WITH-FLOAT-TRAPS-MASKED and WITH-FLOAT-TRAPS-ENABLED.

Merge the body of both macros into one since they only differ in how the bits are merged with the actual mode bits.

- - - - - d2a8d5c7 by Raymond Toy at 2015-12-24T22:25:13-08:00 ADD docstrings for WITH-FLOAT-TRAPS-MASKED and WITH-FLOAT-TRAPS-ENABLED.

- - - - - 519d5133 by Raymond Toy at 2015-12-24T22:47:24-08:00 (setf floating-point-modes) wants (unsigned-byte 24)

When enabling traps, need to take just the low 24 bits of the arg because (setf floating-point-modes) wants an (unsigned-byte 24) argument. The logorc2 makes the result negative when enabling traps.

- - - - - 46e43aed by Raymond Toy at 2015-12-24T22:48:49-08:00 Use correct package (EXT) for WITH-FLOAT-TRAPS-MASKED.

Also replae WITH-INXACT-EXCEPTION-ENABLED with WITH-FLOAT-TRAPS-ENABLED.

All tests still pass, as expected.

- - - - - 38e8ce5c by Raymond Toy at 2015-12-26T09:09:56-08:00 Fix bug on sparc and clean up.

On sparc and ppc (setf vm:floating-point-modes) takes an (unsigned-byte 32) arg, so adjust the ldb byte appopriately.

Clean up code by putting the docstring into the macro.

- - - - - 6cc16b9b by Raymond Toy at 2015-12-26T09:11:40-08:00 Regenerated du to float-traps.lisp changes.

- - - - - 55b541e5 by Raymond Toy at 2015-12-26T09:49:25-08:00 Add shell script to run the test suite.

This makes it quite a bit easier to run the test suite instead of trying to remember exactly how to invoke it from the command line.

- - - - - 0fc0061b by Raymond Toy at 2015-12-27T10:16:45-08:00 Disable FP traps when printing arithmetic-error messages

Printing of FP numbers can signal some traps like overflow, underflow, inexact, or denormalized-operand, so we need to disable these traps when printing out the error message for arithmetic errors.

- - - - - 62acaf64 by Raymond Toy at 2015-12-27T10:36:59-08:00 Merge branch 'master' into rtoy-setexception-inexact

- - - - - 90b9651b by Raymond Toy at 2015-12-27T21:02:14-08:00 Clean up with-float-traps macro.

* Add some comments. * Change x86 (setf floating-point-modes) to accept (unsigned-byte 32). * Remove unneeded x86 conditionalization on the byte size.

- - - - - 80d7ca4e by Raymond Toy at 2015-12-28T10:26:27-08:00 Fix compiler warnings by removing unused vars.

- - - - - 6a6908fb by Raymond Toy at 2015-12-28T10:28:57-08:00 Remove trailing blank line.

- - - - - fc1c9daa by Raymond Toy at 2015-12-28T10:31:55-08:00 Replace with-inexact-exception-enabled with with-float-traps-enabled.

- - - - - 5b83139e by Raymond Toy at 2015-12-28T18:37:04+00:00 Use setexception to set inexact exception

Fix issue #12 by replacing the code with an explicit call to set the inexact exception when needed.

- - - - - b4771d76 by Raymond Toy at 2015-12-29T16:34:46-08:00 Add %SET-FLOATING-POINT-MODES and %GET-FLOATING-POINT-MODES functions.

To aid in debugging floating point modes, add two new functions:

o %SET-FLOATING-POINT-MODES is like SET-FLOATING-POINT-MODES but applies the result to a specified mode value, returning the new mode value (as an integer). This is useful for investigating different mode values without modifying the actual hardware mode. o %GET-FLOATING-POINT-MODES is like GET-FLOATING-POINT-MODES but uses an integer argument instead of the actual floating-point mode. Useful when used with %SET-FLOATING-POINT-MODE or on its own.

- - - - - a65cf4a4 by Raymond Toy at 2015-12-29T18:10:00-08:00 Regenerate due to new functions.

- - - - - edb5af9b by Raymond Toy at 2015-12-29T18:24:24-08:00 WITH-FLOAT-TRAPS-ENABLED was incorrectly setting accrued exceptions.

Fix issue #14.

WITH-FLOAT-TRAPS-ENABLED was leaving the accrued (and current) exceptions unchanged, but it should have cleared out any values there that matched the exceptions to be enabled. Without this, the next x87 operation would signal an exception if an accrued exception matched an enabled exception. This was the cause of issue #14. (Note that for x87, the accrued exception is the same as current exception.)

- - - - - a610d96c by Raymond Toy at 2015-12-30T02:36:39+00:00 Merge branch 'rtoy-issue-14' into 'master'

WITH-FLOAT-TRAPS-ENABLED was incorrectly setting accrued exceptions.

Fix issue #14.

WITH-FLOAT-TRAPS-ENABLED was leaving the accrued (and current) exceptions unchanged, but it should have cleared out any values there that matched the exceptions to be enabled. Without this, the next x87 operation would signal an exception if an accrued exception matched an enabled exception. This was the cause of issue #14. (Note that for x87, the accrued exception is the same as current exception.)

See merge request !5 - - - - - 16ae6709 by Raymond Toy at 2015-12-31T13:08:00-08:00 Rename %get/%set-floating-point-modes to encode/decode-floating-point-modes.

- - - - - e28e38ce by Raymond Toy at 2015-12-31T14:02:26-08:00 Add better description of the output of x87-floating-point-modes

- - - - - 521f8392 by Raymond Toy at 2015-12-31T15:38:08-08:00 Handle search lists in pathname-match-p.

Allow search lists in pathname-match-p. For each arg, we enumerate the possible values of the search list and try to find a match between the path and the wild path. If there's a match, return true.

Tests added for some cases of pathname-match-p with search lists.

Fix issue #16.

- - - - - 107f067a by Raymond Toy at 2016-01-01T08:26:31-08:00 Regenerated.

- - - - - 6162f24e by Raymond Toy at 2016-01-01T09:25:09-08:00 Add more to docstring for set-system-external-format.

- - - - - f3b73541 by Raymond Toy at 2016-01-01T09:30:18-08:00 Add special case for (expt 0 power)

We know the result of (expt 0 power) so return it immediately without first checking if the power exceeds the limit.

Also took the opportunity to add a better message to the intexp-limit-error condition to make it more explicit what is being computed and why it's failing.

Tests added too.

- - - - - c7e71ee2 by Raymond Toy at 2016-01-03T18:11:53+00:00 Merge branch 'rtoy-issue-16' into 'master'

Handle search lists in pathname-match-p.

Allow search lists in pathname-match-p. For each arg, we enumerate the possible values of the search list and try to find a match between the path and the wild path. If there's a match, return true.

Tests added for some cases of pathname-match-p with search lists.

Fix issue #16.

See merge request !6 - - - - - a5805ca0 by Raymond Toy at 2016-01-06T21:00:07-08:00 If -dynamic-space-size is 0, use the max heap.

If the user specifies -dynamic-space-size 0, then use the platform-specific maximum heap size.

Update the docstring for the switch too.

- - - - - 90855b07 by Raymond Toy at 2016-01-06T21:02:16-08:00 Regenerated.

- - - - - 95f2932b by Raymond Toy at 2016-01-07T17:37:42-08:00 Update according to logs.

- - - - - d437c0f6 by Raymond Toy at 2016-01-09T01:29:32-08:00 Update to asdf 3.1.6.9 to get one fix for cmucl.

- - - - - ccabe7f8 by Raymond Toy at 2016-01-09T01:29:32-08:00 Update from logs

- - - - - 7fe61a25 by Raymond Toy at 2016-01-09T09:43:13-08:00 Fix bug in setting max heap size on sparc.

Forgot to put in an else clause if the specified size was 0.

- - - - - 5c10ab93 by Raymond Toy at 2016-01-09T10:50:21-08:00 Add list of features to README.

(Taken from the wiki intro.)

- - - - - e63bc1e9 by Raymond Toy at 2016-01-09T19:00:37-08:00 Handle FP exceptions better.

Don't restore the fpu state from the context in the interrupt handler code (interrupt_handle_now) because that just makes the fpu state the same as the sigcontext that received the exception. I think this was done to reset the x87 fpu precision to 53-bit so that lisp can continue with default double-float rounding. This isn't needed anymore since lisp doesn't use x87 anymore.

In SIGFPE-HANDLER, don't modify the current fp state based on the state from the sigcontext.

These two items cause the arithmetic-error exception printer to trigger inexact when printing out the args. We add a few debugging prints for now so we can see what the FP state is in the handler. Remove them later.

- - - - - da2ff74d by Raymond Toy at 2016-01-10T14:13:10-08:00 Handle FPU exceptions better.

In sigfpe-handler, don't modify the modes; just use whatever they are. (They should be the default values.)

In with-float-traps-*, actually just restore the floating-point mode to the exact original mode instead of trying to mask things out.

- - - - - d9763e90 by Raymond Toy at 2016-01-10T15:42:41-08:00 In WITH-FLOAT-TRAPS-*, remove the unused junk modifying the state.

We just want to return the original modes, so remove all the old commented out stuff that was modifying the original modes to some strange state. This makes a lot more sense to me if WITH-FLOAT-TRAPS-* actually restored the modes exactly as they were before running the body.

- - - - - d7850f57 by Raymond Toy at 2016-01-12T21:21:40-08:00 Restore the FPU state before exiting.

Put an unwind-protect around the error calls. The cleanup form restores the floating-point modes from the sigcontext so that the mode is restored. This is needed, I think, because we throw so that the signal handler doesn't return so the sigcontext isn't restored. If we don't restore the fpu state, it's set to the default processor state. We want the default state when calling error.

In this way, things like (* 1d300 1d300) signals an overflow, and when we throw to top-level, the floating-point modes are restored to their original values they had before.

- - - - - 1fab9bf3 by Raymond Toy at 2016-01-13T21:34:39-08:00 Clean up sigfpe-handler; add comments.

- - - - - 94bb2d9d by Raymond Toy at 2016-01-16T16:02:25+00:00 Merge branch 'rtoy-15-handle-fpu-exceptions' into 'master'

Handle FPU exceptions better

Fix #15

Handle FPU exceptions better in sigfpe-handler. Linux now passes all of the tests, including the inexact tests.

We can correctly print out the operands (if available) when we receive an inexact exception.

The floating point modes are preserved as much as possible when we throw from an arithmetic-error.

See merge request !7 - - - - - 6ac8b5f6 by Raymond Toy at 2016-01-16T08:18:00-08:00 Better docstring for *environment-list*

Fix #17.

- - - - - f613124b by Raymond Toy at 2016-01-16T08:24:09-08:00 Better description for run-program :env

Fix #18.

- - - - - 17932a00 by Raymond Toy at 2016-01-16T08:33:55-08:00 Actually remove RESTORE_FPU's that were #if'ed out.

- - - - - 6feaee2d by Raymond Toy at 2016-01-16T08:37:03-08:00 Add comment on why RESTORE_FPU is needed.

- - - - - 06a68321 by Raymond Toy at 2016-01-16T12:58:43-08:00 Regenerated.

- - - - - 8058d410 by Raymond Toy at 2016-01-16T13:01:37-08:00 Fix up shld/shrd instructions.

o Need to define a new instruction format for these double shifts; they look like ext-reg-reg/mem but there's no width field. o Clean up emit-double-shift slightly. o Update double-shift-inst-printer-list to support both immediate shift or shifts in CL.

- - - - - ddc980d5 by Raymond Toy at 2016-01-16T14:34:19-08:00 Add bignum::%shld and bignum::%shrd

These are useful for multi-precision shifts. For x86, we can use the shld and shrd instructions. For others, we just use basic logical operations.

- - - - - 909ad007 by Raymond Toy at 2016-01-17T20:57:41-08:00 Indent nicely.

- - - - - 351351df by Raymond Toy at 2016-01-17T23:53:43-08:00 Simplify bignum-shld and bignum-shrd vops.

One temp variable for bignum-shld can be removed and the only temp variable for bignum-shld-c can be removed. Base this on the digit-ashr vops. This makes the vops simpler and faster.

- - - - - 23209c84 by Raymond Toy at 2016-01-23T14:28:45-08:00 Add orps and orpd SSE2 instructions.

- - - - - 187d987e by Raymond Toy at 2016-01-23T14:31:09-08:00 Use SSE2 instructions for MAKE-DOUBLE-FLOAT

Instead of storing the high and low words to memory and then loading it into the double-reg, use SSE2 instructions to directly create the double-float from the high and low words.

- - - - - b059caca by Raymond Toy at 2016-01-24T20:21:39-08:00 Clean up make-double-float vop.

Remove the :load-if stuff. Don't think it's needed.

- - - - - 1b324b5d by Raymond Toy at 2016-02-15T09:40:13-08:00 Update from logs.

- - - - - 8d6a01fb by Raymond Toy at 2016-02-25T21:30:29-08:00 Add note on building motifd and clm.

Mention that you need Motif to build motifd which is required for clm. Also say that the build error can be safely ignored if you do not need clm.

Fix issue #20

- - - - - 9e4c9d0a by Raymond Toy at 2016-02-28T21:12:18-08:00 Reduce maximum heap size for Linux.

According to the message from Chisheng Huang on cmucl-help, 2016-02-27, 32-bit Ubuntu 11.10 (in VirtualBox) cannot use the full heap space. There's something already allocated at address 0xb7b82000, so limit the max heap to address 0xb7b80000, for a total of 1530 MB instead of 1632 MB.

(It would be nice to be able to detect this somehow.)

- - - - - 4663279e by Raymond Toy at 2016-03-06T15:31:11-08:00 Remove bignum-shld and bignum-shrd vops and functions.

- - - - - ee6b86bf by Raymond Toy at 2016-03-12T15:22:06-08:00 Update from logs for snapshot.

- - - - - 184a5a0d by Raymond Toy at 2016-03-26T07:55:18-07:00 Update to asdf 3.1.7.

- - - - - e741d305 by Raymond Toy at 2016-05-07T20:38:24-07:00 Update.

- - - - - 583140fc by Raymond Toy at 2016-05-08T09:11:48-07:00 Merge branch 'master' into rtoy-mmap-anon-control-and-binding-stacks

- - - - -

43 changed files:

- BUILDING - README.md - + bin/run-tests.sh - src/code/commandline.lisp - src/code/error.lisp - src/code/exports.lisp - src/code/extfmts.lisp - src/code/float-trap.lisp - src/code/irrat.lisp - src/code/pathname.lisp - src/code/run-program.lisp - src/code/save.lisp - src/compiler/generic/vm-fndb.lisp - src/compiler/x86/arith.lisp - src/compiler/x86/float-sse2.lisp - src/compiler/x86/float.lisp - src/compiler/x86/insts.lisp - src/contrib/asdf/asdf.lisp - src/contrib/asdf/doc/asdf.html - src/contrib/asdf/doc/asdf.info - src/contrib/asdf/doc/asdf.pdf - src/general-info/release-21b.txt - src/i18n/locale/cmucl.pot - src/lisp/e_asin.c - src/lisp/e_cosh.c - src/lisp/e_exp.c - src/lisp/e_sinh.c - src/lisp/fdlibm.h - src/lisp/interrupt.c - src/lisp/k_cos.c - src/lisp/k_sin.c - src/lisp/k_tan.c - src/lisp/lisp.c - src/lisp/s_asinh.c - src/lisp/s_atan.c - src/lisp/s_expm1.c - src/lisp/s_log1p.c - src/lisp/s_scalbn.c - src/lisp/s_tanh.c - src/lisp/setexception.c - src/lisp/x86-arch.c - src/lisp/x86-validate-linux.h - tests/fdlibm.lisp

Changes:

===================================== BUILDING ===================================== --- a/BUILDING +++ b/BUILDING @@ -334,6 +334,18 @@ including CLX, CMUCL/Motif, the Motif debugger, inspector, and control panel, and the Hemlock editor. It will use the lisp executable and core of the given target.

+Note: To build with Motif (clm), you need to have the Motif libraries +available and headers available to build motifd, the clm Motif server. +OpenMotif is known to work. + +You may need to adjust the include paths and library paths in +src/motif/server/Config.* to match where Motif is installed if the +paths therein are incorrect. + +Unless you intend to use clm and motifd, you can safely ignore the +build failure. Everything else will have been compiled correctly; you +just can't use clm. + * bin/make-dist.sh [-bg] [-G group] [-O owner] target-directory version arch os

This script creates both main and extra distribution tarballs from the

===================================== README.md ===================================== --- a/README.md +++ b/README.md @@ -8,3 +8,45 @@ debugger and code profiler; and an Emacs-like editor implemented in Common Lisp. CMUCL is maintained by a team of volunteers collaborating over the Internet, and is mostly in the public domain.

+Here is a summary of its main features: + +* support for **static arrays** that are never moved by GC but are + properly removed when no longer referenced. +* **Unicode** support, including many of the most common external + formats such as UTF-8 and support for handling Unix, DOS, and + Mac end-of-line schemes. +* native **double-double floats** including complex double-double + floats and specialized arrays for double-double floats and and + complex double-double floats that give approximately 106 bits + (32 digits) of precision. +* a **sophisticated native-code compiler** which is capable of + powerful type inferences, and generates code competitive in + speed with C compilers. +* **generational garbage collection** on all supported + architectures. +* **multiprocessing capability** on the x86 ports. +* a foreign function interface which allows interfacing with C code + and system libraries, including shared libraries on most platforms, + and direct access to Unix system calls. +* support for interprocess communication and remote procedure calls. +* an implementation of CLOS, the [Common Lisp Object + System](http://en.wikipedia.org/wiki/Common_Lisp_Object_System), + which includes multimethods and a metaobject protocol. +* a graphical source-level debugger using a Motif interface, and a + code profiler. +* an interface to the X11 Window System (CLX), and a sophisticated + graphical widget library ([Garnet](https://www.cs.cmu.edu/~garnet/), + available separately). +* programmer-extensible input and output streams ([Gray + Streams](http://www.nhplace.com/kent/CL/Issues/stream-definition-by-user.html) + and + [simple-streams](http://www.franz.com/support/documentation/current/doc/streams.htm)). +* an Emacs-like editor, + [Hemlock](http://cmucl.org/hemlock/index.html), implemented in + Common Lisp. +* **freely redistributable**: free, with full source code (most of + which is in the public domain) and no strings attached (and no + warranty). Like the GNU/Linux and *BSD operating systems, CMUCL is + maintained and improved by a team of volunteers collaborating over + the Internet. +

===================================== bin/run-tests.sh ===================================== --- /dev/null +++ b/bin/run-tests.sh @@ -0,0 +1,50 @@ +#! /bin/bash + +# Run the testsuite. +# +# By default, all the tests are run, but if additional args are given, +# then just those tests are run. + +usage() { + echo "run-tests.sh [?] [-l lisp] [tests]" + echo " -l lisp Lisp to use for the tests; defaults to lisp" + echo " -? This help message" + echo "" + echo "Run the test suite" + echo "" + echo "Any remaining args are the names of the tests to run." + echo "These are basically the file names (without extension)" + echo "in the tests/ directory." + echo "" + echo "This script expects to be run from the top level of the" + echo "cmucl source tree. That is, is should be invoked as" + echo "bin/run-tests.sh" + exit 0; +} + +LISP=lisp +while getopts "h?l:" arg +do + case $arg in + l) LISP=$OPTARG ;; + ?) usage ;; + esac +done + +# Shift out the options +shift $[$OPTIND - 1] + +if [ $# -eq 0 ]; then + # No args so run all the tests + $LISP -noinit -load tests/run-tests.lisp -eval '(cmucl-test-runner:run-all-tests)' +else + # Run selected files. Convert each file name to uppercase and append "-TESTS" + result="" + for f in $* + do + new=`echo $f | tr '[a-z]' '[A-Z]'` + result="$result ""$new-TESTS" + done + $LISP -noinit -load tests/run-tests.lisp -eval "(progn (cmucl-test-runner:load-test-files) (cmucl-test-runner:run-test $result))" +fi +

===================================== src/code/commandline.lisp ===================================== --- a/src/code/commandline.lisp +++ b/src/code/commandline.lisp @@ -283,8 +283,9 @@

(defswitch "dynamic-space-size" nil "Specifies the number of megabytes that should be allocated to the - heap. If not specified, a platform-specific default is used. The - actual maximum allowed heap size is platform-specific." + heap. If not specified, a platform-specific default is used. If 0, + the platform-specific maximum heap size is used. The actual maximum + allowed heap size is platform-specific." "megabytes")

(defswitch "read-only-space-size" nil

===================================== src/code/error.lisp ===================================== --- a/src/code/error.lisp +++ b/src/code/error.lisp @@ -1138,9 +1138,14 @@ (format stream (intl:gettext "Arithmetic error ~S signalled.") (type-of condition)) (when (arithmetic-error-operation condition) - (format stream (intl:gettext "~%Operation was ~S, operands ~S.") - (arithmetic-error-operation condition) - (arithmetic-error-operands condition)))))) + ;; Printing the operands can signal these FP traps, so + ;; disable them while we're printing out the error + ;; message. + (with-float-traps-masked (:overflow :underflow :inexact + #+x86 :denormalized-operand) + (format stream (intl:gettext "~%Operation was ~S, operands ~S.") + (arithmetic-error-operation condition) + (arithmetic-error-operands condition)))))))

(define-condition division-by-zero (arithmetic-error) ()) (define-condition floating-point-overflow (arithmetic-error) ())

===================================== src/code/exports.lisp ===================================== --- a/src/code/exports.lisp +++ b/src/code/exports.lisp @@ -1579,11 +1579,15 @@ "DOUBLE-FLOAT-POSITIVE-INFINITY" "LONG-FLOAT-POSITIVE-INFINITY" "SINGLE-FLOAT-NEGATIVE-INFINITY" "SHORT-FLOAT-NEGATIVE-INFINITY" "DOUBLE-FLOAT-NEGATIVE-INFINITY" "LONG-FLOAT-NEGATIVE-INFINITY" - "GET-FLOATING-POINT-MODES" "SET-FLOATING-POINT-MODES" + "GET-FLOATING-POINT-MODES" + "SET-FLOATING-POINT-MODES" + "ENCODE-FLOATING-POINT-MODES" + "DECODE-FLOATING-POINT-MODES" "FLOAT-DENORMALIZED-P" "FLOAT-INFINITY-P" "FLOAT-NAN-P" "FLOAT-TRAPPING-NAN-P" "FLOAT-SIGNALING-NAN-P" - "WITH-FLOAT-TRAPS-MASKED") + "WITH-FLOAT-TRAPS-MASKED" + "WITH-FLOAT-TRAPS-ENABLED") ;; More float extensions #+double-double (:export "LEAST-POSITIVE-NORMALIZED-DOUBLE-DOUBLE-FLOAT"

===================================== src/code/extfmts.lisp ===================================== --- a/src/code/extfmts.lisp +++ b/src/code/extfmts.lisp @@ -1133,9 +1133,12 @@ character and illegal outputs are replaced by a question mark.") The standard streams are sys::*stdin*, sys::*stdout*, and sys::*stderr*, which are normally the input and/or output streams for *standard-input* and *standard-output*. Also sets sys::*tty* - (normally *terminal-io* to the given external format. If the - optional argument Filenames is gvien, then the filename encoding is - set to the specified format." + (normally *terminal-io* to the given external format. The value of + *default-external-format* is not changed. + + If the optional argument Filenames is given, then the filename + encoding is set to the specified format, if it has not already been + specified previously." (unless (find-external-format terminal) (error (intl:gettext "Can't find external-format ~S.") terminal)) (setf (stream-external-format sys:*stdin*) terminal

===================================== src/code/float-trap.lisp ===================================== --- a/src/code/float-trap.lisp +++ b/src/code/float-trap.lisp @@ -22,8 +22,12 @@ (export '(current-float-trap floating-point-modes sigfpe-handler)) ) (in-package "EXTENSIONS") -(export '(set-floating-point-modes get-floating-point-modes - with-float-traps-masked)) +(export '(set-floating-point-modes + get-floating-point-modes + decode-floating-point-modes + encode-floating-point-modes + with-float-traps-masked + with-float-traps-enabled)) (in-package "VM")

(eval-when (compile load eval) @@ -103,7 +107,7 @@

final-mode)) (defun (setf floating-point-modes) (new-mode) - (declare (type (unsigned-byte 24) new-mode)) + (declare (type (unsigned-byte 32) new-mode)) ;; Set the floating point modes for both X87 and SSE2. This ;; include the rounding control bits. (let* ((rc (ldb float-rounding-mode new-mode)) @@ -116,8 +120,8 @@ ;; is ok and would be the correct setting if we ;; ever support long-floats. (ash 3 8)))) - (setf (vm::sse2-floating-point-modes) new-mode) - (setf (vm::x87-floating-point-modes) x87-modes)) + (setf (vm::sse2-floating-point-modes) (ldb (byte 24 0) new-mode)) + (setf (vm::x87-floating-point-modes) (ldb (byte 24 0) x87-modes))) new-mode) )

@@ -134,16 +138,18 @@ new-mode) )

-;;; SET-FLOATING-POINT-MODES -- Public +;;; %SET-FLOATING-POINT-MODES -- Public ;;; -(defun set-floating-point-modes (&key (traps nil traps-p) - (rounding-mode nil round-p) - (current-exceptions nil current-x-p) - (accrued-exceptions nil accrued-x-p) - (fast-mode nil fast-mode-p)) - "This function sets options controlling the floating-point hardware. If a - keyword is not supplied, then the current value is preserved. Possible - keywords: +(defun encode-floating-point-modes (&key (floating-point-modes (floating-point-modes)) + (traps nil traps-p) + (rounding-mode nil round-p) + (current-exceptions nil current-x-p) + (accrued-exceptions nil accrued-x-p) + (fast-mode nil fast-mode-p)) + "Encode the floating-point modes according to the give options and the + specified mode, Floating-Point-Modes. The resulting new mode is + returned. If a keyword is not supplied, then the current value is + preserved. Possible keywords:

:TRAPS A list of the exception conditions that should cause traps. Possible @@ -168,7 +174,7 @@

GET-FLOATING-POINT-MODES may be used to find the floating point modes currently in effect." - (let ((modes (floating-point-modes))) + (let ((modes floating-point-modes)) (when traps-p (let ((trap-mask-bits (float-trap-mask traps))) (setf (ldb float-traps-byte modes) trap-mask-bits) @@ -214,20 +220,56 @@ (setq modes (logior float-fast-bit modes)) (setq modes (logand (lognot float-fast-bit) modes))))

- (setf (floating-point-modes) modes)) - + modes)) + +;;; SET-FLOATING-POINT-MODES -- Public +;;; +(defun set-floating-point-modes (&rest args + &key traps + rounding-mode + current-exceptions + accrued-exceptions + fast-mode) + "This function sets options controlling the floating-point hardware. If a + keyword is not supplied, then the current value is preserved. Possible + keywords: + + :TRAPS + A list of the exception conditions that should cause traps. Possible + exceptions are :UNDERFLOW, :OVERFLOW, :INEXACT, :INVALID, + :DIVIDE-BY-ZERO, and on the X86 :DENORMALIZED-OPERAND. Initially + all traps except :INEXACT are enabled. + + :ROUNDING-MODE + The rounding mode to use when the result is not exact. Possible values + are :NEAREST, :POSITIVE-INFINITY, :NEGATIVE-INFINITY and :ZERO. + Initially, the rounding mode is :NEAREST. + + :CURRENT-EXCEPTIONS + :ACCRUED-EXCEPTIONS + These arguments allow setting of the exception flags. The main use is + setting the accrued exceptions to NIL to clear them. + + :FAST-MODE + Set the hardware's "fast mode" flag, if any. When set, IEEE + conformance or debuggability may be impaired. Some machines may not + have this feature, in which case the value is always NIL. + + GET-FLOATING-POINT-MODES may be used to find the floating point modes + currently in effect." + (declare (ignorable traps rounding-mode current-exceptions accrued-exceptions fast-mode)) + + (setf (floating-point-modes) + (apply #'encode-floating-point-modes args)) (values))

-;;; GET-FLOATING-POINT-MODES -- Public +;;; %GET-FLOATING-POINT-MODES -- Public ;;; -(defun get-floating-point-modes () +(defun decode-floating-point-modes (modes) "This function returns a list representing the state of the floating point - modes. The list is in the same format as the keyword arguments to - SET-FLOATING-POINT-MODES, i.e. - (apply #'set-floating-point-modes (get-floating-point-modes)) - - sets the floating point modes to their current values (and thus is a no-op)." + modes given in Modes. The list is in the same format as the keyword arguments to + SET-FLOATING-POINT-MODES." (flet ((exc-keys (bits) (macrolet ((frob () `(collect ((res)) @@ -237,13 +279,23 @@ float-trap-alist) (res)))) (frob)))) - (let ((modes (floating-point-modes))) - `(:traps ,(exc-keys (ldb float-traps-byte modes)) - :rounding-mode ,(car (rassoc (ldb float-rounding-mode modes) - rounding-mode-alist)) - :current-exceptions ,(exc-keys (ldb float-exceptions-byte modes)) - :accrued-exceptions ,(exc-keys (ldb float-sticky-bits modes)) - :fast-mode ,(logtest float-fast-bit modes))))) + `(:traps ,(exc-keys (ldb float-traps-byte modes)) + :rounding-mode ,(car (rassoc (ldb float-rounding-mode modes) + rounding-mode-alist)) + :current-exceptions ,(exc-keys (ldb float-exceptions-byte modes)) + :accrued-exceptions ,(exc-keys (ldb float-sticky-bits modes)) + :fast-mode ,(logtest float-fast-bit modes)))) + +;;; GET-FLOATING-POINT-MODES -- Public +;;; +(defun get-floating-point-modes () + "This function returns a list representing the state of the floating point + modes. The list is in the same format as the keyword arguments to + SET-FLOATING-POINT-MODES, i.e. + (apply #'set-floating-point-modes (get-floating-point-modes)) + + sets the floating point modes to their current values (and thus is a no-op)." + (decode-floating-point-modes (floating-point-modes)))

;;; CURRENT-FLOAT-TRAP -- Interface @@ -267,142 +319,181 @@ (alien:sap-alien scp (* unix:sigcontext)))) (traps (logand (ldb float-exceptions-byte modes) (ldb float-traps-byte modes)))) - #+(and darwin ppc) - (let* ((new-modes modes) - (new-exceptions (logandc2 (ldb float-exceptions-byte new-modes) - traps))) - ;; (format t "sigfpe: modes = #B~32,'0b~%" modes) - ;; (format t "sigfpe: new-exc = #B~32,'0b~%" new-exceptions) - (setf (ldb float-exceptions-byte new-modes) new-exceptions) - ;; Clear out all exceptions and save them to the context. - ;; - ;; XXX: Should we just clear out the bits for the traps that are - ;; enabled? If we did that then the accrued exceptions would be - ;; correct. - (setf (ldb float-sticky-bits new-modes) 0) - ;; Clear out the various sticky invalid operation bits too. - ;; - ;; XXX: Should we only do that if the invalid trap is enabled? - (setf (ldb float-invalid-op-1-byte new-modes) 0) - (setf (ldb float-invalid-op-2-byte new-modes) 0) - ;; Clear the FP exception summary bit too. - (setf (ldb float-exceptions-summary-byte new-modes) 0) - ;; (format t "sigfpe: new modes = #B~32,'0b~%" new-modes) - (setf (floating-point-modes) new-modes) - (setf (sigcontext-floating-point-modes - (alien:sap-alien scp (* unix:sigcontext))) - new-modes)) - - #+sse2 - (let* ((new-modes modes) - (new-exceptions (logandc2 (ldb float-exceptions-byte new-modes) - traps))) - ;; Clear out the status for any enabled traps. With SSE2, if - ;; the current exception is enabled, the next FP instruction - ;; will cause the exception to be signaled again. Hence, we - ;; need to clear out the exceptions that we are handling here. - (setf (ldb float-exceptions-byte new-modes) new-exceptions) - ;; XXX: This seems not right. Shouldn't we be setting the modes - ;; in the sigcontext instead? This however seems to do what we - ;; want. - (setf (vm:floating-point-modes) new-modes)) +

(multiple-value-bind (fop operands) (let ((sym (find-symbol "GET-FP-OPERANDS" "VM"))) (if (fboundp sym) (funcall sym (alien:sap-alien scp (* unix:sigcontext)) modes) (values nil nil))) - (cond ((not (zerop (logand float-divide-by-zero-trap-bit traps))) - (error 'division-by-zero - :operation fop - :operands operands)) - ((not (zerop (logand float-invalid-trap-bit traps))) - (error 'floating-point-invalid-operation - :operation fop - :operands operands)) - ((not (zerop (logand float-overflow-trap-bit traps))) - (error 'floating-point-overflow - :operation fop - :operands operands)) - ((not (zerop (logand float-underflow-trap-bit traps))) - (error 'floating-point-underflow - :operation fop - :operands operands)) - ((not (zerop (logand float-inexact-trap-bit traps))) - (error 'floating-point-inexact - :operation fop - :operands operands)) - #+x86 - ((not (zerop (logand float-denormal-trap-bit traps))) - (error 'floating-point-denormal-operand - :operation fop - :operands operands)) - (t - ;; It looks like the sigcontext on Solaris/x86 doesn't - ;; actually save the status word of the FPU. The - ;; operands also seem to be missing. Signal a general - ;; arithmetic error. - #+(and x86 solaris) - (error _"SIGFPE with no exceptions currently enabled? (si-code = ~D)" - code) - ;; For all other x86 ports, we should only get here if - ;; the SIGFPE was caused by an integer overflow on - ;; division. For sparc and ppc, I (rtoy) don't think - ;; there's any other way to get here since integer - ;; overflows aren't signaled. - ;; - ;; In that case, FOP should be /, so we can generate a - ;; nice arithmetic-error. It's possible to use CODE, - ;; which is supposed to indicate what caused the - ;; exception, but each OS is different, so we don't; FOP - ;; can tell us. - #-(and x86 solaris) - (if fop - (error 'arithmetic-error - :operation fop - :operands operands) - (error _"SIGFPE with no exceptions currently enabled? (si-code = ~D)" - code))))))) - -;;; WITH-FLOAT-TRAPS-MASKED -- Public -;;; -(defmacro with-float-traps-masked (traps &body body) - "Execute BODY with the floating point exceptions listed in TRAPS + ;; Don't let throws get away without resetting the + ;; floating-point modes back to the original values which we get + ;; from the sigcontext. Because we can throw, we never return + ;; from the signal handler so the sigcontext is never restored. + ;; This means we need to restore the fpu state ourselves. + (unwind-protect + (cond ((not (zerop (logand float-divide-by-zero-trap-bit traps))) + (error 'division-by-zero + :operation fop + :operands operands)) + ((not (zerop (logand float-invalid-trap-bit traps))) + (error 'floating-point-invalid-operation + :operation fop + :operands operands)) + ((not (zerop (logand float-overflow-trap-bit traps))) + (error 'floating-point-overflow + :operation fop + :operands operands)) + ((not (zerop (logand float-underflow-trap-bit traps))) + (error 'floating-point-underflow + :operation fop + :operands operands)) + ((not (zerop (logand float-inexact-trap-bit traps))) + (error 'floating-point-inexact + :operation fop + :operands operands)) + #+x86 + ((not (zerop (logand float-denormal-trap-bit traps))) + (error 'floating-point-denormal-operand + :operation fop + :operands operands)) + (t + ;; It looks like the sigcontext on Solaris/x86 doesn't + ;; actually save the status word of the FPU. The + ;; operands also seem to be missing. Signal a general + ;; arithmetic error. + #+(and x86 solaris) + (error _"SIGFPE with no exceptions currently enabled? (si-code = ~D)" + code) + ;; For all other x86 ports, we should only get here if + ;; the SIGFPE was caused by an integer overflow on + ;; division. For sparc and ppc, I (rtoy) don't think + ;; there's any other way to get here since integer + ;; overflows aren't signaled. + ;; + ;; In that case, FOP should be /, so we can generate a + ;; nice arithmetic-error. It's possible to use CODE, + ;; which is supposed to indicate what caused the + ;; exception, but each OS is different, so we don't; FOP + ;; can tell us. + #-(and x86 solaris) + (if fop + (error 'arithmetic-error + :operation fop + :operands operands) + (error _"SIGFPE with no exceptions currently enabled? (si-code = ~D)" + code)))) + ;; Cleanup + (let* ((new-modes modes) + (new-exceptions (logandc2 (ldb float-exceptions-byte new-modes) + traps))) + #+(and darwin ppc) + (progn + ;; (format t "sigfpe: modes = #B~32,'0b~%" modes) + ;; (format t "sigfpe: new-exc = #B~32,'0b~%" new-exceptions) + (setf (ldb float-exceptions-byte new-modes) new-exceptions) + ;; Clear out all exceptions. + ;; + ;; XXX: Should we just clear out the bits for the traps that are + ;; enabled? If we did that then the accrued exceptions would be + ;; correct. + (setf (ldb float-sticky-bits new-modes) 0) + ;; Clear out the various sticky invalid operation bits too. + ;; + ;; XXX: Should we only do that if the invalid trap is enabled? + (setf (ldb float-invalid-op-1-byte new-modes) 0) + (setf (ldb float-invalid-op-2-byte new-modes) 0) + ;; Clear the FP exception summary bit too. + (setf (ldb float-exceptions-summary-byte new-modes) 0) + ;; (format t "sigfpe: new modes = #B~32,'0b~%" new-modes) + (setf (floating-point-modes) new-modes)) + + #+sse2 + (progn + ;; Clear out the status for any enabled traps. With SSE2, if + ;; the current exception is enabled, the next FP instruction + ;; will cause the exception to be signaled again. Hence, we + ;; need to clear out the exceptions that we are handling here. + (setf (ldb float-exceptions-byte new-modes) new-exceptions) + #+nil + (progn + (format *debug-io* "sigcontext modes: #x~4x (~A)~%" + modes (decode-floating-point-modes modes)) + (format *debug-io* "current modes: #x~4x (~A)~%" + (vm:floating-point-modes) (get-floating-point-modes)) + (format *debug-io* "new modes: #x~x (~A)~%" + new-modes (decode-floating-point-modes new-modes))) + (setf (vm:floating-point-modes) new-modes)) + + #-(or sse2 (and darwin ppc)) + (progn + ;; Apparently nothing needed for sparc it seems The FPU + ;; state in the signal handler is unchanged and it seems we + ;; don't need to reset it any way when we throw out. + )))))) + +(macrolet + ((with-float-traps (name merge-traps docstring) + ;; Define macros to enable or disable floating-point + ;; exceptions. Masked exceptions and enabled exceptions only + ;; differ whether we AND in the bits or OR them, respectively. + ;; MERGE-TRAPS is the logical operation to merge the traps with + ;; the current floating-point mode. Thus, use and MERGE-EXCEPTIONS is the + ;; logical operation to merge the exceptions (sticky bits) with + ;; the current mode. + (let ((macro-name (symbolicate "WITH-FLOAT-TRAPS-" name))) + `(progn + (defmacro ,macro-name (traps &body body) + ,docstring + (let ((traps (dpb (float-trap-mask traps) float-traps-byte 0)) + (exceptions (dpb (float-trap-mask traps) float-sticky-bits 0)) + (trap-mask (dpb (lognot (float-trap-mask traps)) + float-traps-byte #xffffffff)) + (exception-mask (dpb (lognot (vm::float-trap-mask traps)) + float-sticky-bits #xffffffff)) + ;; On ppc if we are masking the invalid trap, we need to make + ;; sure we wipe out the various individual sticky bits + ;; representing the invalid operation. Otherwise, if we + ;; enable the invalid trap later, these sticky bits will cause + ;; an exception. + ;; + ;; FIXME: Consider removing these for ppc. Since + ;; we now restore the original modes exactly, I + ;; don't think these are needed anymore. + #+ppc + (invalid-mask (if (member :invalid traps) + (dpb 0 + (byte 1 31) + (dpb 0 vm::float-invalid-op-2-byte + (dpb 0 vm:float-invalid-op-1-byte #xffffffff))) + #xffffffff)) + (orig-modes (gensym))) + `(let ((,orig-modes (floating-point-modes))) + (unwind-protect + (progn + (setf (floating-point-modes) + (ldb (byte 32 0) + (logand (,',merge-traps ,orig-modes ,trap-mask) + ,exception-mask))) + ,@body) + ;; Restore the modes exactly as they were. + (setf (floating-point-modes) ,orig-modes))))))))) + + ;; WITH-FLOAT-TRAPS-MASKED -- Public + (with-float-traps masked logand + _N"Execute BODY with the floating point exceptions listed in TRAPS masked (disabled). TRAPS should be a list of possible exceptions which includes :UNDERFLOW, :OVERFLOW, :INEXACT, :INVALID and :DIVIDE-BY-ZERO and on the X86 :DENORMALIZED-OPERAND. The respective accrued exceptions are cleared at the start of the body to support - their testing within, and restored on exit." - (let ((traps (dpb (float-trap-mask traps) float-traps-byte 0)) - (exceptions (dpb (float-trap-mask traps) float-sticky-bits 0)) - (trap-mask (dpb (lognot (float-trap-mask traps)) - float-traps-byte #xffffffff)) - (exception-mask (dpb (lognot (vm::float-trap-mask traps)) - float-sticky-bits #xffffffff)) - ;; On ppc if we are masking the invalid trap, we need to make - ;; sure we wipe out the various individual sticky bits - ;; representing the invalid operation. Otherwise, if we - ;; enable the invalid trap later, these sticky bits will cause - ;; an exception. - #+ppc - (invalid-mask (if (member :invalid traps) - (dpb 0 - (byte 1 31) - (dpb 0 vm::float-invalid-op-2-byte - (dpb 0 vm:float-invalid-op-1-byte #xffffffff))) - #xffffffff)) - (orig-modes (gensym))) - `(let ((,orig-modes (floating-point-modes))) - (unwind-protect - (progn - (setf (floating-point-modes) - (logand ,orig-modes ,(logand trap-mask exception-mask))) - ,@body) - ;; Restore the original traps and exceptions. - (setf (floating-point-modes) - (logior (logand ,orig-modes ,(logior traps exceptions)) - (logand (floating-point-modes) - ,(logand trap-mask exception-mask) - #+ppc - ,invalid-mask - #+mips ,(dpb 0 float-exceptions-byte #xffffffff)))))))) + their testing within, and restored on exit.") + + ;; WITH-FLOAT-TRAPS-ENABLED -- Public + (with-float-traps enabled logorc2 + _N"Execute BODY with the floating point exceptions listed in TRAPS + enabled. TRAPS should be a list of possible exceptions which + includes :UNDERFLOW, :OVERFLOW, :INEXACT, :INVALID and + :DIVIDE-BY-ZERO and on the X86 :DENORMALIZED-OPERAND. The respective + accrued exceptions are cleared at the start of the body to support + their testing within, and restored on exit.")) +

===================================== src/code/irrat.lisp ===================================== --- a/src/code/irrat.lisp +++ b/src/code/irrat.lisp @@ -252,6 +252,13 @@ (return-from intexp base)) (when (eql base -1) (return-from intexp (if (oddp power) -1 1))) + + ;; Handle 0 raised to a power. Return 0 if the power is + ;; non-negative or signal a divide-by-zero if the power is negative. + (when (zerop base) + (if (minusp power) + (error 'division-by-zero) + (return-from intexp base)))

(when (> (abs power) *intexp-maximum-exponent*) ;; Allow user the option to continue with calculation, possibly

===================================== src/code/pathname.lisp ===================================== --- a/src/code/pathname.lisp +++ b/src/code/pathname.lisp @@ -1227,18 +1227,21 @@ a host-structure or string." ;; Not path-designator because a file-stream can't have a ;; wild pathname. (type (or string pathname) in-wildname)) - (with-pathname (pathname in-pathname) - (with-pathname (wildname in-wildname) - (macrolet ((frob (field &optional (op 'components-match )) - `(or (null (,field wildname)) - (,op (,field pathname) (,field wildname))))) - (and (or (null (%pathname-host wildname)) - (eq (%pathname-host wildname) (%pathname-host pathname))) - (frob %pathname-device) - (frob %pathname-directory directory-components-match) - (frob %pathname-name) - (frob %pathname-type) - (frob %pathname-version)))))) + (with-pathname (in-path in-pathname) + (enumerate-search-list (pathname in-path) + (with-pathname (in-wild in-wildname) + (enumerate-search-list (wildname in-wild) + (macrolet ((frob (field &optional (op 'components-match )) + `(or (null (,field wildname)) + (,op (,field pathname) (,field wildname))))) + (when (and (or (null (%pathname-host wildname)) + (eq (%pathname-host wildname) (%pathname-host pathname))) + (frob %pathname-device) + (frob %pathname-directory directory-components-match) + (frob %pathname-name) + (frob %pathname-type) + (frob %pathname-version)) + (return-from pathname-match-p pathname))))))))

;;; SUBSTITUTE-INTO -- Internal

===================================== src/code/run-program.lisp ===================================== --- a/src/code/run-program.lisp +++ b/src/code/run-program.lisp @@ -471,8 +471,9 @@

The keyword arguments have the following meanings: :env - - An A-LIST mapping keyword environment variables to simple-string - values. + An A-LIST mapping keyword environment variables to + simple-string values. This is the shell environment for + Program. Defaults to *environment-list*. :wait - If non-NIL (default), wait until the created process finishes. If NIL, continue running Lisp until the program finishes.

===================================== src/code/save.lisp ===================================== --- a/src/code/save.lisp +++ b/src/code/save.lisp @@ -36,7 +36,8 @@ might not be.")

(defvar *environment-list* nil - "An alist mapping environment variables (as keywords) to either values") + "An alist mapping each environment variable (as a keyword) to its + value.")

(defvar *environment-list-initialized* nil "Non-NIL if environment-init has been called")

===================================== src/compiler/generic/vm-fndb.lisp ===================================== --- a/src/compiler/generic/vm-fndb.lisp +++ b/src/compiler/generic/vm-fndb.lisp @@ -288,6 +288,13 @@ (bignum-element-type (mod #+amd64 64 #-amd64 32)) bignum-element-type (foldable flushable movable))

+ +#+x86 +(defknown (bignum::%shld bignum::%shrd) + (bignum-element-type bignum-element-type (unsigned-byte 5)) + bignum-element-type + (foldable flushable movable)) +  ;;;; Bit-bashing routines.

===================================== src/compiler/x86/arith.lisp ===================================== --- a/src/compiler/x86/arith.lisp +++ b/src/compiler/x86/arith.lisp @@ -1579,6 +1579,7 @@ (inst mov tmp y) (inst shr tmp 18) (inst xor y tmp))) +  ;;; Modular arithmetic ;;; logical operations

===================================== src/compiler/x86/float-sse2.lisp ===================================== --- a/src/compiler/x86/float-sse2.lisp +++ b/src/compiler/x86/float-sse2.lisp @@ -1181,19 +1181,17 @@ (:args (hi-bits :scs (signed-reg)) (lo-bits :scs (unsigned-reg))) (:results (res :scs (double-reg))) - (:temporary (:sc double-stack) temp) (:arg-types signed-num unsigned-num) (:result-types double-float) (:translate make-double-float) + (:temporary (:sc double-reg) temp) (:policy :fast-safe) (:vop-var vop) - (:generator 2 - (let ((offset (1+ (tn-offset temp)))) - (storew hi-bits ebp-tn (- offset)) - (storew lo-bits ebp-tn (- (1+ offset))) - (inst movsd res (make-ea :dword :base ebp-tn - :disp (- (* (1+ offset) word-bytes))))))) - + (:generator 4 + (inst movd temp hi-bits) + (inst psllq temp 32) + (inst movd res lo-bits) + (inst orpd res temp)))

(define-vop (single-float-bits) (:args (float :scs (single-reg descriptor-reg)

===================================== src/compiler/x86/float.lisp ===================================== --- a/src/compiler/x86/float.lisp +++ b/src/compiler/x86/float.lisp @@ -2340,6 +2340,13 @@ ;; ;; When one of the mask bits (0-5) is set, then that exception is ;; masked so that no exception is generated. +;; +;; Returns the control and status words merged into one. The low 16 +;; bits contains the control word with the exception mask bits +;; inverted to indicate exception enable bits. The high 16 bits +;; contains the status word, but the top 8 bits of the status word are +;; cleared, effectively removing the condition code, top-of-stack +;; bits, and the FPU busy bit. (define-vop (x87-floating-point-modes) (:results (res :scs (unsigned-reg))) (:result-types unsigned-num)

===================================== src/compiler/x86/insts.lisp ===================================== --- a/src/compiler/x86/insts.lisp +++ b/src/compiler/x86/insts.lisp @@ -859,6 +859,18 @@ ;; optional fields (imm))

+;; Double shift instructions. Like ext-reg-reg/mem but there's no +;; width field. +(disassem:define-instruction-format (ext-reg-reg/mem-shift 24) + (prefix :field (byte 8 0) :value #b00001111) + (op :field (byte 8 8)) + (reg/mem :fields (list (byte 2 22) (byte 3 16)) + :type 'reg/mem) + (reg :field (byte 3 19) :type 'reg) + ;; optional fields + (imm)) + + ;;; ---------------------------------------------------------------- ;;; this section added by jrd, for fp instructions.

@@ -1535,24 +1547,22 @@ (defun emit-double-shift (segment opcode dst src amt) (let ((size (matching-operand-size dst src))) (when (eq size :byte) - (error "Double shifts can only be used with words.")) + (error "Double shifts cannot be used with byte registers.")) (maybe-emit-operand-size-prefix segment size) (emit-byte segment #b00001111) (emit-byte segment (dpb opcode (byte 1 3) (if (eq amt :cl) #b10100101 #b10100100))) - #+nil - (emit-ea segment dst src) - (emit-ea segment dst (reg-tn-encoding src)) ; pw tries this + (emit-ea segment dst (reg-tn-encoding src)) (unless (eq amt :cl) (emit-byte segment amt))))

(eval-when (compile eval) (defun double-shift-inst-printer-list (op) - `(#+nil - (ext-reg-reg/mem-imm ((op ,(logior op #b100)) - (imm nil :type signed-imm-byte))) - (ext-reg-reg/mem ((op ,(logior op #b101))) - (:name :tab reg/mem ", " 'cl))))) + `((ext-reg-reg/mem-shift ((op ,(logior op #b100)) + (imm nil :type signed-imm-byte)) + (:name :tab reg/mem ", " reg ", " imm)) + (ext-reg-reg/mem-shift ((op ,(logior op #b101))) + (:name :tab reg/mem ", " reg ", " 'cl)))))

(define-instruction shld (segment dst src amt) (:declare (type (or (member :cl) (mod 32)) amt)) @@ -3136,6 +3146,8 @@ ;; logical (define-regular-sse-inst andpd #x66 #x54 t) (define-regular-sse-inst andps nil #x54) + (define-regular-sse-inst orpd #x66 #x56 t) + (define-regular-sse-inst orps nil #x56) (define-regular-sse-inst xorpd #x66 #x57 t) (define-regular-sse-inst xorps nil #x57) ;; comparison

===================================== src/contrib/asdf/asdf.lisp ===================================== --- a/src/contrib/asdf/asdf.lisp +++ b/src/contrib/asdf/asdf.lisp @@ -1,5 +1,5 @@ -;;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp ; buffer-read-only: t; -*- -;;; This is ASDF 3.1.6: Another System Definition Facility. +;;; -*- mode: Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp ; buffer-read-only: t; -*- +;;; This is ASDF 3.1.7: Another System Definition Facility. ;;; ;;; Feedback, bug reports, and patches are all welcome: ;;; please mail to asdf-devel@common-lisp.net. @@ -46,43 +46,6 @@ ;;; we can't use defsystem to compile it. Hence, all in one file.

#+xcvb (module ()) - -(in-package :cl-user) - -#+cmu -(eval-when (:load-toplevel :compile-toplevel :execute) - (setf ext:*gc-verbose* nil)) - -;;; pre 1.3.0 ABCL versions do not support the bundle-op on Mac OS X -#+abcl -(eval-when (:load-toplevel :compile-toplevel :execute) - (unless (and (member :darwin *features*) - (second (third (sys::arglist 'directory)))) - (push :abcl-bundle-op-supported *features*))) - -;; Punt on hard package upgrade: from ASDF1 always, and even from ASDF2 on most implementations. -(eval-when (:load-toplevel :compile-toplevel :execute) - (unless (member :asdf3 *features*) - (let* ((existing-version - (when (find-package :asdf) - (or (symbol-value (find-symbol (string :*asdf-version*) :asdf)) - (let ((ver (symbol-value (find-symbol (string :*asdf-revision*) :asdf)))) - (etypecase ver - (string ver) - (cons (format nil "~{~D~^.~}" ver)) - (null "1.0")))))) - (first-dot (when existing-version (position #. existing-version))) - (second-dot (when first-dot (position #. existing-version :start (1+ first-dot)))) - (existing-major-minor (subseq existing-version 0 second-dot)) - (existing-version-number (and existing-version (read-from-string existing-major-minor))) - (away (format nil "~A-~A" :asdf existing-version))) - (when (and existing-version - (< existing-version-number - #+(or allegro clisp lispworks sbcl) 2.0 - #-(or allegro clisp lispworks sbcl) 2.27)) - (rename-package :asdf away) - (when *load-verbose* - (format t "~&; Renamed old ~A package away to ~A~%" :asdf away)))))) ;;;; --------------------------------------------------------------------------- ;;;; Handle ASDF package upgrade, including implementation-dependent magic. ;; @@ -822,19 +785,6 @@ UNINTERN -- Remove symbols here from PACKAGE." #+(or clasp ecl gcl mkcl) (defpackage ,package (:use)) (eval-when (:compile-toplevel :load-toplevel :execute) ,ensure-form)))) - -;;;; Final tricks to keep various implementations happy. -;; We want most such tricks in common-lisp.lisp, -;; but these need to be done before the define-package form there, -;; that we nevertheless want to be the very first form. -(eval-when (:load-toplevel :compile-toplevel :execute) - #+allegro ;; We need to disable autoloading BEFORE any mention of package ASDF. - (setf excl::*autoload-package-name-alist* - (remove "asdf" excl::*autoload-package-name-alist* - :test 'equalp :key 'car))) - -;; Compatibility with whoever calls asdf/package -(define-package :asdf/package (:use :cl :uiop/package) (:reexport :uiop/package)) ;;;; ------------------------------------------------------------------------- ;;;; Handle compatibility with multiple implementations. ;;; This file is for papering over the deficiencies and peculiarities @@ -844,10 +794,9 @@ UNINTERN -- Remove symbols here from PACKAGE." ;;; from this package only common-lisp symbols are exported.

(uiop/package:define-package :uiop/common-lisp - (:nicknames :uoip/cl :asdf/common-lisp :asdf/cl) + (:nicknames :uoip/cl) (:use :uiop/package) (:use-reexport #-genera :common-lisp #+genera :future-common-lisp) - (:recycle :uiop/common-lisp :uoip/cl :asdf/common-lisp :asdf/cl :asdf) #+allegro (:intern #:*acl-warn-save*) #+cormanlisp (:shadow #:user-homedir-pathname) #+cormanlisp @@ -856,10 +805,10 @@ UNINTERN -- Remove symbols here from PACKAGE." #:make-broadcast-stream #:file-namestring) #+genera (:shadowing-import-from :scl #:boolean) #+genera (:export #:boolean #:ensure-directories-exist #:read-sequence #:write-sequence) - #+mcl (:shadow #:user-homedir-pathname)) + #+(or mcl cmucl) (:shadow #:user-homedir-pathname)) (in-package :uiop/common-lisp)

-#-(or abcl allegro clasp clisp clozure cmu cormanlisp ecl gcl genera lispworks mcl mkcl sbcl scl xcl) +#-(or abcl allegro clasp clisp clozure cmucl cormanlisp ecl gcl genera lispworks mcl mkcl sbcl scl xcl) (error "ASDF is not supported on your implementation. Please help us port it.")

;; (declaim (optimize (speed 1) (debug 3) (safety 3))) ; DON'T: trust implementation defaults. @@ -867,17 +816,23 @@ UNINTERN -- Remove symbols here from PACKAGE."

;;;; Early meta-level tweaks

-#+(or abcl allegro clasp clisp cmu ecl mkcl clozure lispworks mkcl sbcl scl) +#+(or allegro clasp clisp cmucl ecl mkcl mkcl sbcl) (eval-when (:load-toplevel :compile-toplevel :execute) - ;; Check for unicode at runtime, so that a hypothetical FASL compiled with unicode - ;; but loaded in a non-unicode setting (e.g. on Allegro) won't tell a lie. (when (and #+allegro (member :ics *features*) - #+(or clasp clisp cmu ecl mkcl) (member :unicode *features*) + #+(or clasp clisp cmucl ecl mkcl) (member :unicode *features*) #+sbcl (member :sb-unicode *features*)) + ;; Check for unicode at runtime, so that a hypothetical FASL compiled with unicode + ;; but loaded in a non-unicode setting (e.g. on Allegro) won't tell a lie. (pushnew :asdf-unicode *features*)))

#+allegro (eval-when (:load-toplevel :compile-toplevel :execute) + ;; We need to disable autoloading BEFORE any mention of package ASDF. + ;; In particular, there must NOT be a mention of package ASDF in the defpackage of this file + ;; or any previous file. + (setf excl::*autoload-package-name-alist* + (remove "asdf" excl::*autoload-package-name-alist* + :test 'equalp :key 'car)) (defparameter *acl-warn-save* (when (boundp 'excl:*warn-on-nested-reader-conditionals*) excl:*warn-on-nested-reader-conditionals*)) @@ -901,7 +856,13 @@ UNINTERN -- Remove symbols here from PACKAGE." (wait-on-semaphore (external-process-completed proc)))) (values (external-process-%exit-code proc) (external-process-%status proc)))))) -#+clozure (in-package :uiop/common-lisp) +#+clozure (in-package :uiop/common-lisp) ;; back in this package. + +#+cmucl +(eval-when (:load-toplevel :compile-toplevel :execute) + (setf ext:*gc-verbose* nil) + (defun user-homedir-pathname () + (first (ext:search-list (cl:user-homedir-pathname)))))

#+cormanlisp (eval-when (:load-toplevel :compile-toplevel :execute) @@ -1035,8 +996,6 @@ Return a string made of the parts not omitted or emitted by FROB." ;;;; General Purpose Utilities for ASDF

(uiop/package:define-package :uiop/utility - (:nicknames :asdf/utility) - (:recycle :uiop/utility :asdf/utility :asdf) (:use :uiop/common-lisp :uiop/package) ;; import and reexport a few things defined in :uiop/common-lisp (:import-from :uiop/common-lisp #:compatfmt #:loop* #:frob-substrings @@ -1618,11 +1577,11 @@ with later being determined by a lexicographical comparison of minor numbers." #+allegro 'excl::format-control #+clisp 'system::$format-control #+clozure 'ccl::format-control - #+(or cmu scl) 'conditions::format-control + #+(or cmucl scl) 'conditions::format-control #+(or clasp ecl mkcl) 'si::format-control #+(or gcl lispworks) 'conditions::format-string #+sbcl 'sb-kernel:format-control - #-(or abcl allegro clasp clisp clozure cmu ecl gcl lispworks mkcl sbcl scl) nil + #-(or abcl allegro clasp clisp clozure cmucl ecl gcl lispworks mkcl sbcl scl) nil "Name of the slot for FORMAT-CONTROL in simple-condition")

(defun match-condition-p (x condition) @@ -1637,7 +1596,7 @@ or a string describing the format-control of a simple-condition." (function (funcall x condition)) (string (and (typep condition 'simple-condition) ;; On SBCL, it's always set and the check triggers a warning - #+(or allegro clozure cmu lispworks scl) + #+(or allegro clozure cmucl lispworks scl) (slot-boundp condition +simple-condition-format-control-slot+) (ignore-errors (equal (simple-condition-format-control condition) x))))))

@@ -1659,8 +1618,6 @@ or a string describing the format-control of a simple-condition." ;;;; Access to the Operating System

(uiop/package:define-package :uiop/os - (:nicknames :asdf/os) - (:recycle :uiop/os :asdf/os :asdf) (:use :uiop/common-lisp :uiop/package :uiop/utility) (:export #:featurep #:os-unix-p #:os-macosx-p #:os-windows-p #:os-genera-p #:detect-os ;; features @@ -1744,7 +1701,7 @@ use getenvp to return NIL in such a case." #+(or abcl clasp clisp ecl xcl) (ext:getenv x) #+allegro (sys:getenv x) #+clozure (ccl:getenv x) - #+cmu (unix:unix-getenv x) + #+cmucl (unix:unix-getenv x) #+scl (cdr (assoc x ext:*environment-list* :test #'string=)) #+cormanlisp (let* ((buffer (ct:malloc 1)) @@ -1765,7 +1722,7 @@ use getenvp to return NIL in such a case." (ccl:%get-cstring value)))) #+mkcl (#.(or (find-symbol* 'getenv :si nil) (find-symbol* 'getenv :mk-ext nil)) x) #+sbcl (sb-ext:posix-getenv x) - #-(or abcl allegro clasp clisp clozure cmu cormanlisp ecl gcl genera lispworks mcl mkcl sbcl scl xcl) + #-(or abcl allegro clasp clisp clozure cmucl cormanlisp ecl gcl genera lispworks mcl mkcl sbcl scl xcl) (error "~S is not supported on your implementation" 'getenv))

(defsetf getenv (x) (val) @@ -1774,12 +1731,12 @@ use getenvp to return NIL in such a case." #+allegro `(setf (sys:getenv ,x) ,val) #+clisp `(system::setenv ,x ,val) #+clozure `(ccl:setenv ,x ,val) - #+cmu `(unix:unix-setenv ,x ,val 1) + #+cmucl `(unix:unix-setenv ,x ,val 1) #+ecl `(ext:setenv ,x ,val) #+lispworks `(hcl:setenv ,x ,val) #+mkcl `(mkcl:setenv ,x ,val) #+sbcl `(progn (require :sb-posix) (symbol-call :sb-posix :setenv ,x ,val 1)) - #-(or allegro clisp clozure cmu ecl lispworks mkcl sbcl) + #-(or allegro clisp clozure cmucl ecl lispworks mkcl sbcl) '(error "~S ~S is not supported on your implementation" 'setf 'getenv))

(defun getenvp (x) @@ -1871,7 +1828,7 @@ then returning the non-empty string value of the variable" ccl::*openmcl-major-version* ccl::*openmcl-minor-version* (logand (ccl-fasl-version) #xFF)) - #+cmu (substitute #- #/ s) + #+cmucl (substitute #- #/ s) #+scl (format nil "~A~A" s ;; ANSI upper case vs lower case. (ecase ext:*case-mode* (:upper "") (:lower "l"))) @@ -1905,7 +1862,7 @@ suitable for use as a directory name to segregate Lisp FASLs, C dynamic librarie (defun hostname () "return the hostname of the current host" ;; Note: untested on RMCL - #+(or abcl clasp clozure cmu ecl genera lispworks mcl mkcl sbcl scl xcl) (machine-instance) + #+(or abcl clasp clozure cmucl ecl genera lispworks mcl mkcl sbcl scl xcl) (machine-instance) #+cormanlisp "localhost" ;; is there a better way? Does it matter? #+allegro (symbol-call :excl.osi :gethostname) #+clisp (first (split-string (machine-instance) :separator " ")) @@ -1915,7 +1872,7 @@ suitable for use as a directory name to segregate Lisp FASLs, C dynamic librarie ;;; Current directory (with-upgradability ()

- #+cmu + #+cmucl (defun parse-unix-namestring* (unix-namestring) "variant of LISP::PARSE-UNIX-NAMESTRING that returns a pathname object" (multiple-value-bind (host device directory name type version) @@ -1929,7 +1886,7 @@ suitable for use as a directory name to segregate Lisp FASLs, C dynamic librarie #+allegro (excl::current-directory) #+clisp (ext:default-directory) #+clozure (ccl:current-directory) - #+(or cmu scl) (#+cmu parse-unix-namestring* #+scl lisp::parse-unix-namestring + #+(or cmucl scl) (#+cmucl parse-unix-namestring* #+scl lisp::parse-unix-namestring (strcat (nth-value 1 (unix:unix-current-directory)) "/")) #+cormanlisp (pathname (pl::get-current-directory)) ;; Q: what type does it return? #+(or clasp ecl) (ext:getcwd) @@ -1947,7 +1904,7 @@ suitable for use as a directory name to segregate Lisp FASLs, C dynamic librarie #+allegro (excl:chdir x) #+clisp (ext:cd x) #+clozure (setf (ccl:current-directory) x) - #+(or cmu scl) (unix:unix-chdir (ext:unix-namestring x)) + #+(or cmucl scl) (unix:unix-chdir (ext:unix-namestring x)) #+cormanlisp (unless (zerop (win32::_chdir (namestring x))) (error "Could not set current directory to ~A" x)) #+(or clasp ecl) (ext:chdir x) @@ -1955,7 +1912,7 @@ suitable for use as a directory name to segregate Lisp FASLs, C dynamic librarie #+lispworks (hcl:change-directory x) #+mkcl (mk-ext:chdir x) #+sbcl (progn (require :sb-posix) (symbol-call :sb-posix :chdir (sb-ext:native-namestring x))) - #-(or abcl allegro clasp clisp clozure cmu cormanlisp ecl gcl genera lispworks mkcl sbcl scl xcl) + #-(or abcl allegro clasp clisp clozure cmucl cormanlisp ecl gcl genera lispworks mkcl sbcl scl xcl) (error "chdir not supported on your implementation"))))

@@ -2048,8 +2005,7 @@ the number having BYTES octets (defaulting to 4)." ;; which all is necessary prior to any access the filesystem or environment.

(uiop/package:define-package :uiop/pathname - (:nicknames :asdf/pathname) - (:recycle :uiop/pathname :asdf/pathname :asdf) + (:nicknames :asdf/pathname) ;; deprecated. Used by ceramic (:use :uiop/common-lisp :uiop/package :uiop/utility :uiop/os) (:export ;; Making and merging pathnames, portably @@ -2092,7 +2048,7 @@ the number having BYTES octets (defaulting to 4)." implementation's MAKE-PATHNAME and other primitives to a CLHS-standard format that is a list and not a string." (cond - #-(or cmu sbcl scl) ;; these implementations already normalize directory components. + #-(or cmucl sbcl scl) ;; these implementations already normalize directory components. ((stringp directory) `(:absolute ,directory)) ((or (null directory) (and (consp directory) (member (first directory) '(:absolute :relative)))) @@ -2135,22 +2091,17 @@ by the underlying implementation's MAKE-PATHNAME and other primitives" ;; See CLHS make-pathname and 19.2.2.2.3. ;; This will be :unspecific if supported, or NIL if not. (defparameter *unspecific-pathname-type* - #+(or abcl allegro clozure cmu genera lispworks sbcl scl) :unspecific + #+(or abcl allegro clozure cmucl genera lispworks sbcl scl) :unspecific #+(or clasp clisp ecl mkcl gcl xcl #|These haven't been tested:|# cormanlisp mcl) nil "Unspecific type component to use with the underlying implementation's MAKE-PATHNAME")

- (defun make-pathname* (&rest keys &key (directory nil) - host (device () #+allegro devicep) name type version defaults + (defun make-pathname* (&rest keys &key directory host device name type version defaults #+scl &allow-other-keys) "Takes arguments like CL:MAKE-PATHNAME in the CLHS, and tries hard to make a pathname that will actually behave as documented, - despite the peculiarities of each implementation" - ;; TODO: reimplement defaulting for MCL, whereby an explicit NIL should override the defaults. - (declare (ignorable host device directory name type version defaults)) - (apply 'make-pathname - (append - #+allegro (when (and devicep (null device)) `(:device :unspecific)) - keys))) + despite the peculiarities of each implementation. DEPRECATED: just use MAKE-PATHNAME." + (declare (ignore host device directory name type version defaults)) + (apply 'make-pathname keys))

(defun make-pathname-component-logical (x) "Make a pathname component suitable for use in a logical-pathname" @@ -2163,7 +2114,7 @@ by the underlying implementation's MAKE-PATHNAME and other primitives" (defun make-pathname-logical (pathname host) "Take a PATHNAME's directory, name, type and version components, and make a new pathname with corresponding components and specified logical HOST" - (make-pathname* + (make-pathname :host host :directory (make-pathname-component-logical (pathname-directory pathname)) :name (make-pathname-component-logical (pathname-name pathname)) @@ -2206,10 +2157,10 @@ by default *DEFAULT-PATHNAME-DEFAULTS*, which cannot be NIL." (pathname-device defaults) (merge-pathname-directory-components directory (pathname-directory defaults)) (unspecific-handler defaults)))) - (make-pathname* :host host :device device :directory directory - :name (funcall unspecific-handler name) - :type (funcall unspecific-handler type) - :version (funcall unspecific-handler version)))))) + (make-pathname :host host :device device :directory directory + :name (funcall unspecific-handler name) + :type (funcall unspecific-handler type) + :version (funcall unspecific-handler version))))))

(defun logical-pathname-p (x) "is X a logical-pathname?" @@ -2234,13 +2185,13 @@ when merging, making or parsing pathnames" ;; But CMUCL decides to die on NIL. ;; MCL has issues with make-pathname, nil and defaulting (declare (ignorable defaults)) - #.`(make-pathname* :directory nil :name nil :type nil :version nil - :device (or #+(and mkcl unix) :unspecific) - :host (or #+cmu lisp::*unix-host* #+(and mkcl unix) "localhost") - #+scl ,@'(:scheme nil :scheme-specific-part nil - :username nil :password nil :parameters nil :query nil :fragment nil) - ;; the default shouldn't matter, but we really want something physical - #-mcl ,@'(:defaults defaults))) + #.`(make-pathname :directory nil :name nil :type nil :version nil + :device (or #+(and mkcl unix) :unspecific) + :host (or #+cmucl lisp::*unix-host* #+(and mkcl unix) "localhost") + #+scl ,@'(:scheme nil :scheme-specific-part nil + :username nil :password nil :parameters nil :query nil :fragment nil) + ;; the default shouldn't matter, but we really want something physical + #-mcl ,@'(:defaults defaults)))

(defvar *nil-pathname* (nil-pathname (physicalize-pathname (user-homedir-pathname))) "A pathname that is as neutral as possible for use as defaults @@ -2318,9 +2269,9 @@ actually-existing file.

Returns the (parsed) PATHNAME when true" (when pathname - (let* ((pathname (pathname pathname)) - (name (pathname-name pathname))) - (when (not (member name '(nil :unspecific "") :test 'equal)) + (let ((pathname (pathname pathname))) + (unless (and (member (pathname-name pathname) '(nil :unspecific "") :test 'equal) + (member (pathname-type pathname) '(nil :unspecific "") :test 'equal)) pathname)))))

@@ -2337,10 +2288,10 @@ and NIL NAME, TYPE and VERSION components" i.e. removing one level of depth in the DIRECTORY component. e.g. if pathname is Unix pathname /foo/bar/baz/file.type then return /foo/bar/" (when pathname - (make-pathname* :name nil :type nil :version nil - :directory (merge-pathname-directory-components - '(:relative :back) (pathname-directory pathname)) - :defaults pathname))) + (make-pathname :name nil :type nil :version nil + :directory (merge-pathname-directory-components + '(:relative :back) (pathname-directory pathname)) + :defaults pathname)))

(defun directory-pathname-p (pathname) "Does PATHNAME represent a directory? @@ -2375,11 +2326,11 @@ actually-existing directory." ((directory-pathname-p pathspec) pathspec) (t - (make-pathname* :directory (append (or (normalize-pathname-directory-component - (pathname-directory pathspec)) - (list :relative)) - (list (file-namestring pathspec))) - :name nil :type nil :version nil :defaults pathspec))))) + (make-pathname :directory (append (or (normalize-pathname-directory-component + (pathname-directory pathspec)) + (list :relative)) + (list (file-namestring pathspec))) + :name nil :type nil :version nil :defaults pathspec)))))

;;; Parsing filenames @@ -2512,7 +2463,7 @@ to throw an error if the pathname is absolute" (t (split-name-type filename))) (apply 'ensure-pathname - (make-pathname* + (make-pathname :directory (unless file-only (cons relative path)) :name name :type type :defaults (or #-mcl defaults *nil-pathname*)) @@ -2581,19 +2532,19 @@ then it is merged with the PATHNAME-DIRECTORY-PATHNAME of PATHNAME."

(defun pathname-root (pathname) "return the root directory for the host and device of given PATHNAME" - (make-pathname* :directory '(:absolute) - :name nil :type nil :version nil - :defaults pathname ;; host device, and on scl, *some* - ;; scheme-specific parts: port username password, not others: - . #.(or #+scl '(:parameters nil :query nil :fragment nil)))) + (make-pathname :directory '(:absolute) + :name nil :type nil :version nil + :defaults pathname ;; host device, and on scl, *some* + ;; scheme-specific parts: port username password, not others: + . #.(or #+scl '(:parameters nil :query nil :fragment nil))))

(defun pathname-host-pathname (pathname) "return a pathname with the same host as given PATHNAME, and all other fields NIL" - (make-pathname* :directory nil - :name nil :type nil :version nil :device nil - :defaults pathname ;; host device, and on scl, *some* - ;; scheme-specific parts: port username password, not others: - . #.(or #+scl '(:parameters nil :query nil :fragment nil)))) + (make-pathname :directory nil + :name nil :type nil :version nil :device nil + :defaults pathname ;; host device, and on scl, *some* + ;; scheme-specific parts: port username password, not others: + . #.(or #+scl '(:parameters nil :query nil :fragment nil))))

(defun ensure-absolute-pathname (path &optional defaults (on-error 'error)) "Given a pathname designator PATH, return an absolute pathname as specified by PATH @@ -2660,12 +2611,12 @@ given DEFAULTS-PATHNAME as a base pathname." :version (or #-(or allegro abcl xcl) *wild*)) "A pathname object with wildcards for matching any file in a given directory") (defparameter *wild-directory* - (make-pathname* :directory `(:relative ,*wild-directory-component*) - :name nil :type nil :version nil) + (make-pathname :directory `(:relative ,*wild-directory-component*) + :name nil :type nil :version nil) "A pathname object with wildcards for matching any subdirectory") (defparameter *wild-inferiors* - (make-pathname* :directory `(:relative ,*wild-inferiors-component*) - :name nil :type nil :version nil) + (make-pathname :directory `(:relative ,*wild-inferiors-component*) + :name nil :type nil :version nil) "A pathname object with wildcards for matching any recursive subdirectory") (defparameter *wild-path* (merge-pathnames* *wild-file* *wild-inferiors*) @@ -2692,13 +2643,13 @@ given DEFAULTS-PATHNAME as a base pathname." (defun relativize-pathname-directory (pathspec) "Given a PATHNAME, return a relative pathname with otherwise the same components" (let ((p (pathname pathspec))) - (make-pathname* + (make-pathname :directory (relativize-directory-component (pathname-directory p)) :defaults p)))

(defun directory-separator-for-host (&optional (pathname *default-pathname-defaults*)) "Given a PATHNAME, return the character used to delimit directory names on this host and device." - (let ((foo (make-pathname* :directory '(:absolute "FOO") :defaults pathname))) + (let ((foo (make-pathname :directory '(:absolute "FOO") :defaults pathname))) (last-char (namestring foo))))

#-scl @@ -2722,8 +2673,7 @@ added to its DIRECTORY component. This is useful for output translations." (multiple-value-bind (relative path filename) (split-unix-namestring-directory-components root-string :ensure-directory t) (declare (ignore relative filename)) - (let ((new-base - (make-pathname* :defaults root :directory `(:absolute ,@path)))) + (let ((new-base (make-pathname :defaults root :directory `(:absolute ,@path)))) (translate-pathname absolute-pathname wild-root (wilden new-base))))))

#+scl @@ -2745,8 +2695,8 @@ added to its DIRECTORY component. This is useful for output translations." (when (specificp scheme) (setf prefix (strcat scheme prefix))) (assert (and directory (eq (first directory) :absolute))) - (make-pathname* :directory `(:absolute ,prefix ,@(rest directory)) - :defaults pathname))) + (make-pathname :directory `(:absolute ,prefix ,@(rest directory)) + :defaults pathname))) pathname)))

(defun* (translate-pathname*) (path absolute-source destination &optional root source) @@ -2785,8 +2735,6 @@ you need to still be able to use compile-op on that lisp file.")) ;;;; Portability layer around Common Lisp filesystem access

(uiop/package:define-package :uiop/filesystem - (:nicknames :asdf/filesystem) - (:recycle :uiop/filesystem :asdf/pathname :asdf) (:use :uiop/common-lisp :uiop/package :uiop/utility :uiop/os :uiop/pathname) (:export ;; Native namestrings @@ -2817,9 +2765,9 @@ you need to still be able to use compile-op on that lisp file.")) (when x (let ((p (pathname x))) #+clozure (with-pathname-defaults () (ccl:native-translated-namestring p)) ; see ccl bug 978 - #+(or cmu scl) (ext:unix-namestring p nil) + #+(or cmucl scl) (ext:unix-namestring p nil) #+sbcl (sb-ext:native-namestring p) - #-(or clozure cmu sbcl scl) + #-(or clozure cmucl sbcl scl) (os-cond ((os-unix-p) (unix-namestring p)) (t (namestring p)))))) @@ -2832,8 +2780,10 @@ a CL pathname satisfying all the specified constraints as per ENSURE-PATHNAME" (when string (with-pathname-defaults () #+clozure (ccl:native-to-pathname string) + #+cmucl (uiop/os::parse-unix-namestring* string) #+sbcl (sb-ext:parse-native-namestring string) - #-(or clozure sbcl) + #+scl (lisp::parse-unix-namestring string) + #-(or clozure cmucl sbcl scl) (os-cond ((os-unix-p) (parse-unix-namestring string :ensure-directory ensure-directory)) (t (parse-namestring string)))))) @@ -2918,10 +2868,10 @@ or the original (parsed) pathname if it is false (the default)." (if truename (probe-file p) (and - #+(or cmu scl) (unix:unix-stat (ext:unix-namestring p)) + #+(or cmucl scl) (unix:unix-stat (ext:unix-namestring p)) #+(and lispworks unix) (system:get-file-stat p) #+sbcl (sb-unix:unix-stat (sb-ext:native-namestring p)) - #-(or cmu (and lispworks unix) sbcl scl) (file-write-date p) + #-(or cmucl (and lispworks unix) sbcl scl) (file-write-date p) p))))))

(defun directory-exists-p (x) @@ -2948,7 +2898,7 @@ Try to override the defaults to not resolving symlinks, if implementation allows (append keys '#.(or #+allegro '(:directories-are-files nil :follow-symbolic-links nil) #+(or clozure digitool) '(:follow-links nil) #+clisp '(:circle t :if-does-not-exist :ignore) - #+(or cmu scl) '(:follow-links nil :truenamep nil) + #+(or cmucl scl) '(:follow-links nil :truenamep nil) #+lispworks '(:link-transparency nil) #+sbcl (when (find-symbol* :resolve-symlinks '#:sb-impl nil) '(:resolve-symlinks nil)))))) @@ -3014,9 +2964,9 @@ The behavior in presence of symlinks is not portable. Use IOlib to handle such s (let* ((directory (ensure-directory-pathname directory)) #-(or abcl cormanlisp genera xcl) (wild (merge-pathnames* - #-(or abcl allegro cmu lispworks sbcl scl xcl) + #-(or abcl allegro cmucl lispworks sbcl scl xcl) *wild-directory* - #+(or abcl allegro cmu lispworks sbcl scl xcl) "*.*" + #+(or abcl allegro cmucl lispworks sbcl scl xcl) "*.*" directory)) (dirs #-(or abcl cormanlisp genera xcl) @@ -3025,17 +2975,17 @@ The behavior in presence of symlinks is not portable. Use IOlib to handle such s #+mcl '(:directories t)))) #+(or abcl xcl) (system:list-directory directory) #+cormanlisp (cl::directory-subdirs directory) - #+genera (fs:directory-list directory)) - #+(or abcl allegro cmu genera lispworks sbcl scl xcl) + #+genera (handler-case (fs:directory-list directory) (fs:directory-not-found () nil))) + #+(or abcl allegro cmucl genera lispworks sbcl scl xcl) (dirs (loop :for x :in dirs :for d = #+(or abcl xcl) (extensions:probe-directory x) #+allegro (excl:probe-directory x) - #+(or cmu sbcl scl) (directory-pathname-p x) + #+(or cmucl sbcl scl) (directory-pathname-p x) #+genera (getf (cdr x) :directory) #+lispworks (lw:file-directory-p x) :when d :collect #+(or abcl allegro xcl) d #+genera (ensure-directory-pathname (first x)) - #+(or cmu lispworks sbcl scl) x))) + #+(or cmucl lispworks sbcl scl) x))) (filter-logical-directory-results directory dirs (let ((prefix (or (normalize-pathname-directory-component (pathname-directory directory)) @@ -3080,13 +3030,13 @@ The behavior in presence of symlinks is not portable. Use IOlib to handle such s (loop :while up-components :do (if-let (parent (ignore-errors - (probe-file* (make-pathname* :directory `(:absolute ,@(reverse up-components)) - :name nil :type nil :version nil :defaults p)))) + (probe-file* (make-pathname :directory `(:absolute ,@(reverse up-components)) + :name nil :type nil :version nil :defaults p)))) (if-let (simplified (ignore-errors (merge-pathnames* - (make-pathname* :directory `(:relative ,@down-components) - :defaults p) + (make-pathname :directory `(:relative ,@down-components) + :defaults p) (ensure-directory-pathname parent)))) (return simplified))) (push (pop up-components) down-components) @@ -3332,7 +3282,7 @@ NILs." #+(or allegro clasp ecl mkcl) #p"SYS:" ;;#+clisp custom:*lib-directory* ; causes failure in asdf-pathname-test(!) #+clozure #p"ccl:" - #+cmu (ignore-errors (pathname-parent-directory-pathname (truename #p"modules:"))) + #+cmucl (ignore-errors (pathname-parent-directory-pathname (truename #p"modules:"))) #+gcl system::*system-directory* #+lispworks lispworks:*lispworks-directory* #+sbcl (if-let (it (find-symbol* :sbcl-homedir-pathname :sb-int nil)) @@ -3386,10 +3336,10 @@ in an atomic way if the implementation allows." #+allegro (excl:delete-directory directory-pathname) #+clisp (ext:delete-directory directory-pathname) #+clozure (ccl::delete-empty-directory directory-pathname) - #+(or cmu scl) (multiple-value-bind (ok errno) + #+(or cmucl scl) (multiple-value-bind (ok errno) (unix:unix-rmdir (native-namestring directory-pathname)) (unless ok - #+cmu (error "Error number ~A when trying to delete directory ~A" + #+cmucl (error "Error number ~A when trying to delete directory ~A" errno directory-pathname) #+scl (error "~@<Error deleting ~S: ~A~@:>" directory-pathname (unix:get-unix-error-msg errno)))) @@ -3402,7 +3352,7 @@ in an atomic way if the implementation allows." `(,dd directory-pathname) ;; requires SBCL 1.0.44 or later `(progn (require :sb-posix) (symbol-call :sb-posix :rmdir directory-pathname))) #+xcl (symbol-call :uiop :run-program `("rmdir" ,(native-namestring directory-pathname))) - #-(or abcl allegro clasp clisp clozure cmu cormanlisp digitool ecl gcl genera lispworks mkcl sbcl scl xcl) + #-(or abcl allegro clasp clisp clozure cmucl cormanlisp digitool ecl gcl genera lispworks mkcl sbcl scl xcl) (error "~S not implemented on ~S" 'delete-empty-directory (implementation-type))) ; genera

(defun delete-directory-tree (directory-pathname &key (validate nil validatep) (if-does-not-exist :error)) @@ -3436,7 +3386,7 @@ If you're suicidal or extremely confident, just use :VALIDATE T." (error "~S was asked to delete ~S but the directory does not exist" 'delete-directory-tree directory-pathname)) (:ignore nil))) - #-(or allegro cmu clozure genera sbcl scl) + #-(or allegro cmucl clozure genera sbcl scl) ((os-unix-p) ;; On Unix, don't recursively walk the directory and delete everything in Lisp, ;; except on implementations where we can prevent DIRECTORY from following symlinks; ;; instead spawn a standard external program to do the dirty work. @@ -3463,8 +3413,6 @@ If you're suicidal or extremely confident, just use :VALIDATE T." ;;;; Utilities related to streams

(uiop/package:define-package :uiop/stream - (:nicknames :asdf/stream) - (:recycle :uiop/stream :asdf/stream :asdf) (:use :uiop/common-lisp :uiop/package :uiop/utility :uiop/os :uiop/pathname :uiop/filesystem) (:export #:*default-stream-element-type* @@ -3495,7 +3443,7 @@ If you're suicidal or extremely confident, just use :VALIDATE T."

(with-upgradability () (defvar *default-stream-element-type* - (or #+(or abcl cmu cormanlisp scl xcl) 'character + (or #+(or abcl cmucl cormanlisp scl xcl) 'character #+lispworks 'lw:simple-char :default) "default element-type for open (depends on the current CL implementation)") @@ -3506,7 +3454,7 @@ If you're suicidal or extremely confident, just use :VALIDATE T." (defun setup-stdin () (setf *stdin* #.(or #+clozure 'ccl::*stdin* - #+(or cmu scl) 'system:*stdin* + #+(or cmucl scl) 'system:*stdin* #+(or clasp ecl) 'ext::+process-standard-input+ #+sbcl 'sb-sys:*stdin* '*standard-input*))) @@ -3517,7 +3465,7 @@ If you're suicidal or extremely confident, just use :VALIDATE T." (defun setup-stdout () (setf *stdout* #.(or #+clozure 'ccl::*stdout* - #+(or cmu scl) 'system:*stdout* + #+(or cmucl scl) 'system:*stdout* #+(or clasp ecl) 'ext::+process-standard-output+ #+sbcl 'sb-sys:*stdout* '*standard-output*))) @@ -3529,7 +3477,7 @@ If you're suicidal or extremely confident, just use :VALIDATE T." (setf *stderr* #.(or #+allegro 'excl::*stderr* #+clozure 'ccl::*stderr* - #+(or cmu scl) 'system:*stderr* + #+(or cmucl scl) 'system:*stderr* #+(or clasp ecl) 'ext::+process-error-output+ #+sbcl 'sb-sys:*stderr* '*error-output*))) @@ -3814,7 +3762,7 @@ Otherwise, using WRITE-SEQUENCE using a buffer of size BUFFER-SIZE." (when eof (return))) (loop :with buffer-size = (or buffer-size 8192) - :for buffer = (make-array (list buffer-size) :element-type (or element-type 'character)) + :with buffer = (make-array (list buffer-size) :element-type (or element-type 'character)) :for end = (read-sequence buffer input) :until (zerop end) :do (write-sequence buffer output :end end) @@ -4027,7 +3975,7 @@ ELEMENT-TYPE (defaults to *DEFAULT-STREAM-ELEMENT-TYPE*) and EXTERNAL-FORMAT (defaults to *UTF-8-EXTERNAL-FORMAT*). If WANT-STREAM-P is true (the defaults to T), then THUNK will then be CALL-FUNCTION'ed with the stream and the pathname (if WANT-PATHNAME-P is true, defaults to T), -and stream with be closed after the THUNK exits (either normally or abnormally). +and stream will be closed after the THUNK exits (either normally or abnormally). If WANT-STREAM-P is false, then WANT-PATHAME-P must be true, and then THUNK is only CALL-FUNCTION'ed after the stream is closed, with the pathname as argument. Upon exit of THUNK, the AFTER thunk if defined is CALL-FUNCTION'ed with the pathname as argument. @@ -4164,8 +4112,6 @@ For the latter case, we ought pick a random suffix and atomically open it." ;;;; Starting, Stopping, Dumping a Lisp image

(uiop/package:define-package :uiop/image - (:nicknames :asdf/image) - (:recycle :uiop/image :asdf/image :xcvb-driver) (:use :uiop/common-lisp :uiop/package :uiop/utility :uiop/pathname :uiop/stream :uiop/os) (:export #:*image-dumped-p* #:raw-command-line-arguments #:*command-line-arguments* @@ -4231,7 +4177,7 @@ This is designed to abstract away the implementation specific quit forms." #+clisp (ext:quit code) #+clozure (ccl:quit code) #+cormanlisp (win32:exitprocess code) - #+(or cmu scl) (unix:unix-exit code) + #+(or cmucl scl) (unix:unix-exit code) #+gcl (system:quit code) #+genera (error "~S: You probably don't want to Halt Genera. (code: ~S)" 'quit code) #+lispworks (lispworks:quit :status code :confirm nil :return nil :ignore-errors-p t) @@ -4242,7 +4188,7 @@ This is designed to abstract away the implementation specific quit forms." (cond (exit `(,exit :code code :abort (not finish-output))) (quit `(,quit :unix-status code :recklessly-p (not finish-output))))) - #-(or abcl allegro clasp clisp clozure cmu ecl gcl genera lispworks mcl mkcl sbcl scl xcl) + #-(or abcl allegro clasp clisp clozure cmucl ecl gcl genera lispworks mcl mkcl sbcl scl xcl) (error "~S called with exit code ~S but there's no quitting on this implementation" 'quit code))

(defun die (code format &rest arguments) @@ -4285,7 +4231,7 @@ This is designed to abstract away the implementation specific quit forms." #+clozure (ccl:print-call-history :count count :start-frame-number 1) #+mcl (ccl:print-call-history :detailed-p nil) (finish-output stream)) - #+(or cmu scl) + #+(or cmucl scl) (let ((debug:*debug-print-level* *print-level*) (debug:*debug-print-length* *print-length*)) (debug:backtrace (or count most-positive-fixnum) stream)) @@ -4389,14 +4335,14 @@ depending on whether *LISP-INTERACTION* is set, enter debugger or die" #+(or clasp ecl) (loop :for i :from 0 :below (si:argc) :collect (si:argv i)) #+clisp (coerce (ext:argv) 'list) #+clozure ccl:*command-line-argument-list* - #+(or cmu scl) extensions:*command-line-strings* + #+(or cmucl scl) extensions:*command-line-strings* #+gcl si:*command-args* #+(or genera mcl) nil #+lispworks sys:*line-arguments-list* #+mkcl (loop :for i :from 0 :below (mkcl:argc) :collect (mkcl:argv i)) #+sbcl sb-ext:*posix-argv* #+xcl system:*argv* - #-(or abcl allegro clasp clisp clozure cmu ecl gcl genera lispworks mcl mkcl sbcl scl xcl) + #-(or abcl allegro clasp clisp clozure cmucl ecl gcl genera lispworks mcl mkcl sbcl scl xcl) (error "raw-command-line-arguments not implemented yet"))

(defun command-line-arguments (&optional (arguments (raw-command-line-arguments))) @@ -4425,7 +4371,7 @@ Otherwise, return NIL." (cond ((eq *image-dumped-p* :executable) ; yes, this ARGV0 is our argv0 ! ;; NB: not currently available on ABCL, Corman, Genera, MCL - (or #+(or allegro clisp clozure cmu gcl lispworks sbcl scl xcl) + (or #+(or allegro clisp clozure cmucl gcl lispworks sbcl scl xcl) (first (raw-command-line-arguments)) #+(or clasp ecl) (si:argv 0) #+mkcl (mkcl:argv 0))) (t ;; argv[0] is the name of the interpreter. @@ -4515,7 +4461,7 @@ or COMPRESSION on SBCL, and APPLICATION-TYPE on SBCL/Windows." (setf *image-dump-hook* dump-hook) (call-image-dump-hook) (setf *image-restored-p* nil) - #-(or clisp clozure cmu lispworks sbcl scl) + #-(or clisp clozure cmucl lispworks sbcl scl) (when executable (error "Dumping an executable is not supported on this implementation! Aborting.")) #+allegro @@ -4543,13 +4489,13 @@ or COMPRESSION on SBCL, and APPLICATION-TYPE on SBCL/Windows." (funcall (fdefinition 'ccl::write-elf-symbols-to-file) path) (dump path)) (dump t))) - #+(or cmu scl) + #+(or cmucl scl) (progn (ext:gc :full t) (setf ext:*batch-mode* nil) (setf ext::*gc-run-time* 0) (apply 'ext:save-lisp filename - #+cmu :executable #+cmu t + #+cmucl :executable #+cmucl t (when executable '(:init-function restore-image :process-command-line nil)))) #+gcl (progn @@ -4572,7 +4518,7 @@ or COMPRESSION on SBCL, and APPLICATION-TYPE on SBCL/Windows." #+(and sbcl os-windows) ;; passing :application-type :gui will disable the console window. ;; the default is :console - only works with SBCL 1.1.15 or later. (when application-type (list :application-type application-type))))) - #-(or allegro clisp clozure cmu gcl lispworks sbcl scl) + #-(or allegro clisp clozure cmucl gcl lispworks sbcl scl) (error "Can't ~S ~S: UIOP doesn't support image dumping with ~A.~%" 'dump-image filename (nth-value 1 (implementation-type))))

@@ -4636,8 +4582,7 @@ or COMPRESSION on SBCL, and APPLICATION-TYPE on SBCL/Windows." ;;;; run-program initially from xcvb-driver.

(uiop/package:define-package :uiop/run-program - (:nicknames :asdf/run-program) - (:recycle :uiop/run-program :asdf/run-program :xcvb-driver) + (:nicknames :asdf/run-program) ; OBSOLETE. Used by cl-sane, printv. (:use :uiop/common-lisp :uiop/package :uiop/utility :uiop/pathname :uiop/os :uiop/filesystem :uiop/stream) (:export @@ -5554,8 +5499,7 @@ or an indication of failure via the EXIT-CODE of the process" ;;;; Support to build (compile and load) Lisp files

(uiop/package:define-package :uiop/lisp-build - (:nicknames :asdf/lisp-build) - (:recycle :uiop/lisp-build :asdf/lisp-build :asdf) + (:nicknames :asdf/lisp-build) ;; OBSOLETE, used by slime/contrib/swank-asdf.lisp (:use :uiop/common-lisp :uiop/package :uiop/utility :uiop/os :uiop/pathname :uiop/filesystem :uiop/stream :uiop/image) (:export @@ -5618,7 +5562,7 @@ This can help you produce more deterministic output for FASLs.")) #+clisp '() ;; system::*optimize* is a constant hash-table! (with non-constant contents) #+clozure '(ccl::*nx-speed* ccl::*nx-space* ccl::*nx-safety* ccl::*nx-debug* ccl::*nx-cspeed*) - #+(or cmu scl) '(c::*default-cookie*) + #+(or cmucl scl) '(c::*default-cookie*) #+(and ecl (not clasp)) (unless (use-ecl-byte-compiler-p) '(c::*speed* c::*space* c::*safety* c::*debug*)) #+clasp '() #+gcl '(compiler::*speed* compiler::*space* compiler::*compiler-new-safety* compiler::*debug*) @@ -5627,11 +5571,11 @@ This can help you produce more deterministic output for FASLs.")) #+sbcl '(sb-c::*policy*))) (defun get-optimization-settings () "Get current compiler optimization settings, ready to PROCLAIM again" - #-(or abcl allegro clasp clisp clozure cmu ecl lispworks mkcl sbcl scl xcl) + #-(or abcl allegro clasp clisp clozure cmucl ecl lispworks mkcl sbcl scl xcl) (warn "~S does not support ~S. Please help me fix that." 'get-optimization-settings (implementation-type)) - #+(or abcl allegro clasp clisp clozure cmu ecl lispworks mkcl sbcl scl xcl) - (let ((settings '(speed space safety debug compilation-speed #+(or cmu scl) c::brevity))) + #+(or abcl allegro clasp clisp clozure cmucl ecl lispworks mkcl sbcl scl xcl) + (let ((settings '(speed space safety debug compilation-speed #+(or cmucl scl) c::brevity))) #.`(loop #+(or allegro clozure) ,@'(:with info = #+allegro (sys:declaration-information 'optimize) #+clozure (ccl:declaration-information 'optimize nil)) @@ -5640,7 +5584,7 @@ This can help you produce more deterministic output for FASLs.")) :for y = (or #+(or allegro clozure) (second (assoc x info)) ; normalize order #+clisp (gethash x system::*optimize* 1) #+(or abcl clasp ecl mkcl xcl) (symbol-value v) - #+(or cmu scl) (slot-value c::*default-cookie* + #+(or cmucl scl) (slot-value c::*default-cookie* (case x (compilation-speed 'c::cspeed) (otherwise x))) #+lispworks (slot-value compiler::*optimization-level* x) @@ -5682,7 +5626,7 @@ This can help you produce more deterministic output for FASLs.")) (defvar *usual-uninteresting-conditions* (append ;;#+clozure '(ccl:compiler-warning) - #+cmu '("Deleting unreachable code.") + #+cmucl '("Deleting unreachable code.") #+lispworks '("~S being redefined in ~A (previously in ~A)." "~S defined more than once in ~A.") ;; lispworks gets confused by eval-when. #+sbcl @@ -5867,7 +5811,7 @@ Simple means made of symbols, numbers, characters, simple-strings, pathnames, co :warning-type warning-type :args (destructuring-bind (fun . more) args (cons (symbolify-function-name fun) more)))))) - #+(or cmu scl) + #+(or cmucl scl) (defun reify-undefined-warning (warning) ;; Extracting undefined-warnings from the compilation-unit ;; To be passed through the above reify/unreify link, it must be a "simple-sexp" @@ -5919,7 +5863,7 @@ WITH-COMPILATION-UNIT. One of three functions required for deferred-warnings sup (if-let (dw ccl::*outstanding-deferred-warnings*) (let ((mdw (ccl::ensure-merged-deferred-warnings dw))) (ccl::deferred-warnings.warnings mdw)))) - #+(or cmu scl) + #+(or cmucl scl) (when lisp::*in-compilation-unit* ;; Try to send nothing through the pipe if nothing needs to be accumulated `(,@(when c::*undefined-warnings* @@ -5965,7 +5909,7 @@ One of three functions required for deferred-warnings support in ASDF." (setf ccl::*outstanding-deferred-warnings* (ccl::%defer-warnings t))))) (appendf (ccl::deferred-warnings.warnings dw) (mapcar 'unreify-deferred-warning reified-deferred-warnings))) - #+(or cmu scl) + #+(or cmucl scl) (dolist (item reified-deferred-warnings) ;; Each item is (symbol . adjustment) where the adjustment depends on the symbol. ;; For *undefined-warnings*, the adjustment is a list of initargs. @@ -6028,7 +5972,7 @@ One of three functions required for deferred-warnings support in ASDF." (if-let (dw ccl::*outstanding-deferred-warnings*) (let ((mdw (ccl::ensure-merged-deferred-warnings dw))) (setf (ccl::deferred-warnings.warnings mdw) nil))) - #+(or cmu scl) + #+(or cmucl scl) (when lisp::*in-compilation-unit* (setf c::*undefined-warnings* nil c::*compiler-error-count* 0 @@ -6194,25 +6138,26 @@ possibly in a different process. Otherwise just call THUNK." "This function provides a portable wrapper around COMPILE-FILE. It ensures that the OUTPUT-FILE value is only returned and the file only actually created if the compilation was successful, -even though your implementation may not do that, and including -an optional call to an user-provided consistency check function COMPILE-CHECK; +even though your implementation may not do that. It also checks an optional +user-provided consistency function COMPILE-CHECK to determine success; it will call this function if not NIL at the end of the compilation with the arguments sent to COMPILE-FILE*, except with :OUTPUT-FILE TMP-FILE where TMP-FILE is the name of a temporary output-file. It also checks two flags (with legacy british spelling from ASDF1), *COMPILE-FILE-FAILURE-BEHAVIOUR* and *COMPILE-FILE-WARNINGS-BEHAVIOUR* with appropriate implementation-dependent defaults, -and if a failure (respectively warnings) are reported by COMPILE-FILE -with consider it an error unless the respective behaviour flag +and if a failure (respectively warnings) are reported by COMPILE-FILE, +it will consider that an error unless the respective behaviour flag is one of :SUCCESS :WARN :IGNORE. If WARNINGS-FILE is defined, deferred warnings are saved to that file. On ECL or MKCL, it creates both the linkable object and loadable fasl files. On implementations that erroneously do not recognize standard keyword arguments, it will filter them appropriately." - #+(or clasp ecl) (when (and object-file (equal (compile-file-type) (pathname object-file))) - (format t "Whoa, some funky ASDF upgrade switched ~S calling convention for ~S and ~S~%" - 'compile-file* output-file object-file) - (rotatef output-file object-file)) + #+(or clasp ecl) + (when (and object-file (equal (compile-file-type) (pathname object-file))) + (format t "Whoa, some funky ASDF upgrade switched ~S calling convention for ~S and ~S~%" + 'compile-file* output-file object-file) + (rotatef output-file object-file)) (let* ((keywords (remove-plist-keys `(:output-file :compile-check :warnings-file #+clisp :lib-file #+(or clasp ecl mkcl) :object-file) keys)) @@ -6223,7 +6168,7 @@ it will filter them appropriately." (object-file (unless (use-ecl-byte-compiler-p) (or object-file - #+ecl(compile-file-pathname output-file :type :object) + #+ecl (compile-file-pathname output-file :type :object) #+clasp (compile-file-pathname output-file :output-type :object)))) #+mkcl (object-file @@ -6344,8 +6289,7 @@ it will filter them appropriately." ;;;; Generic support for configuration files

(uiop/package:define-package :uiop/configuration - (:nicknames :asdf/configuration) - (:recycle :uiop/configuration :asdf/configuration :asdf) + (:recycle :uiop/configuration :asdf/configuration) ;; necessary to upgrade from 2.27. (:use :uiop/common-lisp :uiop/utility :uiop/os :uiop/pathname :uiop/filesystem :uiop/stream :uiop/image :uiop/lisp-build) (:export @@ -6541,7 +6485,7 @@ directive.") ;; but what it means to the output-translations is ;; "relative to the root of the source pathname's host and device". (return-from resolve-absolute-location - (let ((p (make-pathname* :directory '(:relative)))) + (let ((p (make-pathname :directory '(:relative)))) (if wilden (wilden p) p)))) ((eql :home) (user-homedir-pathname)) ((eql :here) (resolve-absolute-location @@ -6758,14 +6702,11 @@ objects. Side-effects for cached file location computation." ;;; Hacks for backward-compatibility of the driver

(uiop/package:define-package :uiop/backward-driver - (:nicknames :asdf/backward-driver) - (:recycle :uiop/backward-driver :asdf/backward-driver :asdf) (:use :uiop/common-lisp :uiop/package :uiop/utility :uiop/pathname :uiop/stream :uiop/os :uiop/image :uiop/run-program :uiop/lisp-build :uiop/configuration) (:export - #:coerce-pathname #:component-name-to-pathname-components - #+(or clasp ecl mkcl) #:compile-file-keeping-object + #:coerce-pathname #:user-configuration-directories #:system-configuration-directories #:in-first-directory #:in-user-configuration-directory #:in-system-configuration-directory )) @@ -6776,27 +6717,11 @@ objects. Side-effects for cached file location computation." (with-upgradability () (defun coerce-pathname (name &key type defaults) ;; For backward-compatibility only, for people using internals - ;; Reported users in quicklisp: hu.dwim.asdf, asdf-utils, xcvb - ;; Will be removed after 2014-01-16. + ;; Reported users in quicklisp 2015-11: hu.dwim.asdf (removed in next release) + ;; Will be removed after 2015-12. ;;(warn "Please don't use ASDF::COERCE-PATHNAME. Use ASDF/PATHNAME:PARSE-UNIX-NAMESTRING.") (parse-unix-namestring name :type type :defaults defaults))

- (defun component-name-to-pathname-components (unix-style-namestring - &key force-directory force-relative) - ;; Will be removed after 2014-01-16. - ;; (warn "Please don't use ASDF::COMPONENT-NAME-TO-PATHNAME-COMPONENTS, use SPLIT-UNIX-NAMESTRING-DIRECTORY-COMPONENTS") - (multiple-value-bind (relabs path filename file-only) - (split-unix-namestring-directory-components - unix-style-namestring :ensure-directory force-directory) - (declare (ignore file-only)) - (when (and force-relative (not (eq relabs :relative))) - (error (compatfmt "~@<Absolute pathname designator not allowed: ~3i~_~S~@:>") - unix-style-namestring)) - (values relabs path filename))) - - #+(or clasp ecl mkcl) - (defun compile-file-keeping-object (&rest args) (apply #'compile-file* args)) - ;; Backward compatibility for ASDF 2.27 to 3.1.4 (defun user-configuration-directories () "Return the current user's list of user configuration directories @@ -6829,7 +6754,8 @@ for common-lisp. DEPRECATED." ;;;; Re-export all the functionality in UIOP

(uiop/package:define-package :uiop/driver - (:nicknames :uiop :asdf/driver :asdf-driver :asdf-utils) + (:nicknames :uiop :asdf/driver) ;; asdf/driver is obsolete (uiop isn't); + ;; but asdf/driver is still used by swap-bytes, static-vectors. (:use :uiop/common-lisp) ;; NB: not reexporting uiop/common-lisp ;; which include all of CL with compatibility modifications on select platforms, @@ -6837,9 +6763,8 @@ for common-lisp. DEPRECATED." ;; or :use (closer-common-lisp uiop), etc. (:use-reexport :uiop/package :uiop/utility - :uiop/os :uiop/pathname :uiop/stream :uiop/filesystem :uiop/image - :uiop/run-program :uiop/lisp-build - :uiop/configuration :uiop/backward-driver)) + :uiop/os :uiop/pathname :uiop/filesystem :uiop/stream :uiop/image + :uiop/run-program :uiop/lisp-build :uiop/configuration :uiop/backward-driver))

;; Provide both lowercase and uppercase, to satisfy more people. (provide "uiop") (provide "UIOP") @@ -6853,7 +6778,7 @@ for common-lisp. DEPRECATED." (:export #:asdf-version #:*previous-asdf-versions* #:*asdf-version* #:asdf-message #:*verbose-out* - #:upgrading-p #:when-upgrading #:upgrade-asdf #:asdf-upgrade-error #:defparameter* + #:upgrading-p #:when-upgrading #:upgrade-asdf #:defparameter* #:*post-upgrade-cleanup-hook* #:*post-upgrade-restart-hook* #:cleanup-upgraded-asdf ;; There will be no symbol left behind! #:intern*) @@ -6875,7 +6800,16 @@ You can compare this string with e.g.: (ASDF:VERSION-SATISFIES (ASDF:ASDF-VERSIO (cons (format nil "~{~D~^.~}" rev)) (null "1.0")))))) ;; Important: define *p-a-v* /before/ *a-v* so that it initializes correctly. - (defvar *previous-asdf-versions* (if-let (previous (asdf-version)) (list previous))) + (defvar *previous-asdf-versions* + (let ((previous (asdf-version))) + (when previous + ;; Punt on hard package upgrade: from ASDF1 or ASDF2 + (when (version< previous "2.27") ;; 2.27 is the first to have the :asdf3 feature. + (let ((away (format nil "~A-~A" :asdf previous))) + (rename-package :asdf away) + (when *load-verbose* + (format t "~&; Renamed old ~A package away to ~A~%" :asdf away))))) + (list previous))) (defvar *asdf-version* nil) ;; We need to clear systems from versions yet older than the below: (defparameter *oldest-forward-compatible-asdf-version* "2.33") ;; 2.32.13 renames a slot in component. @@ -6912,7 +6846,7 @@ previously-loaded version of ASDF." ;; "3.4.5.67" would be a development version in the official branch, on top of 3.4.5. ;; "3.4.5.0.8" would be your eighth local modification of official release 3.4.5 ;; "3.4.5.67.8" would be your eighth local modification of development version 3.4.5.67 - (asdf-version "3.1.6") + (asdf-version "3.1.7") (existing-version (asdf-version))) (setf *asdf-version* asdf-version) (when (and existing-version (not (equal asdf-version existing-version))) @@ -6926,21 +6860,7 @@ previously-loaded version of ASDF." (let ((redefined-functions ;; gf signature and/or semantics changed incompatibly. Oops. ;; NB: it's too late to do anything about functions in UIOP! ;; If you introduce some critically incompatibility there, you must change name. - '(#:component-relative-pathname #:component-parent-pathname ;; component - #:source-file-type - #:find-system #:system-source-file #:system-relative-pathname ;; system - #:find-component ;; find-component - #:explain #:perform #:perform-with-restarts #:input-files #:output-files ;; action - #:component-depends-on #:operation-done-p #:component-depends-on - #:traverse ;; backward-interface - #:map-direct-dependencies #:reduce-direct-dependencies #:direct-dependencies ;; plan - #:operate ;; operate - #:parse-component-form ;; defsystem - #:apply-output-translations ;; output-translations - #:process-output-translations-directive - #:inherit-source-registry #:process-source-registry ;; source-registry - #:process-source-registry-directive - #:trivial-system-p)) ;; bundle + '()) ;; empty now that we don't unintern, but wholly punt on ASDF 2.26 or earlier. (redefined-classes ;; redefining the classes causes interim circularities ;; with the old ASDF during upgrade, and many implementations bork @@ -6962,12 +6882,6 @@ previously-loaded version of ASDF." ;;; Self-upgrade functions

(with-upgradability () - (defun asdf-upgrade-error () - ;; Important notice for whom it concerns. The crux of the matter is that - ;; TRAVERSE can be completely refactored, and so after the find-system returns, it's too late. - (error "When a system transitively depends on ASDF, it must :defsystem-depends-on (:asdf)~%~ - Otherwise, when you upgrade from ASDF 2, you must do it before you operate on any system.~%")) - (defun cleanup-upgraded-asdf (&optional (old-version (first *previous-asdf-versions*))) (let ((new-version (asdf-version))) (unless (equal old-version new-version) @@ -7072,7 +6986,7 @@ another pathname in a degenerate way.")) ;; condition objects, which in turn does inheritance of :report options at ;; run-time. fortunately, inheritance means we only need this kludge here in ;; order to fix all conditions that build on it. -- rgr, 28-Jul-02.] - #+cmu (:report print-object)) + #+cmucl (:report print-object))

(define-condition duplicate-names (system-definition-error) ((name :initarg :name :reader duplicate-names-name)) @@ -7110,10 +7024,9 @@ another pathname in a degenerate way.")) ;; See our ASDF 2 paper for more complete explanations. (in-order-to :initform nil :initarg :in-order-to :accessor component-in-order-to) - ;; methods defined using the "inline" style inside a defsystem form: - ;; need to store them somewhere so we can delete them when the system - ;; is re-evaluated. - (inline-methods :accessor component-inline-methods :initform nil) ;; OBSOLETE! DELETE THIS IF NO ONE USES. + ;; Methods defined using the "inline" style inside a defsystem form: + ;; we store them here so we can delete them when the system is re-evaluated. + (inline-methods :accessor component-inline-methods :initform nil) ;; ASDF4: rename it from relative-pathname to specified-pathname. It need not be relative. ;; There is no initform and no direct accessor for this specified pathname, ;; so we only access the information through appropriate methods, after it has been processed. @@ -7502,7 +7415,8 @@ in which the system specification (.asd file) is located." #:remove-entry-from-registry #:coerce-entry-to-directory #:coerce-name #:primary-system-name #:coerce-filename #:find-system #:locate-system #:load-asd - #:system-registered-p #:register-system #:registered-systems #:clear-system #:map-systems + #:system-registered-p #:register-system #:registered-systems* #:registered-systems + #:clear-system #:map-systems #:missing-component #:missing-requires #:missing-parent #:formatted-system-definition-error #:format-control #:format-arguments #:sysdef-error #:load-system-definition-error #:error-name #:error-pathname #:error-condition @@ -7567,9 +7481,12 @@ of which is a system object.") (defun system-registered-p (name) (gethash (coerce-name name) *defined-systems*))

- (defun registered-systems () + (defun registered-systems* () (loop :for registered :being :the :hash-values :of *defined-systems* - :collect (coerce-name (cdr registered)))) + :collect (cdr registered))) + + (defun registered-systems () + (mapcar 'coerce-name (registered-systems*)))

(defun register-system (system) (check-type system system) @@ -7788,7 +7705,8 @@ Going forward, we recommend new users should be using the source-registry. (find-system (coerce-name name) error-p))

(defun find-system-if-being-defined (name) - ;; notable side effect: mark the system as being defined, to avoid infinite loops + ;; NB: this depends on a corresponding side-effect in parse-defsystem; + ;; this protocol may change somewhat in the future. (first (gethash `(find-system ,(coerce-name name)) *asdf-cache*)))

(defun load-asd (pathname @@ -7809,10 +7727,10 @@ Going forward, we recommend new users should be using the source-registry. ;; resolve logical-pathnames so they won't wreak havoc in parsing namestrings. (pathname-directory-pathname (physicalize-pathname pathname)))) (handler-bind - ((error #'(lambda (condition) - (error 'load-system-definition-error - :name name :pathname pathname - :condition condition)))) + (((and error (not missing-component)) + #'(lambda (condition) + (error 'load-system-definition-error + :name name :pathname pathname :condition condition)))) (asdf-message (compatfmt "~&~@<; ~@;Loading system definition~@[ for ~A~] from ~A~@:>~%") name pathname) (load* pathname :external-format external-format)))))) @@ -8446,6 +8364,7 @@ The class needs to be updated for ASDF 3.1 and specify appropriate propagation m ;;;; Done performing (with-upgradability () (defgeneric component-operation-time (operation component)) ;; ASDF4: hide it behind plan-action-stamp + (defgeneric (setf component-operation-time) (time operation component)) (define-convenience-action-methods component-operation-time (operation component))

(defgeneric mark-operation-done (operation component)) ;; ASDF4: hide it behind (setf plan-action-stamp) @@ -8482,9 +8401,11 @@ in some previous image, or T if it needs to be done.") (defmethod component-operation-time ((o operation) (c component)) (gethash (type-of o) (component-operation-times c)))

+ (defmethod (setf component-operation-time) (stamp (o operation) (c component)) + (setf (gethash (type-of o) (component-operation-times c)) stamp)) + (defmethod mark-operation-done ((o operation) (c component)) - (setf (gethash (type-of o) (component-operation-times c)) - (compute-action-stamp nil o c :just-done t)))) + (setf (component-operation-time o c) (compute-action-stamp nil o c :just-done t))))

;;;; Perform @@ -9123,6 +9044,8 @@ the action of OPERATION on COMPONENT in the PLAN")) :index (if status ; index of action amongst all nodes in traversal (action-index status) ;; if already visited, keep index (incf (plan-total-action-count plan))))) ; else new index + (when (and done-p (not add-to-plan-p)) + (setf (component-operation-time operation component) stamp)) (when add-to-plan-p ; if it needs to be added to the plan, (incf (plan-planned-action-count plan)) ; count it (unless aniip ; if it's output-producing, @@ -9413,7 +9336,7 @@ to load it in current image."

(defun already-loaded-systems () "return a list of the names of the systems that have been successfully loaded so far" - (remove-if-not 'component-loaded-p (registered-systems))) + (mapcar 'coerce-name (remove-if-not 'component-loaded-p (registered-systems*))))

(defun require-system (system &rest keys &key &allow-other-keys) "Ensure the specified SYSTEM is loaded, passing the KEYS to OPERATE, but skip any update to the @@ -9853,7 +9776,7 @@ system names to pathnames of .asd files") (register-clear-configuration-hook 'clear-source-registry)

(defparameter *wild-asd* - (make-pathname* :directory nil :name *wild* :type "asd" :version :newest)) + (make-pathname :directory nil :name *wild* :type "asd" :version :newest))

(defun directory-asd-files (directory) (directory-files directory *wild-asd*)) @@ -9877,15 +9800,22 @@ after having found a .asd file? True by default.") (defun collect-sub*directories-asd-files (directory &key (exclude *default-source-registry-exclusions*) collect (recurse-beyond-asds *recurse-beyond-asds*) ignore-cache) - (collect-sub*directories - directory - #'(lambda (dir) - (unless (and (not ignore-cache) (process-source-registry-cache directory collect)) - (let ((asds (collect-asds-in-directory dir collect))) - (or recurse-beyond-asds (not asds))))) - #'(lambda (x) - (not (member (car (last (pathname-directory x))) exclude :test #'equal))) - (constantly nil))) + (let ((visited (make-hash-table :test 'equalp))) + (collect-sub*directories + directory + #'(lambda (dir) + (unless (and (not ignore-cache) (process-source-registry-cache directory collect)) + (let ((asds (collect-asds-in-directory dir collect))) + (or recurse-beyond-asds (not asds))))) + #'(lambda (x) ; x will be a directory pathname + (and + (not (member (car (last (pathname-directory x))) exclude :test #'equal)) + (flet ((pathname-key (x) + (namestring (truename* x)))) + (let ((visitedp (gethash (pathname-key x) visited))) + (if visitedp nil + (setf (gethash (pathname-key x) visited) t)))))) + (constantly nil))))

(defun validate-source-registry-directive (directive) (or (member directive '(:default-registry)) @@ -9978,7 +9908,7 @@ after having found a .asd file? True by default.") #+(or clasp ecl sbcl) (:tree ,(resolve-symlinks* (lisp-implementation-directory))) :inherit-configuration #+mkcl (:tree ,(translate-logical-pathname "CONTRIB:")) - #+cmu (:tree #p"modules:") + #+cmucl (:tree #p"modules:") #+scl (:tree #p"file://modules/"))) (defun default-user-source-registry () `(:source-registry @@ -10295,7 +10225,7 @@ after having found a .asd file? True by default.")

;;; Main parsing function (with-upgradability () - (defun* parse-dependency-def (dd) + (defun parse-dependency-def (dd) (if (listp dd) (case (first dd) (:feature @@ -10316,12 +10246,12 @@ after having found a .asd file? True by default.") (otherwise (sysdef-error "Ill-formed dependency: ~s" dd))) (coerce-name dd)))

- (defun* parse-dependency-defs (dd-list) + (defun parse-dependency-defs (dd-list) "Parse the dependency defs in DD-LIST into canonical form by translating all system names contained using COERCE-NAME. Return the result." (mapcar 'parse-dependency-def dd-list))

- (defun* (parse-component-form) (parent options &key previous-serial-component) + (defun (parse-component-form) (parent options &key previous-serial-component) (destructuring-bind (type name &rest rest &key (builtin-system-p () bspp) @@ -10411,6 +10341,15 @@ system names contained using COERCE-NAME. Return the result." (with-asdf-cache () (let* ((name (coerce-name name)) (source-file (if sfp source-file (resolve-symlinks* (load-pathname)))) + ;; NB: handle defsystem-depends-on BEFORE to create the system object, + ;; so that in case it fails, there is no incomplete object polluting the build. + (checked-defsystem-depends-on + (let* ((dep-forms (parse-dependency-defs defsystem-depends-on)) + (deps (loop :for spec :in dep-forms + :when (resolve-dependency-spec nil spec) + :collect :it))) + (load-systems* deps) + dep-forms)) (registered (system-registered-p name)) (registered! (if registered (rplaca registered (get-file-stamp source-file)) @@ -10419,17 +10358,12 @@ system names contained using COERCE-NAME. Return the result." (system (reset-system (cdr registered!) :name name :source-file source-file)) (component-options - (remove-plist-keys '(:defsystem-depends-on :class) options)) - (defsystem-dependencies (loop :for spec :in defsystem-depends-on - :when (resolve-dependency-spec nil spec) - :collect :it))) - ;; cache defsystem-depends-on in canonical form - (when defsystem-depends-on - (setf component-options - (append `(:defsystem-depends-on ,(parse-dependency-defs defsystem-depends-on)) - component-options))) + (append + (remove-plist-keys '(:defsystem-depends-on :class) options) + ;; cache defsystem-depends-on in canonical form + (when checked-defsystem-depends-on + `(:defsystem-depends-on ,checked-defsystem-depends-on))))) (set-asdf-cache-entry `(find-system ,name) (list system)) - (load-systems* defsystem-dependencies) ;; We change-class AFTER we loaded the defsystem-depends-on ;; since the class might be defined as part of those. (let ((class (class-for-type nil class))) @@ -10667,10 +10601,10 @@ for all the linkable object files associated with the system or its dependencies (format nil "~A~@[~A~]" (component-name c) (slot-value o 'name-suffix)))) (type (bundle-pathname-type bundle-type))) (values (list (subpathname (component-pathname c) name :type type)) - (eq (type-of o) (coerce-class (component-build-operation c) - :package :asdf/interface - :super 'operation - :error nil))))))) + (eq (class-of o) (coerce-class (component-build-operation c) + :package :asdf/interface + :super 'operation + :error nil)))))))

(defmethod output-files ((o bundle-op) (c system)) (bundle-output-files o c)) @@ -11023,16 +10957,6 @@ for all the linkable object files associated with the system or its dependencies :extra-object-files (or (extra-object-files o) (when programp (extra-object-files c))) :no-uiop (no-uiop c) (when programp `(:entry-point ,(component-entry-point c)))))))) - -#+(and (not asdf-use-unsafe-mac-bundle-op) - (or (and clasp ecl darwin) - (and abcl darwin (not abcl-bundle-op-supported)))) -(defmethod perform :before ((o basic-compile-bundle-op) (c component)) - (unless (featurep :asdf-use-unsafe-mac-bundle-op) - (cerror "Continue after modifying *FEATURES*." - "BASIC-COMPILE-BUNDLE-OP operations are not supported on Mac OS X for this lisp.~%~T~ -To continue, push :asdf-use-unsafe-mac-bundle-op onto *FEATURES*.~%~T~ -Please report to ASDF-DEVEL if this works for you."))) ;;;; ------------------------------------------------------------------------- ;;;; Concatenate-source

@@ -11219,11 +11143,12 @@ otherwise return a default system name computed from PACKAGE-NAME." (remove t (mapcar 'package-name-system (package-dependencies defpackage-form))) (error 'package-inferred-system-missing-package-error :system system :pathname file)))

- (defun same-package-inferred-system-p (system name directory subpath dependencies) + (defun same-package-inferred-system-p (system name directory subpath around-compile dependencies) (and (eq (type-of system) 'package-inferred-system) (equal (component-name system) name) (pathname-equal directory (component-pathname system)) (equal dependencies (component-sideway-dependencies system)) + (equal around-compile (around-compile-hook system)) (let ((children (component-children system))) (and (length=n-p children 1) (let ((child (first children))) @@ -11243,14 +11168,16 @@ otherwise return a default system name computed from PACKAGE-NAME." :truename *resolve-symlinks*))) (when (file-pathname-p f) (let ((dependencies (package-inferred-system-file-dependencies f system)) - (previous (cdr (system-registered-p system)))) - (if (same-package-inferred-system-p previous system dir sub dependencies) + (previous (cdr (system-registered-p system))) + (around-compile (around-compile-hook top))) + (if (same-package-inferred-system-p previous system dir sub around-compile dependencies) previous (eval `(defsystem ,system :class package-inferred-system :source-file nil :pathname ,dir :depends-on ,dependencies + :around-compile ,around-compile :components ((cl-source-file "lisp" :pathname ,sub)))))))))))))))

(with-upgradability () @@ -11264,27 +11191,14 @@ otherwise return a default system name computed from PACKAGE-NAME." (uiop/package:define-package :asdf/backward-internals (:recycle :asdf/backward-internals :asdf) (:use :uiop/common-lisp :uiop :asdf/upgrade :asdf/find-system) - (:export ;; for internal use - #:make-sub-operation - #:load-sysdef #:make-temporary-package)) + (:export #:load-sysdef)) (in-package :asdf/backward-internals)

-(when-upgrading (:when (fboundp 'make-sub-operation)) - (defun make-sub-operation (c o dep-c dep-o) - (declare (ignore c o dep-c dep-o)) (asdf-upgrade-error))) - -;;;; load-sysdef (with-upgradability () (defun load-sysdef (name pathname) - (load-asd pathname :name name)) - - (defun make-temporary-package () - ;; For loading a .asd file, we don't make a temporary package anymore, - ;; but use ASDF-USER. I'd like to have this function do this, - ;; but since whoever uses it is likely to delete-package the result afterwards, - ;; this would be a bad idea, so preserve the old behavior. - (make-package (fresh-package-name :prefix :asdf :index 0) :use '(:cl :asdf)))) - + (declare (ignore name pathname)) + ;; Needed for backward compatibility with swank-asdf from SLIME 2015-12-01 or older. + (error "Use asdf:load-asd instead of asdf::load-sysdef"))) ;;;; ------------------------------------------------------------------------- ;;; Backward-compatible interfaces

@@ -11654,12 +11568,12 @@ Please use UIOP:RUN-PROGRAM instead." (in-package :asdf/footer)

;;;; Hook ASDF into the implementation's REQUIRE and other entry points. -#+(or abcl clasp clisp clozure cmu ecl mkcl sbcl) +#+(or abcl clasp clisp clozure cmucl ecl mkcl sbcl) (with-upgradability () (if-let (x (and #+clisp (find-symbol* '#:*module-provider-functions* :custom nil))) (eval `(pushnew 'module-provide-asdf #+abcl sys::*module-provider-functions* - #+(or clasp cmu ecl) ext:*module-provider-functions* + #+(or clasp cmucl ecl) ext:*module-provider-functions* #+clisp ,x #+clozure ccl:*module-provider-functions* #+mkcl mk-ext:*module-provider-functions* @@ -11683,7 +11597,7 @@ Please use UIOP:RUN-PROGRAM instead." (and (first l) (register-preloaded-system (coerce-name name))) (values-list l))))))))

-#+cmu ;; Hook into the CMUCL herald. +#+cmucl ;; Hook into the CMUCL herald. (with-upgradability () (defun herald-asdf (stream) (format stream " ASDF ~A" (asdf-version))) @@ -11694,7 +11608,7 @@ Please use UIOP:RUN-PROGRAM instead." (with-upgradability () #+allegro (when (boundp 'excl:*warn-on-nested-reader-conditionals*) - (setf excl:*warn-on-nested-reader-conditionals* asdf/common-lisp::*acl-warn-save*)) + (setf excl:*warn-on-nested-reader-conditionals* uiop/common-lisp::*acl-warn-save*))

(dolist (f '(:asdf :asdf2 :asdf3 :asdf3.1 :asdf-package-system)) (pushnew f *features*))

===================================== src/contrib/asdf/doc/asdf.html ===================================== --- a/src/contrib/asdf/doc/asdf.html +++ b/src/contrib/asdf/doc/asdf.html @@ -31,7 +31,7 @@ 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. --> -<!-- Created by GNU Texinfo 5.2, http://www.gnu.org/software/texinfo/ --> +<!-- Created by GNU Texinfo 6.1, http://www.gnu.org/software/texinfo/ --> <head> <title>ASDF Manual</title>

@@ -48,16 +48,16 @@ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. <style type="text/css"> <!-- a.summary-letter {text-decoration: none} +blockquote.indentedblock {margin-right: 0em} +blockquote.smallindentedblock {margin-right: 0em; font-size: smaller} blockquote.smallquotation {font-size: smaller} div.display {margin-left: 3.2em} div.example {margin-left: 3.2em} -div.indentedblock {margin-left: 3.2em} div.lisp {margin-left: 3.2em} div.smalldisplay {margin-left: 3.2em} div.smallexample {margin-left: 3.2em} -div.smallindentedblock {margin-left: 3.2em; font-size: smaller} div.smalllisp {margin-left: 3.2em} -kbd {font-style:oblique} +kbd {font-style: oblique} pre.display {font-family: inherit} pre.format {font-family: inherit} pre.menu-comment {font-family: serif} @@ -66,10 +66,9 @@ pre.smalldisplay {font-family: inherit; font-size: smaller} pre.smallexample {font-size: smaller} pre.smallformat {font-family: inherit; font-size: smaller} pre.smalllisp {font-size: smaller} -span.nocodebreak {white-space:nowrap} -span.nolinebreak {white-space:nowrap} -span.roman {font-family:serif; font-weight:normal} -span.sansserif {font-family:sans-serif; font-weight:normal} +span.nolinebreak {white-space: nowrap} +span.roman {font-family: initial; font-weight: normal} +span.sansserif {font-family: sans-serif; font-weight: normal} ul.no-bullet {list-style: none} --> </style> @@ -77,14 +76,13 @@ ul.no-bullet {list-style: none}

</head>

-<body lang="en" bgcolor="#FFFFFF" text="#000000" link="#0000FF" vlink="#800080" alink="#FF0000"> +<body lang="en"> <h1 class="settitle" align="center">ASDF Manual</h1>

- <a name="SEC_Contents"></a> <h2 class="contents-heading">Table of Contents</h2>

@@ -124,16 +122,17 @@ ul.no-bullet {list-style: none} <li><a name="toc-Component-types" href="#Component-types">6.3.2 Component types</a></li> <li><a name="toc-System-class-names" href="#System-class-names">6.3.3 System class names</a></li> <li><a name="toc-Defsystem-depends-on" href="#Defsystem-depends-on">6.3.4 Defsystem depends on</a></li> - <li><a name="toc-Weakly-depends-on" href="#Weakly-depends-on">6.3.5 Weakly depends on</a></li> - <li><a name="toc-Pathname-specifiers" href="#Pathname-specifiers">6.3.6 Pathname specifiers</a></li> - <li><a name="toc-Version-specifiers" href="#Version-specifiers">6.3.7 Version specifiers</a></li> - <li><a name="toc-Require" href="#Require">6.3.8 Require</a></li> - <li><a name="toc-Using-logical-pathnames" href="#Using-logical-pathnames">6.3.9 Using logical pathnames</a></li> - <li><a name="toc-Serial-dependencies" href="#Serial-dependencies">6.3.10 Serial dependencies</a></li> - <li><a name="toc-Source-location-_0028_003apathname_0029" href="#Source-location-_0028_003apathname_0029">6.3.11 Source location (<code>:pathname</code>)</a></li> - <li><a name="toc-if_002dfeature-option" href="#if_002dfeature-option">6.3.12 if-feature option</a></li> - <li><a name="toc-if_002dcomponent_002ddep_002dfails-option" href="#if_002dcomponent_002ddep_002dfails-option">6.3.13 if-component-dep-fails option</a></li> - <li><a name="toc-feature-requirement" href="#feature-requirement">6.3.14 feature requirement</a></li> + <li><a name="toc-Build_002doperation" href="#Build_002doperation">6.3.5 Build-operation</a></li> + <li><a name="toc-Weakly-depends-on" href="#Weakly-depends-on">6.3.6 Weakly depends on</a></li> + <li><a name="toc-Pathname-specifiers" href="#Pathname-specifiers">6.3.7 Pathname specifiers</a></li> + <li><a name="toc-Version-specifiers" href="#Version-specifiers">6.3.8 Version specifiers</a></li> + <li><a name="toc-Require" href="#Require">6.3.9 Require</a></li> + <li><a name="toc-Using-logical-pathnames" href="#Using-logical-pathnames">6.3.10 Using logical pathnames</a></li> + <li><a name="toc-Serial-dependencies" href="#Serial-dependencies">6.3.11 Serial dependencies</a></li> + <li><a name="toc-Source-location-_0028_003apathname_0029" href="#Source-location-_0028_003apathname_0029">6.3.12 Source location (<code>:pathname</code>)</a></li> + <li><a name="toc-if_002dfeature-option" href="#if_002dfeature-option">6.3.13 if-feature option</a></li> + <li><a name="toc-if_002dcomponent_002ddep_002dfails-option" href="#if_002dcomponent_002ddep_002dfails-option">6.3.14 if-component-dep-fails option</a></li> + <li><a name="toc-feature-requirement" href="#feature-requirement">6.3.15 feature requirement</a></li> </ul></li> <li><a name="toc-Other-code-in-_002easd-files-1" href="#Other-code-in-_002easd-files">6.4 Other code in .asd files</a></li> <li><a name="toc-The-package_002dinferred_002dsystem-extension-1" href="#The-package_002dinferred_002dsystem-extension">6.5 The package-inferred-system extension</a></li> @@ -255,6 +254,7 @@ ul.no-bullet {list-style: none} <li><a name="toc-How-should-my-system-use-a-readtable-exported-by-another-system_003f" href="#How-should-my-system-use-a-readtable-exported-by-another-system_003f">13.6.7.1 How should my system use a readtable exported by another system?</a></li> <li><a name="toc-How-should-my-library-make-a-readtable-available-to-other-systems_003f" href="#How-should-my-library-make-a-readtable-available-to-other-systems_003f">13.6.7.2 How should my library make a readtable available to other systems?</a></li> </ul></li> + <li><a name="toc-How-can-I-capture-ASDF_0027s-output_003f-1" href="#How-can-I-capture-ASDF_0027s-output_003f">13.6.8 How can I capture ASDF&rsquo;s output?</a></li> </ul></li> <li><a name="toc-ASDF-development-FAQs-1" href="#ASDF-development-FAQs">13.7 ASDF development FAQs</a> <ul class="no-bullet"> @@ -275,7 +275,7 @@ ul.no-bullet {list-style: none} <a name="Top"></a> <a name="ASDF_003a-Another-System-Definition-Facility"></a> <h1 class="top">ASDF: Another System Definition Facility</h1> -<p>Manual for Version 3.1.6 +<p>Manual for Version 3.1.6.14 </p>

<p>This manual describes ASDF, a system definition facility @@ -851,21 +851,24 @@ or silently convert lowercase to uppercase (lpns). <a name="Convenience-Functions-1"></a> <h3 class="section">5.2 Convenience Functions</h3>

-<a name="index-load_002dsystem"></a> -<a name="index-compile_002dsystem"></a> -<a name="index-test_002dsystem"></a> -<a name="index-require_002dsystem"></a> -<a name="index-make"></a>

<p>ASDF provides three commands for the most common system operations: <code>load-system</code>, <code>compile-system</code>, and <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. -And it provides <code>make</code>, a function that uses whichever operation -was specified by the author of the target system, -which by default behaves like <code>load-system</code>. +</p> +<p>ASDF also provides <code>require-system</code>, a variant of <code>load-system</code> +that skips loading systems that are already loaded. This is sometimes +useful, for example, in order to avoid re-loading libraries that come +pre-loaded into your lisp implementation. +</p> +<p>ASDF also provides <code>make</code>, a way of allowing system developers to +choose a default operation for their systems. For example, a developer +who has created a system intended to format a specific document, might +make document-formatting the default operation invoked by <code>make</code>, +instead of loading. If the system developer doesn&rsquo;t specify in the +system definition, the default operation will be loading. </p>

+ <a name="index-operate"></a> <a name="index-oos"></a>

@@ -878,49 +881,89 @@ which stands for operate-on-system, a name inherited from <code>mk-defsystem</co You&rsquo;ll use <code>operate</code> whenever you want to do something beyond compiling, loading and testing. </p> -<p>Note that output from ASDF and ASDF extensions are sent -to the CL stream <code>*standard-output*</code>, -so rebinding that stream around calls to <code>asdf:operate</code> -should redirect all output from ASDF operations. -</p>

-<a name="index-load_002dsystem-1"></a> <a name="index-_002aload_002dsystem_002doperation_002a"></a> <a name="index-already_002dloaded_002dsystems"></a> -<a name="index-require_002dsystem-1"></a> -<p><code>load-system</code> applies <code>operate</code> with the operation from + +<dl> +<dt><a name="index-load_002dsystem"></a>Function: <strong>load-system</strong> <em>system &amp;rest keys &amp;key force force-not verbose version &amp;allow-other-keys</em></dt> +<dd><p>Apply <code>operate</code> with the operation from <code>*load-system-operation*</code> -the system, and any provided keyword arguments. +the <var>system</var>, and any provided keyword arguments. <code>*load-system-operation*</code> by default is <code>load-op</code>; -it would be <code>load-bundle-op</code> by default on ECL, if only an implementation bug were fixed. -</p> -<p><code>require-system</code> skips any update to systems that have already been loaded, +it would be <code>load-bundle-op</code> by default on ECL, +if only an implementation bug were fixed. +Calling <code>load-system</code> is the regular, recommended way +to load a system into the current image. +</p></dd></dl> + +<dl> +<dt><a name="index-compile_002dsystem"></a>Function: <strong>compile-system</strong> <em>system &amp;rest keys &amp;key force force-not verbose version &amp;allow-other-keys</em></dt> +<dd><p>Apply <code>operate</code> with the operation <code>compile-op</code>, +the <var>system</var>, and any provided keyword arguments. +This will make sure all the files in the system are compiled, +but not necessarily load any of them in the current image; +on most systems, it will <em>not</em> load all compiled files in the current image. +This function exists for symmetry with <code>load-system</code> but is not recommended +unless you are writing build scripts and know what you&rsquo;re doing. +But then, you might be interested in <code>program-op</code> rather than <code>compile-op</code>. +</p></dd></dl> + +<dl> +<dt><a name="index-test_002dsystem"></a>Function: <strong>test-system</strong> <em>system &amp;rest keys &amp;key force force-not verbose version &amp;allow-other-keys</em></dt> +<dd><p>Apply <code>operate</code> with the operation <code>test-op</code>, +the <var>system</var>, and any provided keyword arguments. +See <a href="#test_002dop">test-op</a>. +</p></dd></dl> + +<dl> +<dt><a name="index-make"></a>Function: <strong>make</strong> <em>system &amp;rest keys &amp;key &amp;allow-other-keys</em></dt> +<dd><p>Do &ldquo;The Right Thing&rdquo; with your system. +Starting with ASDF 3.1, this function <code>make</code> is also available. +The default behaviour is to load the system as if by <code>load-system</code>; +but system authors can override this default in their system definition +they may specify an alternate operation as the intended use of their system, +with a <code>:build-operation</code> option in the <code>defsystem</code> form +(see <a href="#The-defsystem-grammar">build-operation</a>), +and an intended output pathname for that operation with +<code>:build-pathname</code>. +This function is experimental and largely untested. Use at your own risk. +</p></dd></dl> +<a name="index-build_002doperation"></a> + +<dl> +<dt><a name="index-require_002dsystem"></a>Function: <strong>require-system</strong> <em>system &amp;rest keys &amp;key &amp;allow-other-keys</em></dt> +<dd><p><code>require-system</code> skips any update to systems that have already been loaded, in the spirit of <code>cl:require</code>. -It does it by calling <code>load-system</code> with a keyword option excluding already loaded systems.<a name="DOCF8" href="#FOOT8">⁸</a>. +It does it by calling <code>load-system</code> with a keyword option +excluding already loaded systems.<a name="DOCF8" href="#FOOT8">⁸</a>. On actively maintained free software implementations (namely recent versions of ABCL, Clozure CL, CMUCL, ECL, GNU CLISP, MKCL and SBCL), once ASDF itself is loaded, <code>cl:require</code> too can load ASDF systems, by falling back on <code>require-system</code> for module names not recognized by the implementation. +(Note however that <code>require-system</code> does <em>not</em> fall back on <code>cl:require</code>; +that would introduce an &ldquo;interesting&rdquo; potential infinite loop to break somehow.) </p> -<p>Note that <code>cl:require</code> and <code>require-system</code> are appropriate to load code +<p><code>cl:require</code> and <code>require-system</code> are appropriate to load code that is not being modified during the current programming session. -This notably includes the implementation-provided extension modules that <code>cl:require</code> can load. -This also includes any number of ASDF systems that the user isn&rsquo;t either developing or debugging, -for which a previously installed version is deemed to be satisfactory. -<code>require-system</code> and through it <code>cl:require</code> can load these systems without any problem. +<code>cl:require</code> will notably load the implementation-provided extension modules; +<code>require-system</code> won&rsquo;t, unless they are also defined as systems somehow, +which SBCL and MKCL do. +<code>require-system</code> may also be used to load any number of ASDF systems +that the user isn&rsquo;t either developing or debugging, +for which a previously installed version is deemed to be satisfactory; +<code>cl:require</code> on the above-mentioned implementations will delegate to <code>require-system</code> +and may load them as well. But for code that you are actively developing, debugging, or otherwise modifying, you should use <code>load-system</code>, so ASDF will pick on your modifications -and transitively re-build the modified files and everything that depends on them. -</p> -<p>Finally, starting with ASDF 3.1, a function <code>make</code> is also available, -that does &ldquo;The Right Thing&rdquo; with your system. -The default behaviour is to load the system as if by <code>load-system</code>; -but instead of this default, system authors can specify -the intended use of their system by specifying their desired operation -with a <code>:build-operation</code> argument in the system definition. -</p> +and transitively re-build the modified files and everything that depends on them +(that the requested <var>system</var> itself depends on &mdash; +ASDF itself never builds anything unless +it&rsquo;s an explicitly requested system or the dependencies thereof). +</p></dd></dl> +

<hr> <a name="Moving-on"></a> @@ -1203,6 +1246,7 @@ Presumably, the 4th form looks like <code>(defparameter *foo-version* &quot;5.6. system-option := :defsystem-depends-on system-list | :weakly-depends-on <var>system-list</var> | :class class-name (see discussion below) + | :build-operation <var>operation-name</var> | system-option | module-option | option @@ -1263,7 +1307,7 @@ simple-component-name := string pathname-specifier := pathname | string | symbol

method-form := (operation-name qual lambda-list &amp;rest body) -qual := method qualifier +qual := method qualifier?

component-dep-fail-option := :fail | :try-next | :ignore

@@ -1324,8 +1368,21 @@ 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. </p> +<a name="Build_002doperation"></a> +<h4 class="subsection">6.3.5 Build-operation</h4> +<a name="index-_003abuild_002doperation"></a> + +<p>The <code>:build-operation</code> option to <code>defsystem</code> allows the +programmer to specify an operation that will be applied, in place of +<code>load-op</code> when <code>make</code> (see <a href="#Convenience-Functions">make</a>) +is run on the system. The option +value should be the name of an operation. E.g., <code>:build-operation doc-op</code> +</p> +<p>This feature is +experimental and largely untested. Use at your own risk. +</p> <a name="Weakly-depends-on"></a> -<h4 class="subsection">6.3.5 Weakly depends on</h4> +<h4 class="subsection">6.3.6 Weakly depends on</h4> <a name="index-_003aweakly_002ddepends_002don"></a>

<p>We do <em>NOT</em> recommend you use this feature. @@ -1355,7 +1412,7 @@ this anomalous behaviour may be removed without warning.

<a name="Pathname-specifiers"></a> -<h4 class="subsection">6.3.6 Pathname specifiers</h4> +<h4 class="subsection">6.3.7 Pathname specifiers</h4> <a name="index-pathname-specifiers"></a>

<p>A pathname specifier (<code>pathname-specifier</code>) @@ -1435,7 +1492,7 @@ on the other hand, you can circumvent the file type that would otherwise be forced upon you if you were specifying a string. </p> <a name="Version-specifiers"></a> -<h4 class="subsection">6.3.7 Version specifiers</h4> +<h4 class="subsection">6.3.8 Version specifiers</h4> <a name="index-version-specifiers"></a> <a name="index-_003aversion-1"></a>

@@ -1470,7 +1527,7 @@ where significant API incompatibilities are signaled by an increased major numbe <p>See <a href="#Common-attributes-of-components">Common attributes of components</a>. </p> <a name="Require"></a> -<h4 class="subsection">6.3.8 Require</h4> +<h4 class="subsection">6.3.9 Require</h4> <a name="index-_003arequire-dependencies"></a>

<p>Use the implementation&rsquo;s own <code>require</code> to load the <var>module-name</var>. @@ -1482,7 +1539,7 @@ See <a href="#if_002dfeature_002doption">if-feature-option</a>. </p>

<a name="Using-logical-pathnames"></a> -<h4 class="subsection">6.3.9 Using logical pathnames</h4> +<h4 class="subsection">6.3.10 Using logical pathnames</h4> <a name="index-logical-pathnames"></a>

<p>We do not generally recommend the use of logical pathnames, @@ -1538,7 +1595,7 @@ underscores, dots or CamelCase in pathnames. </p>

<a name="Serial-dependencies"></a> -<h4 class="subsection">6.3.10 Serial dependencies</h4> +<h4 class="subsection">6.3.11 Serial dependencies</h4> <a name="index-serial-dependencies"></a>

<p>If the <code>:serial t</code> option is specified for a module, @@ -1561,7 +1618,7 @@ This is done as if by <code>:depends-on</code>.

<a name="Source-location-_0028_003apathname_0029"></a> -<h4 class="subsection">6.3.11 Source location (<code>:pathname</code>)</h4> +<h4 class="subsection">6.3.12 Source location (<code>:pathname</code>)</h4>

<p>The <code>:pathname</code> option is optional in all cases for systems defined via <code>defsystem</code>, and generally is unnecessary. In the @@ -1607,7 +1664,7 @@ from within an editor without clobbering its source location) </li></ul>

<a name="if_002dfeature-option"></a> -<h4 class="subsection">6.3.12 if-feature option</h4> +<h4 class="subsection">6.3.13 if-feature option</h4> <a name="index-_003aif_002dfeature-component-option"></a> <a name="if_002dfeature_002doption"></a> <p>This option allows you to specify a feature expression to be evaluated @@ -1633,7 +1690,7 @@ been performed. See <a href="#required_002dfeatures">Required features</a>. </p> <a name="if_002dcomponent_002ddep_002dfails-option"></a> -<h4 class="subsection">6.3.13 if-component-dep-fails option</h4> +<h4 class="subsection">6.3.14 if-component-dep-fails option</h4> <a name="index-_003aif_002dcomponent_002ddep_002dfails-component-option"></a> <p>This option was removed in ASDF 3. Its semantics was limited in purpose and dubious to explain, @@ -1641,7 +1698,7 @@ and its implementation was breaking a hole into the ASDF object model. Please use the <code>if-feature</code> option instead. </p> <a name="feature-requirement"></a> -<h4 class="subsection">6.3.14 feature requirement</h4> +<h4 class="subsection">6.3.15 feature requirement</h4> <p>This requirement was removed in ASDF 3.1. Please do not use it. In most cases, <code>:if-feature</code> (see <a href="#if_002dfeature_002doption">if-feature-option</a>) will provide an adequate substitute. @@ -1787,6 +1844,7 @@ whereas earlier versions ignore this option and use the <code>system-source-dire where the <samp>.asd</samp> file resides. </p>

+ <hr> <a name="The-object-model-of-ASDF"></a> <a name="The-Object-model-of-ASDF"></a> @@ -1799,7 +1857,7 @@ Both a system&rsquo;s structure and the operations that can be performed on syst follow a extensible protocol, allowing programmers to add new behaviours to ASDF. For example, <code>cffi</code> adds support for special FFI description files that interface with C libraries and for wrapper files that embed C code in Lisp. -<code>abcl-jar</code> supports creating Java JAR archives in ABCL. +<code>asdf-jar</code> supports creating Java JAR archives in ABCL. <code>poiu</code> supports compiling code in parallel using background processes. </p> <p>The key classes in ASDF are <code>component</code> and <code>operation</code>. @@ -1971,7 +2029,7 @@ may be performed on a given component. </p></dd></dl>

<dl> -<dt><a name="index-load_002dsource_002dop"></a>Operation: <strong><code>load-source-op</code></strong> <em>, <code>prepare-source-op</code></em></dt> +<dt><a name="index-load_002dsource_002dop_002c"></a>Operation: <strong><code>load-source-op</code>,</strong> <em><code>prepare-source-op</code></em></dt> <dd> <p><code>load-source-op</code> will load the source for the files in a module rather than the compiled fasl output. @@ -1987,7 +2045,7 @@ that ensures the dependencies are themselves loaded via <code>load-source-op</co The default method will do nothing. The default dependency is to require <code>load-op</code> to be performed on the module first. -Its <code>operation-done-p</code> method returns <code>nil</code>, +Its default <code>operation-done-p</code> method returns <code>nil</code>, which means that the operation is <em>never</em> done &ndash; we assume that if you invoke the <code>test-op</code>, @@ -2034,7 +2092,7 @@ on a library. For example, one might have

<dl> -<dt><a name="index-compile_002dbundle_002dop"></a>Operation: <strong><code>compile-bundle-op</code></strong> <em>, <code>monolithic-compile-bundle-op</code>, <code>load-bundle-op</code>, <code>monolithic-load-bundle-op</code>, <code>deliver-asd-op</code>, <code>monolithic-deliver-asd-op</code>, <code>lib-op</code>, <code>monolithic-lib-op</code>, <code>dll-op</code>, <code>monolithic-dll-op</code>, <code>image-op</code>, <code>program-op</code></em></dt> +<dt><a name="index-compile_002dbundle_002dop_002c"></a>Operation: <strong><code>compile-bundle-op</code>,</strong> <em><code>monolithic-compile-bundle-op</code>, <code>load-bundle-op</code>, <code>monolithic-load-bundle-op</code>, <code>deliver-asd-op</code>, <code>monolithic-deliver-asd-op</code>, <code>lib-op</code>, <code>monolithic-lib-op</code>, <code>dll-op</code>, <code>monolithic-dll-op</code>, <code>image-op</code>, <code>program-op</code></em></dt> <dd> <p>These are &ldquo;bundle&rdquo; operations, that can create a single-file &ldquo;bundle&rdquo; for all the contents of each system in an application, @@ -2126,7 +2184,7 @@ Maybe you have suggestions on how to better configure it? </p></dd></dl>

<dl> -<dt><a name="index-concatenate_002dsource_002dop"></a>Operation: <strong><code>concatenate-source-op</code></strong> <em>, <code>monolithic-concatenate-source-op</code>, <code>load-concatenated-source-op</code>, <code>compile-concatenated-source-op</code>, <code>load-compiled-concatenated-source-op</code>, <code>monolithic-load-concatenated-source-op</code>, <code>monolithic-compile-concatenated-source-op</code>, <code>monolithic-load-compiled-concatenated-source-op</code></em></dt> +<dt><a name="index-concatenate_002dsource_002dop_002c"></a>Operation: <strong><code>concatenate-source-op</code>,</strong> <em><code>monolithic-concatenate-source-op</code>, <code>load-concatenated-source-op</code>, <code>compile-concatenated-source-op</code>, <code>load-compiled-concatenated-source-op</code>, <code>monolithic-load-concatenated-source-op</code>, <code>monolithic-compile-concatenated-source-op</code>, <code>monolithic-load-compiled-concatenated-source-op</code></em></dt> <dd> <p>These operations, as their respective names indicate, will concatenate all the <code>cl-source-file</code> source files in a system @@ -5241,7 +5299,7 @@ and lose configuration as they do. <a name="index-monolithic_002dfasl_002dop-_0028obsolete_0029"></a> <a name="index-monolithic_002dload_002dfasl_002dop-_0028obsolete_0029"></a> <a name="index-monolithic_002dbinary_002dop-_0028obsolete_0029"></a> -<a name="index-compile_002dbundle_002dop-1"></a> +<a name="index-compile_002dbundle_002dop"></a> <a name="index-load_002dbundle_002dop"></a> <a name="index-deliver_002dasd_002dop"></a> <a name="index-monolithic_002dcompile_002dbundle_002dop"></a> @@ -5699,6 +5757,21 @@ to eschew using such an important library anymore. <p>Use from the <code>named-readtables</code> system the macro <code>named-readtables:defreadtable</code>. </p> <hr> +<a name="How-can-I-capture-ASDF_0027s-output_003f"></a> +<a name="How-can-I-capture-ASDF_0027s-output_003f-1"></a> +<h4 class="subsection">13.6.8 How can I capture ASDF&rsquo;s output?</h4> + +<a name="index-ASDF-output"></a> +<a name="index-Capturing-ASDF-output"></a> +<a name="index-_002astandard_002doutput_002a"></a> + +<p>Output from ASDF and ASDF extensions are sent to the CL stream +<code>*standard-output*</code>, so rebinding that stream around calls to +<code>asdf:operate</code> should redirect all output from ASDF operations. +</p> + + +<hr> <a name="ASDF-development-FAQs"></a> <a name="ASDF-development-FAQs-1"></a> <h3 class="section">13.7 ASDF development FAQs</h3> @@ -5878,6 +5951,7 @@ see the <samp>TODO</samp> file in the source repository. <tr><td></td><td valign="top"><a href="#index-_003aasdf">:asdf</a>:</td><td>&nbsp;</td><td valign="top"><a href="#Introduction">Introduction</a></td></tr> <tr><td></td><td valign="top"><a href="#index-_003aasdf2">:asdf2</a>:</td><td>&nbsp;</td><td valign="top"><a href="#Introduction">Introduction</a></td></tr> <tr><td></td><td valign="top"><a href="#index-_003aasdf3">:asdf3</a>:</td><td>&nbsp;</td><td valign="top"><a href="#Introduction">Introduction</a></td></tr> +<tr><td></td><td valign="top"><a href="#index-_003abuild_002doperation">:build-operation</a>:</td><td>&nbsp;</td><td valign="top"><a href="#The-defsystem-grammar">The defsystem grammar</a></td></tr> <tr><td></td><td valign="top"><a href="#index-_003acompile_002dcheck">:compile-check</a>:</td><td>&nbsp;</td><td valign="top"><a href="#Controlling-file-compilation">Controlling file compilation</a></td></tr> <tr><td></td><td valign="top"><a href="#index-_003adefault_002dregistry-source-config-directive">:default-registry source config directive</a>:</td><td>&nbsp;</td><td valign="top"><a href="#Configuration-DSL">Configuration DSL</a></td></tr> <tr><td></td><td valign="top"><a href="#index-_003adefsystem_002ddepends_002don">:defsystem-depends-on</a>:</td><td>&nbsp;</td><td valign="top"><a href="#The-defsystem-grammar">The defsystem grammar</a></td></tr> @@ -5898,6 +5972,7 @@ see the <samp>TODO</samp> file in the source repository. <tr><th><a name="Concept-Index_cp_letter-A">A</a></th><td></td><td></td></tr> <tr><td></td><td valign="top"><a href="#index-also_002dexclude-source-config-directive">also-exclude source config directive</a>:</td><td>&nbsp;</td><td valign="top"><a href="#Configuration-DSL">Configuration DSL</a></td></tr> <tr><td></td><td valign="top"><a href="#index-around_002dcompile-keyword">around-compile keyword</a>:</td><td>&nbsp;</td><td valign="top"><a href="#Controlling-file-compilation">Controlling file compilation</a></td></tr> +<tr><td></td><td valign="top"><a href="#index-ASDF-output">ASDF output</a>:</td><td>&nbsp;</td><td valign="top"><a href="#How-can-I-capture-ASDF_0027s-output_003f">How can I capture ASDF's output?</a></td></tr> <tr><td></td><td valign="top"><a href="#index-ASDF-versions">ASDF versions</a>:</td><td>&nbsp;</td><td valign="top"><a href="#Introduction">Introduction</a></td></tr> <tr><td></td><td valign="top"><a href="#index-ASDF_002dBINARY_002dLOCATIONS-compatibility">ASDF-BINARY-LOCATIONS compatibility</a>:</td><td>&nbsp;</td><td valign="top"><a href="#Output-Backward-Compatibility">Output Backward Compatibility</a></td></tr> <tr><td></td><td valign="top"><a href="#index-asdf_002doutput_002dtranslations">asdf-output-translations</a>:</td><td>&nbsp;</td><td valign="top"><a href="#Controlling-where-ASDF-saves-compiled-files">Controlling where ASDF saves compiled files</a></td></tr> @@ -5907,8 +5982,10 @@ see the <samp>TODO</samp> file in the source repository. <tr><td colspan="4"> <hr></td></tr> <tr><th><a name="Concept-Index_cp_letter-B">B</a></th><td></td><td></td></tr> <tr><td></td><td valign="top"><a href="#index-bug-tracker">bug tracker</a>:</td><td>&nbsp;</td><td valign="top"><a href="#Where-do-I-report-a-bug_003f">Where do I report a bug?</a></td></tr> +<tr><td></td><td valign="top"><a href="#index-build_002doperation">build-operation</a>:</td><td>&nbsp;</td><td valign="top"><a href="#Convenience-Functions">Convenience Functions</a></td></tr> <tr><td colspan="4"> <hr></td></tr> <tr><th><a name="Concept-Index_cp_letter-C">C</a></th><td></td><td></td></tr> +<tr><td></td><td valign="top"><a href="#index-Capturing-ASDF-output">Capturing ASDF output</a>:</td><td>&nbsp;</td><td valign="top"><a href="#How-can-I-capture-ASDF_0027s-output_003f">How can I capture ASDF's output?</a></td></tr> <tr><td></td><td valign="top"><a href="#index-compile_002dcheck-keyword">compile-check keyword</a>:</td><td>&nbsp;</td><td valign="top"><a href="#Controlling-file-compilation">Controlling file compilation</a></td></tr> <tr><td></td><td valign="top"><a href="#index-component">component</a>:</td><td>&nbsp;</td><td valign="top"><a href="#Components">Components</a></td></tr> <tr><td></td><td valign="top"><a href="#index-component-designator">component designator</a>:</td><td>&nbsp;</td><td valign="top"><a href="#Components">Components</a></td></tr> @@ -6050,15 +6127,15 @@ see the <samp>TODO</samp> file in the source repository. <tr><td></td><td valign="top"><a href="#index-coerce_002dname"><code>coerce-name</code></a>:</td><td>&nbsp;</td><td valign="top"><a href="#Creating-new-operations">Creating new operations</a></td></tr> <tr><td></td><td valign="top"><a href="#index-coerce_002dname-1"><code>coerce-name</code></a>:</td><td>&nbsp;</td><td valign="top"><a href="#Components">Components</a></td></tr> <tr><td></td><td valign="top"><a href="#index-coerce_002dname-2"><code>coerce-name</code></a>:</td><td>&nbsp;</td><td valign="top"><a href="#Common-attributes-of-components">Common attributes of components</a></td></tr> -<tr><td></td><td valign="top"><a href="#index-compile_002dbundle_002dop-1"><code>compile-bundle-op</code></a>:</td><td>&nbsp;</td><td valign="top"><a href="#What-happened-to-the-bundle-operations">What happened to the bundle operations</a></td></tr> -<tr><td></td><td valign="top"><a href="#index-compile_002dbundle_002dop"><code><code>compile-bundle-op</code></code></a>:</td><td>&nbsp;</td><td valign="top"><a href="#Predefined-operations-of-ASDF">Predefined operations of ASDF</a></td></tr> +<tr><td></td><td valign="top"><a href="#index-compile_002dbundle_002dop"><code>compile-bundle-op</code></a>:</td><td>&nbsp;</td><td valign="top"><a href="#What-happened-to-the-bundle-operations">What happened to the bundle operations</a></td></tr> +<tr><td></td><td valign="top"><a href="#index-compile_002dbundle_002dop_002c"><code><code>compile-bundle-op</code>,</code></a>:</td><td>&nbsp;</td><td valign="top"><a href="#Predefined-operations-of-ASDF">Predefined operations of ASDF</a></td></tr> <tr><td></td><td valign="top"><a href="#index-compile_002dfile_002a"><code>compile-file*</code></a>:</td><td>&nbsp;</td><td valign="top"><a href="#Controlling-file-compilation">Controlling file compilation</a></td></tr> <tr><td></td><td valign="top"><a href="#index-compile_002dop"><code><code>compile-op</code></code></a>:</td><td>&nbsp;</td><td valign="top"><a href="#Predefined-operations-of-ASDF">Predefined operations of ASDF</a></td></tr> <tr><td></td><td valign="top"><a href="#index-compile_002dsystem"><code>compile-system</code></a>:</td><td>&nbsp;</td><td valign="top"><a href="#Convenience-Functions">Convenience Functions</a></td></tr> <tr><td></td><td valign="top"><a href="#index-component-1"><code>component</code></a>:</td><td>&nbsp;</td><td valign="top"><a href="#The-object-model-of-ASDF">The object model of ASDF</a></td></tr> <tr><td></td><td valign="top"><a href="#index-component_002ddepends_002don"><code>component-depends-on</code></a>:</td><td>&nbsp;</td><td valign="top"><a href="#Creating-new-operations">Creating new operations</a></td></tr> <tr><td></td><td valign="top"><a href="#index-component_002dpathname"><code>component-pathname</code></a>:</td><td>&nbsp;</td><td valign="top"><a href="#Common-attributes-of-components">Common attributes of components</a></td></tr> -<tr><td></td><td valign="top"><a href="#index-concatenate_002dsource_002dop"><code><code>concatenate-source-op</code></code></a>:</td><td>&nbsp;</td><td valign="top"><a href="#Predefined-operations-of-ASDF">Predefined operations of ASDF</a></td></tr> +<tr><td></td><td valign="top"><a href="#index-concatenate_002dsource_002dop_002c"><code><code>concatenate-source-op</code>,</code></a>:</td><td>&nbsp;</td><td valign="top"><a href="#Predefined-operations-of-ASDF">Predefined operations of ASDF</a></td></tr> <tr><td colspan="4"> <hr></td></tr> <tr><th><a name="Function-and-Class-Index_fn_letter-D">D</a></th><td></td><td></td></tr> <tr><td></td><td valign="top"><a href="#index-defsystem"><code>defsystem</code></a>:</td><td>&nbsp;</td><td valign="top"><a href="#The-defsystem-form">The defsystem form</a></td></tr> @@ -6090,9 +6167,8 @@ see the <samp>TODO</samp> file in the source repository. <tr><td></td><td valign="top"><a href="#index-load_002dbundle_002dop"><code>load-bundle-op</code></a>:</td><td>&nbsp;</td><td valign="top"><a href="#What-happened-to-the-bundle-operations">What happened to the bundle operations</a></td></tr> <tr><td></td><td valign="top"><a href="#index-load_002dfasl_002dop-_0028obsolete_0029"><code>load-fasl-op (obsolete)</code></a>:</td><td>&nbsp;</td><td valign="top"><a href="#What-happened-to-the-bundle-operations">What happened to the bundle operations</a></td></tr> <tr><td></td><td valign="top"><a href="#index-load_002dop"><code><code>load-op</code></code></a>:</td><td>&nbsp;</td><td valign="top"><a href="#Predefined-operations-of-ASDF">Predefined operations of ASDF</a></td></tr> -<tr><td></td><td valign="top"><a href="#index-load_002dsource_002dop"><code><code>load-source-op</code></code></a>:</td><td>&nbsp;</td><td valign="top"><a href="#Predefined-operations-of-ASDF">Predefined operations of ASDF</a></td></tr> +<tr><td></td><td valign="top"><a href="#index-load_002dsource_002dop_002c"><code><code>load-source-op</code>,</code></a>:</td><td>&nbsp;</td><td valign="top"><a href="#Predefined-operations-of-ASDF">Predefined operations of ASDF</a></td></tr> <tr><td></td><td valign="top"><a href="#index-load_002dsystem"><code>load-system</code></a>:</td><td>&nbsp;</td><td valign="top"><a href="#Convenience-Functions">Convenience Functions</a></td></tr> -<tr><td></td><td valign="top"><a href="#index-load_002dsystem-1"><code>load-system</code></a>:</td><td>&nbsp;</td><td valign="top"><a href="#Convenience-Functions">Convenience Functions</a></td></tr> <tr><td></td><td valign="top"><a href="#index-locate_002dsystem"><code>locate-system</code></a>:</td><td>&nbsp;</td><td valign="top"><a href="#Components">Components</a></td></tr> <tr><td colspan="4"> <hr></td></tr> <tr><th><a name="Function-and-Class-Index_fn_letter-M">M</a></th><td></td><td></td></tr> @@ -6128,7 +6204,6 @@ see the <samp>TODO</samp> file in the source repository. <tr><td></td><td valign="top"><a href="#index-register_002dimmutable_002dsystem-1"><code>register-immutable-system</code></a>:</td><td>&nbsp;</td><td valign="top"><a href="#Miscellaneous-Functions">Miscellaneous Functions</a></td></tr> <tr><td></td><td valign="top"><a href="#index-register_002dpreloaded_002dsystem"><code>register-preloaded-system</code></a>:</td><td>&nbsp;</td><td valign="top"><a href="#Miscellaneous-Functions">Miscellaneous Functions</a></td></tr> <tr><td></td><td valign="top"><a href="#index-require_002dsystem"><code>require-system</code></a>:</td><td>&nbsp;</td><td valign="top"><a href="#Convenience-Functions">Convenience Functions</a></td></tr> -<tr><td></td><td valign="top"><a href="#index-require_002dsystem-1"><code>require-system</code></a>:</td><td>&nbsp;</td><td valign="top"><a href="#Convenience-Functions">Convenience Functions</a></td></tr> <tr><td></td><td valign="top"><a href="#index-run_002dprogram"><code>run-program</code></a>:</td><td>&nbsp;</td><td valign="top"><a href="#Some-Utility-Functions">Some Utility Functions</a></td></tr> <tr><td></td><td valign="top"><a href="#index-run_002dshell_002dcommand"><code>run-shell-command</code></a>:</td><td>&nbsp;</td><td valign="top"><a href="#Miscellaneous-Functions">Miscellaneous Functions</a></td></tr> <tr><td colspan="4"> <hr></td></tr> @@ -6212,6 +6287,7 @@ see the <samp>TODO</samp> file in the source repository. <tr><td></td><td valign="top"><a href="#index-_002anil_002dpathname_002a"><code>*nil-pathname*</code></a>:</td><td>&nbsp;</td><td valign="top"><a href="#Some-Utility-Functions">Some Utility Functions</a></td></tr> <tr><td></td><td valign="top"><a href="#index-_002aoldest_002dforward_002dcompatible_002dasdf_002dversion_002a"><code>*oldest-forward-compatible-asdf-version*</code></a>:</td><td>&nbsp;</td><td valign="top"><a href="#Pitfalls-of-the-upgrade-to-ASDF-3">Pitfalls of the upgrade to ASDF 3</a></td></tr> <tr><td></td><td valign="top"><a href="#index-_002asource_002dregistry_002dparameter_002a"><code>*source-registry-parameter*</code></a>:</td><td>&nbsp;</td><td valign="top"><a href="#g_t_002asource_002dregistry_002dparameter_002a-variable">*source-registry-parameter* variable</a></td></tr> +<tr><td></td><td valign="top"><a href="#index-_002astandard_002doutput_002a"><code>*standard-output*</code></a>:</td><td>&nbsp;</td><td valign="top"><a href="#How-can-I-capture-ASDF_0027s-output_003f">How can I capture ASDF's output?</a></td></tr> <tr><td></td><td valign="top"><a href="#index-_002asystem_002ddefinition_002dsearch_002dfunctions_002a"><code>*system-definition-search-functions*</code></a>:</td><td>&nbsp;</td><td valign="top"><a href="#Components">Components</a></td></tr> <tr><td colspan="4"> <hr></td></tr> <tr><th><a name="Variable-Index_vr_letter-A">A</a></th><td></td><td></td></tr>

===================================== src/contrib/asdf/doc/asdf.info ===================================== --- a/src/contrib/asdf/doc/asdf.info +++ b/src/contrib/asdf/doc/asdf.info @@ -1,4 +1,4 @@ -This is asdf.info, produced by makeinfo version 5.2 from asdf.texinfo. +This is asdf.info, produced by makeinfo version 6.1 from asdf.texinfo.

This manual describes ASDF, a system definition facility for Common Lisp programs and libraries. @@ -43,7 +43,7 @@ File: asdf.info, Node: Top, Next: Introduction, Prev: (dir), Up: (dir) ASDF: Another System Definition Facility ****************************************

-Manual for Version 3.1.6 +Manual for Version 3.1.6.14

This manual describes ASDF, a system definition facility for Common Lisp programs and libraries. @@ -243,6 +243,7 @@ Issues with using and extending ASDF to define systems * How do I create a system definition where all the source files have a .cl extension?:: * How do I mark a source file to be loaded only and not compiled?:: * How do I work with readtables?:: +* How can I capture ASDF's output?::

ASDF development FAQs

@@ -780,11 +781,19 @@ File: asdf.info, Node: Convenience Functions, Next: Moving on, Prev: Loading =========================

ASDF provides three commands for the most common system operations: -'load-system', 'compile-system', and 'test-system'. It also provides -'require-system', a version of 'load-system' that skips trying to update -systems that are already loaded. And it provides 'make', a function -that uses whichever operation was specified by the author of the target -system, which by default behaves like 'load-system'. +'load-system', 'compile-system', and 'test-system'. + + ASDF also provides 'require-system', a variant of 'load-system' that +skips loading systems that are already loaded. This is sometimes +useful, for example, in order to avoid re-loading libraries that come +pre-loaded into your lisp implementation. + + ASDF also provides 'make', a way of allowing system developers to +choose a default operation for their systems. For example, a developer +who has created a system intended to format a specific document, might +make document-formatting the default operation invoked by 'make', +instead of loading. If the system developer doesn't specify in the +system definition, the default operation will be loading.

Because ASDF is an extensible system for defining _operations_ on _components_, it also provides a generic function 'operate', so you may @@ -794,43 +803,71 @@ stands for operate-on-system, a name inherited from 'mk-defsystem'.) You'll use 'operate' whenever you want to do something beyond compiling, loading and testing.

- Note that output from ASDF and ASDF extensions are sent to the CL -stream '*standard-output*', so rebinding that stream around calls to -'asdf:operate' should redirect all output from ASDF operations. - - 'load-system' applies 'operate' with the operation from -'*load-system-operation*' the system, and any provided keyword -arguments. '*load-system-operation*' by default is 'load-op'; it would -be 'load-bundle-op' by default on ECL, if only an implementation bug -were fixed. - - 'require-system' skips any update to systems that have already been -loaded, in the spirit of 'cl:require'. It does it by calling -'load-system' with a keyword option excluding already loaded -systems.(1). On actively maintained free software implementations -(namely recent versions of ABCL, Clozure CL, CMUCL, ECL, GNU CLISP, MKCL -and SBCL), once ASDF itself is loaded, 'cl:require' too can load ASDF -systems, by falling back on 'require-system' for module names not -recognized by the implementation. - - Note that 'cl:require' and 'require-system' are appropriate to load -code that is not being modified during the current programming session. -This notably includes the implementation-provided extension modules that -'cl:require' can load. This also includes any number of ASDF systems -that the user isn't either developing or debugging, for which a -previously installed version is deemed to be satisfactory. -'require-system' and through it 'cl:require' can load these systems -without any problem. But for code that you are actively developing, -debugging, or otherwise modifying, you should use 'load-system', so ASDF -will pick on your modifications and transitively re-build the modified -files and everything that depends on them. - - Finally, starting with ASDF 3.1, a function 'make' is also available, -that does "The Right Thing" with your system. The default behaviour is -to load the system as if by 'load-system'; but instead of this default, -system authors can specify the intended use of their system by -specifying their desired operation with a ':build-operation' argument in -the system definition. + -- Function: load-system system &rest keys &key force force-not verbose + version &allow-other-keys + Apply 'operate' with the operation from '*load-system-operation*' + the SYSTEM, and any provided keyword arguments. + '*load-system-operation*' by default is 'load-op'; it would be + 'load-bundle-op' by default on ECL, if only an implementation bug + were fixed. Calling 'load-system' is the regular, recommended way + to load a system into the current image. + + -- Function: compile-system system &rest keys &key force force-not + verbose version &allow-other-keys + Apply 'operate' with the operation 'compile-op', the SYSTEM, and + any provided keyword arguments. This will make sure all the files + in the system are compiled, but not necessarily load any of them in + the current image; on most systems, it will _not_ load all compiled + files in the current image. This function exists for symmetry with + 'load-system' but is not recommended unless you are writing build + scripts and know what you're doing. But then, you might be + interested in 'program-op' rather than 'compile-op'. + + -- Function: test-system system &rest keys &key force force-not verbose + version &allow-other-keys + Apply 'operate' with the operation 'test-op', the SYSTEM, and any + provided keyword arguments. *Note test-op::. + + -- Function: make system &rest keys &key &allow-other-keys + Do "The Right Thing" with your system. Starting with ASDF 3.1, + this function 'make' is also available. The default behaviour is + to load the system as if by 'load-system'; but system authors can + override this default in their system definition they may specify + an alternate operation as the intended use of their system, with a + ':build-operation' option in the 'defsystem' form (*note + build-operation: The defsystem grammar.), and an intended output + pathname for that operation with ':build-pathname'. This function + is experimental and largely untested. Use at your own risk. + + -- Function: require-system system &rest keys &key &allow-other-keys + 'require-system' skips any update to systems that have already been + loaded, in the spirit of 'cl:require'. It does it by calling + 'load-system' with a keyword option excluding already loaded + systems.(1). On actively maintained free software implementations + (namely recent versions of ABCL, Clozure CL, CMUCL, ECL, GNU CLISP, + MKCL and SBCL), once ASDF itself is loaded, 'cl:require' too can + load ASDF systems, by falling back on 'require-system' for module + names not recognized by the implementation. (Note however that + 'require-system' does _not_ fall back on 'cl:require'; that would + introduce an "interesting" potential infinite loop to break + somehow.) + + 'cl:require' and 'require-system' are appropriate to load code that + is not being modified during the current programming session. + 'cl:require' will notably load the implementation-provided + extension modules; 'require-system' won't, unless they are also + defined as systems somehow, which SBCL and MKCL do. + 'require-system' may also be used to load any number of ASDF + systems that the user isn't either developing or debugging, for + which a previously installed version is deemed to be satisfactory; + 'cl:require' on the above-mentioned implementations will delegate + to 'require-system' and may load them as well. But for code that + you are actively developing, debugging, or otherwise modifying, you + should use 'load-system', so ASDF will pick on your modifications + and transitively re-build the modified files and everything that + depends on them (that the requested SYSTEM itself depends on -- + ASDF itself never builds anything unless it's an explicitly + requested system or the dependencies thereof).

---------- Footnotes ----------

@@ -1113,6 +1150,7 @@ File: asdf.info, Node: The defsystem grammar, Next: Other code in .asd files, system-option := :defsystem-depends-on system-list | :weakly-depends-on SYSTEM-LIST | :class class-name (see discussion below) + | :build-operation OPERATION-NAME | system-option | module-option | option @@ -1173,7 +1211,7 @@ File: asdf.info, Node: The defsystem grammar, Next: Other code in .asd files, pathname-specifier := pathname | string | symbol

method-form := (operation-name qual lambda-list &rest body) - qual := method qualifier + qual := method qualifier?

component-dep-fail-option := :fail | :try-next | :ignore

@@ -1227,7 +1265,19 @@ 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.

-6.3.5 Weakly depends on +6.3.5 Build-operation +--------------------- + +The ':build-operation' option to 'defsystem' allows the programmer to +specify an operation that will be applied, in place of 'load-op' when +'make' (*note make: Convenience Functions.) is run on the system. The +option value should be the name of an operation. E.g., +':build-operation doc-op' + + This feature is experimental and largely untested. Use at your own +risk. + +6.3.6 Weakly depends on -----------------------

We do _NOT_ recommend you use this feature. If you are tempted to write @@ -1249,7 +1299,7 @@ only makes sense at the 'defsystem' level. Programmers are cautioned not to use this component option except at the 'defsystem' level, as this anomalous behaviour may be removed without warning.

-6.3.6 Pathname specifiers +6.3.7 Pathname specifiers -------------------------

A pathname specifier ('pathname-specifier') may be a pathname, a string @@ -1316,7 +1366,7 @@ 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.

-6.3.7 Version specifiers +6.3.8 Version specifiers ------------------------

Version specifiers are strings to be parsed as period-separated lists of @@ -1347,7 +1397,7 @@ number.

*Note Common attributes of components::.

-6.3.8 Require +6.3.9 Require -------------

Use the implementation's own 'require' to load the MODULE-NAME. @@ -1357,8 +1407,8 @@ than '#+_implementation-name_' to only depend on the specified module on the specific implementation that provides it. *Note if-feature-option::.

-6.3.9 Using logical pathnames ------------------------------ +6.3.10 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 @@ -1403,7 +1453,7 @@ are shared with software written in different programming languages where conventions include the use of underscores, dots or CamelCase in pathnames.

-6.3.10 Serial dependencies +6.3.11 Serial dependencies --------------------------

If the ':serial t' option is specified for a module, ASDF will add @@ -1419,7 +1469,7 @@ preceding it. This is done as if by ':depends-on'. (:file "b" :depends-on ("a")) (:file "c" :depends-on ("a" "b")))

-6.3.11 Source location (':pathname') +6.3.12 Source location (':pathname') ------------------------------------

The ':pathname' option is optional in all cases for systems defined via @@ -1458,7 +1508,7 @@ pathname will be set to: that a developer can evaluate a 'defsystem' form from within an editor without clobbering its source location)

-6.3.12 if-feature option +6.3.13 if-feature option ------------------------

This option allows you to specify a feature expression to be evaluated @@ -1481,14 +1531,14 @@ before any build operations have been performed. This option was added in ASDF 3. For more information, *Note Required features: required-features.

-6.3.13 if-component-dep-fails option +6.3.14 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.

-6.3.14 feature requirement +6.3.15 feature requirement --------------------------

This requirement was removed in ASDF 3.1. Please do not use it. In @@ -1630,7 +1680,7 @@ system's structure and the operations that can be performed on systems follow a extensible protocol, allowing programmers to add new behaviours to ASDF. For example, 'cffi' adds support for special FFI description files that interface with C libraries and for wrapper files that embed C -code in Lisp. 'abcl-jar' supports creating Java JAR archives in ABCL. +code in Lisp. 'asdf-jar' supports creating Java JAR archives in ABCL. 'poiu' supports compiling code in parallel using background processes.

The key classes in ASDF are 'component' and 'operation'. A @@ -1802,7 +1852,7 @@ They are invoked via the 'operate' generic function. before 'compile-op' and 'load-op' operations may be performed on a given component.

- -- Operation: 'load-source-op' , 'prepare-source-op' + -- Operation: 'load-source-op', 'prepare-source-op'

'load-source-op' will load the source for the files in a module rather than the compiled fasl output. It has a 'prepare-source-op' @@ -1813,7 +1863,7 @@ They are invoked via the 'operate' generic function.

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. Its + 'load-op' to be performed on the module first. Its default 'operation-done-p' method returns 'nil', which means 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 @@ -1850,7 +1900,7 @@ They are invoked via the 'operate' generic function. :foo-tests))) ...)

- -- Operation: 'compile-bundle-op' , 'monolithic-compile-bundle-op', + -- Operation: 'compile-bundle-op', 'monolithic-compile-bundle-op', 'load-bundle-op', 'monolithic-load-bundle-op', 'deliver-asd-op', 'monolithic-deliver-asd-op', 'lib-op', 'monolithic-lib-op', 'dll-op', 'monolithic-dll-op', @@ -1935,7 +1985,7 @@ They are invoked via the 'operate' generic function. very satisfactory and may change in the future. Maybe you have suggestions on how to better configure it?

- -- Operation: 'concatenate-source-op' , + -- Operation: 'concatenate-source-op', 'monolithic-concatenate-source-op', 'load-concatenated-source-op', 'compile-concatenated-source-op', @@ -4993,6 +5043,7 @@ File: asdf.info, Node: Issues with using and extending ASDF to define systems, * How do I create a system definition where all the source files have a .cl extension?:: * How do I mark a source file to be loaded only and not compiled?:: * How do I work with readtables?:: +* How can I capture ASDF's output?::

File: asdf.info, Node: How can I cater for unit-testing in my system?, Next: How can I cater for documentation generation in my system?, Prev: Issues with using and extending ASDF to define systems, Up: Issues with using and extending ASDF to define systems @@ -5001,7 +5052,7 @@ File: asdf.info, Node: How can I cater for unit-testing in my system?, Next: H -------------------------------------------------------

ASDF provides a predefined test operation, 'test-op'. *Note test-op: -Predefined operations of ASDF. The test operation, however, is largely +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) (*note @@ -5152,7 +5203,7 @@ or with various bundle operations. In addition, the dependency model of ASDF would have to be modified incompatibly to allow for such a trick.

-File: asdf.info, Node: How do I work with readtables?, Prev: How do I mark a source file to be loaded only and not compiled?, Up: Issues with using and extending ASDF to define systems +File: asdf.info, Node: How do I work with readtables?, Next: How can I capture ASDF's output?, Prev: How do I mark a source file to be loaded only and not compiled?, Up: Issues with using and extending ASDF to define systems

13.6.7 How do I work with readtables? ------------------------------------- @@ -5226,6 +5277,16 @@ Use from the 'named-readtables' system the macro 'named-readtables:defreadtable'.

+File: asdf.info, Node: How can I capture ASDF's output?, Prev: How do I work with readtables?, Up: Issues with using and extending ASDF to define systems + +13.6.8 How can I capture ASDF's output? +--------------------------------------- + +Output from ASDF and ASDF extensions are sent to the CL stream +'*standard-output*', so rebinding that stream around calls to +'asdf:operate' should redirect all output from ASDF operations. + + File: asdf.info, Node: ASDF development FAQs, Prev: Issues with using and extending ASDF to define systems, Up: FAQ

13.7 ASDF development FAQs @@ -5364,36 +5425,40 @@ Concept Index * :asdf: Introduction. (line 6) * :asdf2: Introduction. (line 6) * :asdf3: Introduction. (line 6) +* :build-operation: The defsystem grammar. + (line 129) * :compile-check: Controlling file compilation. (line 6) * :default-registry source config directive: Configuration DSL. (line 6) * :defsystem-depends-on: The defsystem grammar. - (line 120) + (line 121) * :directory source config directive: Configuration DSL. (line 6) * :exclude source config directive: Configuration DSL. (line 6) * :if-component-dep-fails component option: The defsystem grammar. - (line 382) + (line 395) * :if-feature component option: The defsystem grammar. - (line 359) + (line 372) * :ignore-invalid-entries source config directive: Configuration DSL. (line 6) * :include source config directive: Configuration DSL. (line 6) * :inherit-configuration source config directive: Configuration DSL. (line 6) * :require dependencies: The defsystem grammar. - (line 248) + (line 261) * :tree source config directive: Configuration DSL. (line 6) * :version: The defsystem form. (line 68) * :version <1>: The defsystem grammar. - (line 217) + (line 230) * :version <2>: Common attributes of components. (line 23) * :weakly-depends-on: The defsystem grammar. - (line 128) + (line 141) * also-exclude source config directive: Configuration DSL. (line 6) * around-compile keyword: Controlling file compilation. (line 6) +* ASDF output: How can I capture ASDF's output?. + (line 6) * ASDF versions: Introduction. (line 6) * ASDF-BINARY-LOCATIONS compatibility: Output Backward Compatibility. (line 6) @@ -5404,6 +5469,10 @@ Concept Index * ASDF-USER package: Components. (line 41) * bug tracker: Where do I report a bug?. (line 6) +* build-operation: Convenience Functions. + (line 64) +* Capturing ASDF output: How can I capture ASDF's output?. + (line 6) * compile-check keyword: Controlling file compilation. (line 6) * component: Components. (line 6) @@ -5425,23 +5494,23 @@ Concept Index * launchpad: Where do I report a bug?. (line 6) * logical pathnames: The defsystem grammar. - (line 258) + (line 271) * mailing list: Mailing list. (line 6) * operation: Operations. (line 6) * pathname specifiers: The defsystem grammar. - (line 150) + (line 163) * Primary system name: Components. (line 70) * readtables: How do I work with readtables?. (line 6) * serial dependencies: The defsystem grammar. - (line 304) + (line 317) * system: Components. (line 6) * system designator: Components. (line 6) * System names: Components. (line 70) * Testing for ASDF: Introduction. (line 6) * tree source config directive: Configuration DSL. (line 6) * version specifiers: The defsystem grammar. - (line 217) + (line 230)

File: asdf.info, Node: Function and Class Index, Next: Variable Index, Prev: Concept Index, Up: Top @@ -5453,7 +5522,7 @@ Function and Class Index * Menu:

* already-loaded-systems: Convenience Functions. - (line 25) + (line 29) * apply-output-translations: Output location API. (line 36) * asdf-version: How do I detect the ASDF version?. (line 6) @@ -5474,21 +5543,21 @@ Function and Class Index (line 12) * compile-bundle-op: What happened to the bundle operations. (line 6) -* 'compile-bundle-op': Predefined operations of ASDF. +* compile-bundle-op,: Predefined operations of ASDF. (line 93) * compile-file*: Controlling file compilation. (line 6) -* 'compile-op': Predefined operations of ASDF. +* compile-op: Predefined operations of ASDF. (line 11) * compile-system: Convenience Functions. - (line 6) + (line 38) * component: The object model of ASDF. (line 6) * component-depends-on: Creating new operations. (line 45) * component-pathname: Common attributes of components. (line 155) -* 'concatenate-source-op': Predefined operations of ASDF. +* concatenate-source-op,: Predefined operations of ASDF. (line 178) * defsystem: The defsystem form. (line 6) * defsystem <1>: A more involved example. @@ -5521,17 +5590,15 @@ Function and Class Index (line 6) * load-fasl-op (obsolete): What happened to the bundle operations. (line 6) -* 'load-op': Predefined operations of ASDF. +* load-op: Predefined operations of ASDF. (line 25) -* 'load-source-op': Predefined operations of ASDF. +* load-source-op,: Predefined operations of ASDF. (line 45) * load-system: Convenience Functions. - (line 6) -* load-system <1>: Convenience Functions. - (line 25) + (line 29) * locate-system: Components. (line 97) * make: Convenience Functions. - (line 6) + (line 54) * merge-pathnames*: Some Utility Functions. (line 62) * module: Pre-defined subclasses of component. @@ -5549,11 +5616,11 @@ Function and Class Index * monolithic-load-fasl-op (obsolete): What happened to the bundle operations. (line 6) * oos: Convenience Functions. - (line 13) -* 'oos': Operations. (line 33) + (line 21) +* oos <1>: Operations. (line 33) * operate: Convenience Functions. - (line 13) -* 'operate': Operations. (line 31) + (line 21) +* operate <1>: Operations. (line 31) * operation: The object model of ASDF. (line 6) * operation-done-p: Creating new operations. @@ -5565,7 +5632,7 @@ Function and Class Index (line 12) * perform: Creating new operations. (line 19) -* 'prepare-op': Predefined operations of ASDF. +* prepare-op: Predefined operations of ASDF. (line 38) * primary-system-name: Components. (line 70) * primary-system-name <1>: Components. (line 91) @@ -5575,9 +5642,7 @@ Function and Class Index * register-preloaded-system: Miscellaneous Functions. (line 61) * require-system: Convenience Functions. - (line 6) -* require-system <1>: Convenience Functions. - (line 25) + (line 65) * run-program: Some Utility Functions. (line 89) * run-shell-command: Miscellaneous Functions. @@ -5605,10 +5670,10 @@ Function and Class Index (line 25) * system-weakly-depends-on: Information about system dependencies. (line 14) -* 'test-op': Predefined operations of ASDF. +* test-op: Predefined operations of ASDF. (line 52) * test-system: Convenience Functions. - (line 6) + (line 49) * traverse: Operations. (line 73) * version-satisfies: Common attributes of components. (line 23) @@ -5630,15 +5695,17 @@ Variable Index * *image-dump-hook*: Resetting the ASDF configuration. (line 14) * *load-system-operation*: Convenience Functions. - (line 25) + (line 29) * *nil-pathname*: Some Utility Functions. (line 43) * *oldest-forward-compatible-asdf-version*: Pitfalls of the upgrade to ASDF 3. (line 83) * *source-registry-parameter*: *source-registry-parameter* variable. (line 6) +* *standard-output*: How can I capture ASDF's output?. + (line 6) * *system-definition-search-functions*: Components. (line 6) -* 'asdf::*user-cache*': Output Configuration DSL. +* asdf::*user-cache*: Output Configuration DSL. (line 118) * ASDF_OUTPUT_TRANSLATIONS: Controlling where ASDF saves compiled files. (line 6) @@ -5647,136 +5714,137 @@ Variable Index  Tag Table: Node: Top1684 -Node: Introduction7633 -Node: Quick start summary9936 -Node: Loading ASDF11643 -Node: Loading a pre-installed ASDF11945 -Ref: Loading a pre-installed ASDF-Footnote-113758 -Node: Checking whether ASDF is loaded13940 -Node: Upgrading ASDF14854 -Node: Replacing your implementation's ASDF15842 -Node: Loading ASDF from source17265 -Node: Configuring ASDF18366 -Node: Configuring ASDF to find your systems19139 -Ref: Configuring ASDF to find your systems-Footnote-122444 -Ref: Configuring ASDF to find your systems-Footnote-222691 -Ref: Configuring ASDF to find your systems-Footnote-322973 -Node: Configuring ASDF to find your systems --- old style23434 -Ref: Configuring ASDF to find your systems --- old style-Footnote-125861 -Ref: Configuring ASDF to find your systems --- old style-Footnote-226093 -Ref: Configuring ASDF to find your systems --- old style-Footnote-326860 -Node: Configuring where ASDF stores object files27016 -Node: Resetting the ASDF configuration28419 -Node: Using ASDF29476 -Node: Loading a system29687 -Node: Convenience Functions30704 -Ref: Convenience Functions-Footnote-133849 -Node: Moving on33927 -Node: Defining systems with defsystem34298 -Node: The defsystem form34726 -Node: A more involved example38132 -Ref: A more involved example-Footnote-145114 -Node: The defsystem grammar45796 -Ref: if-feature-option61935 -Node: Other code in .asd files63767 -Node: The package-inferred-system extension64903 -Node: The object model of ASDF69170 -Ref: The object model of ASDF-Footnote-171500 -Ref: The object model of ASDF-Footnote-271852 -Node: Operations72179 -Ref: operate73284 -Node: Predefined operations of ASDF75767 -Ref: test-op77882 -Node: Creating new operations85765 -Node: Components90978 -Ref: System names94462 -Ref: Components-Footnote-199134 -Ref: Components-Footnote-299430 -Node: Common attributes of components99752 -Ref: required-features101314 -Node: Pre-defined subclasses of component107161 -Node: Creating new component types109595 -Node: Dependencies110885 -Node: Functions112756 -Node: Controlling where ASDF searches for systems114590 -Node: Configurations115212 -Node: Truenames and other dangers118687 -Node: XDG base directory119973 -Node: Backward Compatibility121387 -Node: Configuration DSL122103 -Node: Configuration Directories127658 -Node: The here directive129485 -Node: Shell-friendly syntax for configuration131378 -Node: Search Algorithm132395 -Node: Caching Results133896 -Node: Configuration API137140 -Node: Introspection139179 -Node: *source-registry-parameter* variable139443 -Node: Information about system dependencies140012 -Node: Status140928 -Node: Rejected ideas141383 -Node: TODO143764 -Node: Credits for the source-registry143949 -Node: Controlling where ASDF saves compiled files144484 -Ref: Controlling where ASDF saves compiled files-Footnote-1145896 -Node: Output Configurations145940 -Ref: Output Configurations-Footnote-1148801 -Node: Output Backward Compatibility148867 -Node: Output Configuration DSL151593 -Node: Output Configuration Directories157048 -Node: Output Shell-friendly syntax for configuration158605 -Node: Semantics of Output Translations159914 -Node: Output Caching Results161483 -Node: Output location API161963 -Node: Credits for output translations164385 -Node: Error handling164905 -Node: Miscellaneous additional functionality165746 -Node: Controlling file compilation166218 -Node: Controlling source file character encoding169484 -Node: Miscellaneous Functions176299 -Ref: system-relative-pathname176596 -Ref: Miscellaneous Functions-Footnote-1182220 -Node: Some Utility Functions182331 -Node: Getting the latest version193059 -Node: FAQ194004 -Node: Where do I report a bug?194399 -Node: Mailing list194764 -Node: What has changed between ASDF 1 ASDF 2 and ASDF 3?195099 -Node: What are ASDF 1 2 3?197273 -Node: How do I detect the ASDF version?198314 -Node: ASDF can portably name files in subdirectories200621 -Node: Output translations202171 -Node: Source Registry Configuration203198 -Node: Usual operations are made easier to the user204825 -Node: Many bugs have been fixed205411 -Node: ASDF itself is versioned207243 -Node: ASDF can be upgraded208118 -Node: Decoupled release cycle209270 -Node: Pitfalls of the transition to ASDF 2210199 -Node: Pitfalls of the upgrade to ASDF 3214469 -Ref: Pitfalls of the upgrade to ASDF 3-Footnote-1218836 -Node: What happened to the bundle operations219006 -Node: Issues with installing the proper version of ASDF220108 -Node: My Common Lisp implementation comes with an outdated version of ASDF. What to do?220579 -Node: I'm a Common Lisp implementation vendor. When and how should I upgrade ASDF?221512 -Node: Issues with configuring ASDF225395 -Node: How can I customize where fasl files are stored?225770 -Node: How can I wholly disable the compiler output cache?226863 -Node: Issues with using and extending ASDF to define systems228242 -Node: How can I cater for unit-testing in my system?228966 -Node: How can I cater for documentation generation in my system?229855 -Node: How can I maintain non-Lisp (e.g. C) source files?230376 -Ref: report-bugs230808 -Node: I want to put my module's files at the top level. How do I do this?230808 -Node: How do I create a system definition where all the source files have a .cl extension?233958 -Node: How do I mark a source file to be loaded only and not compiled?235931 -Node: How do I work with readtables?236927 -Node: ASDF development FAQs240613 -Node: How do I run the tests interactively in a REPL?240852 -Node: Ongoing Work242718 -Node: Bibliography242997 -Node: Concept Index246433 -Node: Function and Class Index252725 -Node: Variable Index264553 +Node: Introduction7673 +Node: Quick start summary9976 +Node: Loading ASDF11683 +Node: Loading a pre-installed ASDF11985 +Ref: Loading a pre-installed ASDF-Footnote-113798 +Node: Checking whether ASDF is loaded13980 +Node: Upgrading ASDF14894 +Node: Replacing your implementation's ASDF15882 +Node: Loading ASDF from source17305 +Node: Configuring ASDF18406 +Node: Configuring ASDF to find your systems19179 +Ref: Configuring ASDF to find your systems-Footnote-122484 +Ref: Configuring ASDF to find your systems-Footnote-222731 +Ref: Configuring ASDF to find your systems-Footnote-323013 +Node: Configuring ASDF to find your systems --- old style23474 +Ref: Configuring ASDF to find your systems --- old style-Footnote-125901 +Ref: Configuring ASDF to find your systems --- old style-Footnote-226133 +Ref: Configuring ASDF to find your systems --- old style-Footnote-326900 +Node: Configuring where ASDF stores object files27056 +Node: Resetting the ASDF configuration28459 +Node: Using ASDF29516 +Node: Loading a system29727 +Node: Convenience Functions30744 +Ref: Convenience Functions-Footnote-136104 +Node: Moving on36182 +Node: Defining systems with defsystem36553 +Node: The defsystem form36981 +Node: A more involved example40387 +Ref: A more involved example-Footnote-147369 +Node: The defsystem grammar48051 +Ref: if-feature-option64666 +Node: Other code in .asd files66498 +Node: The package-inferred-system extension67634 +Node: The object model of ASDF71901 +Ref: The object model of ASDF-Footnote-174231 +Ref: The object model of ASDF-Footnote-274583 +Node: Operations74910 +Ref: operate76015 +Node: Predefined operations of ASDF78498 +Ref: test-op80612 +Node: Creating new operations88501 +Node: Components93714 +Ref: System names97198 +Ref: Components-Footnote-1101870 +Ref: Components-Footnote-2102166 +Node: Common attributes of components102488 +Ref: required-features104050 +Node: Pre-defined subclasses of component109897 +Node: Creating new component types112331 +Node: Dependencies113621 +Node: Functions115492 +Node: Controlling where ASDF searches for systems117326 +Node: Configurations117948 +Node: Truenames and other dangers121423 +Node: XDG base directory122709 +Node: Backward Compatibility124123 +Node: Configuration DSL124839 +Node: Configuration Directories130394 +Node: The here directive132221 +Node: Shell-friendly syntax for configuration134114 +Node: Search Algorithm135131 +Node: Caching Results136632 +Node: Configuration API139876 +Node: Introspection141915 +Node: *source-registry-parameter* variable142179 +Node: Information about system dependencies142748 +Node: Status143664 +Node: Rejected ideas144119 +Node: TODO146500 +Node: Credits for the source-registry146685 +Node: Controlling where ASDF saves compiled files147220 +Ref: Controlling where ASDF saves compiled files-Footnote-1148632 +Node: Output Configurations148676 +Ref: Output Configurations-Footnote-1151537 +Node: Output Backward Compatibility151603 +Node: Output Configuration DSL154329 +Node: Output Configuration Directories159784 +Node: Output Shell-friendly syntax for configuration161341 +Node: Semantics of Output Translations162650 +Node: Output Caching Results164219 +Node: Output location API164699 +Node: Credits for output translations167121 +Node: Error handling167641 +Node: Miscellaneous additional functionality168482 +Node: Controlling file compilation168954 +Node: Controlling source file character encoding172220 +Node: Miscellaneous Functions179035 +Ref: system-relative-pathname179332 +Ref: Miscellaneous Functions-Footnote-1184956 +Node: Some Utility Functions185067 +Node: Getting the latest version195795 +Node: FAQ196740 +Node: Where do I report a bug?197135 +Node: Mailing list197500 +Node: What has changed between ASDF 1 ASDF 2 and ASDF 3?197835 +Node: What are ASDF 1 2 3?200009 +Node: How do I detect the ASDF version?201050 +Node: ASDF can portably name files in subdirectories203357 +Node: Output translations204907 +Node: Source Registry Configuration205934 +Node: Usual operations are made easier to the user207561 +Node: Many bugs have been fixed208147 +Node: ASDF itself is versioned209979 +Node: ASDF can be upgraded210854 +Node: Decoupled release cycle212006 +Node: Pitfalls of the transition to ASDF 2212935 +Node: Pitfalls of the upgrade to ASDF 3217205 +Ref: Pitfalls of the upgrade to ASDF 3-Footnote-1221572 +Node: What happened to the bundle operations221742 +Node: Issues with installing the proper version of ASDF222844 +Node: My Common Lisp implementation comes with an outdated version of ASDF. What to do?223315 +Node: I'm a Common Lisp implementation vendor. When and how should I upgrade ASDF?224248 +Node: Issues with configuring ASDF228131 +Node: How can I customize where fasl files are stored?228506 +Node: How can I wholly disable the compiler output cache?229599 +Node: Issues with using and extending ASDF to define systems230978 +Node: How can I cater for unit-testing in my system?231739 +Node: How can I cater for documentation generation in my system?232627 +Node: How can I maintain non-Lisp (e.g. C) source files?233148 +Ref: report-bugs233580 +Node: I want to put my module's files at the top level. How do I do this?233580 +Node: How do I create a system definition where all the source files have a .cl extension?236730 +Node: How do I mark a source file to be loaded only and not compiled?238703 +Node: How do I work with readtables?239699 +Node: How can I capture ASDF's output?243426 +Node: ASDF development FAQs243857 +Node: How do I run the tests interactively in a REPL?244096 +Node: Ongoing Work245962 +Node: Bibliography246241 +Node: Concept Index249677 +Node: Function and Class Index256539 +Node: Variable Index268093  End Tag Table

===================================== src/contrib/asdf/doc/asdf.pdf ===================================== Binary files a/src/contrib/asdf/doc/asdf.pdf and b/src/contrib/asdf/doc/asdf.pdf differ

===================================== src/general-info/release-21b.txt ===================================== --- a/src/general-info/release-21b.txt +++ b/src/general-info/release-21b.txt @@ -22,7 +22,7 @@ New in this release: * Feature enhancements

* Changes - * Update to ASDF 3.1.6 + * Update to ASDF 3.1.7. * Add support for asdf's static-image-op * This mostly entails internal changes in how executables are handled. lisp.a is not complete; it must be linked with @@ -44,18 +44,46 @@ New in this release: Thus, src/code/unix-glibc2.lisp is no longer used. * Micro-optimize modular shifts on x86. * Update lisp-unit to commit e6c259f. + * Added EXT:WITH-FLOAT-TRAPS-ENABLED to complement + WITH-FLOAT-TRAPS-MASKED. + * (EXPT 0 power) doesn't throw INTEXP-LIMIT-ERROR anymore for any + integer value of power. + * Starting cmucl with "-dyanmic-space-size 0" means using the + maximum possible heap size for the platform. + * More descriptive docstring for + * *environment-list* + * :env option for run-program + * Maximum dynamic-space-size on Linux reduced to 1530 MB because + that's the largest available space on 32-bit Ubuntu 11.10.

* ANSI compliance fixes: + * PATHNAME-MATCH-P did not accept search-lists.

* Bugfixes: * Linux was missing unix-setitimer which prevented saving cores. + * Generate inxact exceptions more carefully. + * Fix FP issue when building with Xcode 7.2 (and newer versions of + clang). (See ticket #12.) + * Cleanups in handling floating-point exceptions. See Tickets #15 + and #16.

* Trac Tickets:

* Gitlab tickets: * Ticket #10 fixed: setting an element of a 1, 2, or 4-bit array with a constant index did not always set the element - appropriately. + appropriately. + * Ticket #12 fixed. It looks like a possible compiler bug, but + worked around by explicitly setting inexact instead of using FP + instructions to generate inexact. + * Ticket #16 fixed: search-lists are handled correctly. + * Ticket #14 fixed: WITH-FLOAT-TRAPS-ENABLED doesn't incorrectly + set accrued exceptions anymore. + * Ticket #15 fixed: FLOATING-POINT-INEXACT exception prints out + values correctly now. + * Ticket #17 fixed: better docstring for *ENVIRONMENT-LIST* + * Ticket #18 fixed: better description of :ENV option for + RUN-PROGRAM.

* Other changes:

===================================== src/i18n/locale/cmucl.pot ===================================== --- a/src/i18n/locale/cmucl.pot +++ b/src/i18n/locale/cmucl.pot @@ -4729,6 +4729,45 @@ msgstr ""

#: src/code/float-trap.lisp msgid "" +"Encode the floating-point modes according to the give options and the\n" +" specified mode, Floating-Point-Modes. The resulting new mode is\n" +" returned. If a keyword is not supplied, then the current value is\n" +" preserved. Possible keywords:\n" +"\n" +" :TRAPS\n" +" A list of the exception conditions that should cause traps. Possible" +"\n" +" exceptions are :UNDERFLOW, :OVERFLOW, :INEXACT, :INVALID,\n" +" :DIVIDE-BY-ZERO, and on the X86 :DENORMALIZED-OPERAND. Initially\n" +" all traps except :INEXACT are enabled.\n" +"\n" +" :ROUNDING-MODE\n" +" The rounding mode to use when the result is not exact. Possible " +"values\n" +" are :NEAREST, :POSITIVE-INFINITY, :NEGATIVE-INFINITY and :ZERO.\n" +" Initially, the rounding mode is :NEAREST.\n" +"\n" +" :CURRENT-EXCEPTIONS\n" +" :ACCRUED-EXCEPTIONS\n" +" These arguments allow setting of the exception flags. The main use " +"is\n" +" setting the accrued exceptions to NIL to clear them.\n" +"\n" +" :FAST-MODE\n" +" Set the hardware's "fast mode" flag, if any. When set, IEEE\n" +" conformance or debuggability may be impaired. Some machines may not\n" +" have this feature, in which case the value is always NIL.\n" +"\n" +" GET-FLOATING-POINT-MODES may be used to find the floating point modes\n" +" currently in effect." +msgstr "" + +#: src/code/float-trap.lisp +msgid "Unknown rounding mode: ~S." +msgstr "" + +#: src/code/float-trap.lisp +msgid "" "This function sets options controlling the floating-point hardware. If a\n" " keyword is not supplied, then the current value is preserved. Possible\n" " keywords:\n" @@ -4762,7 +4801,11 @@ msgid "" msgstr ""

#: src/code/float-trap.lisp -msgid "Unknown rounding mode: ~S." +msgid "" +"This function returns a list representing the state of the floating point\n" +" modes given in Modes. The list is in the same format as the keyword " +"arguments to\n" +" SET-FLOATING-POINT-MODES." msgstr ""

#: src/code/float-trap.lisp @@ -4797,6 +4840,16 @@ msgid "" " their testing within, and restored on exit." msgstr ""

+#: src/code/float-trap.lisp +msgid "" +"Execute BODY with the floating point exceptions listed in TRAPS\n" +" enabled. TRAPS should be a list of possible exceptions which\n" +" includes :UNDERFLOW, :OVERFLOW, :INEXACT, :INVALID and\n" +" :DIVIDE-BY-ZERO and on the X86 :DENORMALIZED-OPERAND. The respective\n" +" accrued exceptions are cleared at the start of the body to support\n" +" their testing within, and restored on exit." +msgstr "" + #: src/code/float.lisp msgid "Return true if the float X is denormalized." msgstr "" @@ -6012,8 +6065,9 @@ msgstr "" #: src/code/commandline.lisp msgid "" "Specifies the number of megabytes that should be allocated to the\n" -" heap. If not specified, a platform-specific default is used. The\n" -" actual maximum allowed heap size is platform-specific." +" heap. If not specified, a platform-specific default is used. If 0,\n" +" the platform-specific maximum heap size is used. The actual maximum\n" +" allowed heap size is platform-specific." msgstr ""

#: src/code/commandline.lisp @@ -6600,7 +6654,9 @@ msgid "" msgstr ""

#: src/code/save.lisp -msgid "An alist mapping environment variables (as keywords) to either values" +msgid "" +"An alist mapping each environment variable (as a keyword) to its\n" +" value." msgstr ""

#: src/code/save.lisp @@ -9118,9 +9174,12 @@ msgid "" " The standard streams are sys::*stdin*, sys::*stdout*, and\n" " sys::*stderr*, which are normally the input and/or output streams\n" " for *standard-input* and *standard-output*. Also sets sys::*tty*\n" -" (normally *terminal-io* to the given external format. If the\n" -" optional argument Filenames is gvien, then the filename encoding is\n" -" set to the specified format." +" (normally *terminal-io* to the given external format. The value of\n" +" *default-external-format* is not changed.\n" +"\n" +" If the optional argument Filenames is given, then the filename\n" +" encoding is set to the specified format, if it has not already been\n" +" specified previously." msgstr ""

#: src/code/extfmts.lisp @@ -13065,8 +13124,9 @@ msgid "" "\n" " The keyword arguments have the following meanings:\n" " :env -\n" -" An A-LIST mapping keyword environment variables to simple-string\n" -" values.\n" +" An A-LIST mapping keyword environment variables to\n" +" simple-string values. This is the shell environment for\n" +" Program. Defaults to *environment-list*.\n" " :wait -\n" " If non-NIL (default), wait until the created process finishes. If\n" " NIL, continue running Lisp until the program finishes.\n"

===================================== src/lisp/e_asin.c ===================================== --- a/src/lisp/e_asin.c +++ b/src/lisp/e_asin.c @@ -50,7 +50,6 @@ static const double static double #endif one = 1.00000000000000000000e+00, /* 0x3FF00000, 0x00000000 */ -huge = 1.000e+300, pio2_hi = 1.57079632679489655800e+00, /* 0x3FF921FB, 0x54442D18 */ pio2_lo = 6.12323399573676603587e-17, /* 0x3C91A626, 0x33145C07 */ pio4_hi = 7.85398163397448278999e-01, /* 0x3FE921FB, 0x54442D18 */ @@ -89,7 +88,12 @@ qS4 = 7.70381505559019352791e-02; /* 0x3FB3B8C5, 0xB12E9282 */ return fdlibm_setexception(x, FDLIBM_INVALID); } else if (ix<0x3fe00000) { /* |x|<0.5 */ if(ix<0x3e400000) { /* if |x| < 2**-27 */ - if(huge+x>one) return x;/* return x with inexact if x!=0*/ + /* return x inexact except 0 */ + if (x != 0) { + fdlibm_setexception(x, FDLIBM_INEXACT); + } + + return x; } else t = x*x; p = t*(pS0+t*(pS1+t*(pS2+t*(pS3+t*(pS4+t*pS5)))));

===================================== src/lisp/e_cosh.c ===================================== --- a/src/lisp/e_cosh.c +++ b/src/lisp/e_cosh.c @@ -35,7 +35,7 @@ #include "fdlibm.h"

#ifdef __STDC__ -static const double one = 1.0, half=0.5, huge = 1.0e307; +static const double one = 1.0, half=0.5; #else static double one = 1.0, half=0.5, huge = 1.0e307; #endif

===================================== src/lisp/e_exp.c ===================================== --- a/src/lisp/e_exp.c +++ b/src/lisp/e_exp.c @@ -82,7 +82,6 @@ static double #endif one = 1.0, halF[2] = {0.5,-0.5,}, -huge = 1.0e+300, twom1000= 9.33263618503218878990e-302, /* 2**-1000=0x01700000,0*/ o_threshold= 7.09782712893383973096e+02, /* 0x40862E42, 0xFEFA39EF */ u_threshold= -7.45133219101941108420e+02, /* 0xc0874910, 0xD52D3051 */ @@ -161,7 +160,12 @@ P5 = 4.13813679705723846039e-08; /* 0x3E663769, 0x72BEA4D0 */ x = hi - lo; } else if(hx < 0x3e300000) { /* when |x|<2**-28 */ - if(huge+x>one) return one+x;/* trigger inexact */ + /* return x inexact except 0 */ + if (x != 0) { + fdlibm_setexception(x, FDLIBM_INEXACT); + } + + return one + x; } else k = 0;

===================================== src/lisp/e_sinh.c ===================================== --- a/src/lisp/e_sinh.c +++ b/src/lisp/e_sinh.c @@ -32,7 +32,7 @@ #include "fdlibm.h"

#ifdef __STDC__ -static const double one = 1.0, shuge = 1.0e307; +static const double one = 1.0; #else static double one = 1.0, shuge = 1.0e307; #endif @@ -67,8 +67,14 @@ static double one = 1.0, shuge = 1.0e307; if (jx<0) h = -h; /* |x| in [0,22], return sign(x)*0.5*(E+E/(E+1))) */ if (ix < 0x40360000) { /* |x|<22 */ - if (ix<0x3e300000) /* |x|<2**-28 */ - if(shuge+x>one) return x;/* sinh(tiny) = tiny with inexact */ + if (ix<0x3e300000) { /* |x|<2**-28 */ + /* sinh(tiny) = tiny with inexact */ + if (x != 0) { + fdlibm_setexception(x, FDLIBM_INEXACT); + } + + return x; + } t = fdlibm_expm1(fabs(x)); if(ix<0x3ff00000) return h*(2.0*t-t*t/(t+one)); return h*(t+t/(t+one));

===================================== src/lisp/fdlibm.h ===================================== --- a/src/lisp/fdlibm.h +++ b/src/lisp/fdlibm.h @@ -61,7 +61,8 @@ enum FDLIBM_EXCEPTION { FDLIBM_DIVIDE_BY_ZERO, FDLIBM_UNDERFLOW, FDLIBM_OVERFLOW, - FDLIBM_INVALID + FDLIBM_INVALID, + FDLIBM_INEXACT };

extern double fdlibm_setexception(double x, enum FDLIBM_EXCEPTION);

===================================== src/lisp/interrupt.c ===================================== --- a/src/lisp/interrupt.c +++ b/src/lisp/interrupt.c @@ -252,8 +252,6 @@ interrupt_handle_now(HANDLER_ARGS)

handler = interrupt_handlers[signal];

- RESTORE_FPU(context); - if (handler.c == (void (*)(HANDLER_ARGS)) SIG_IGN) return;

@@ -333,7 +331,6 @@ maybe_now_maybe_later(HANDLER_ARGS) setup_pending_signal(signal, code, context); arch_set_pseudo_atomic_interrupted(context); } else { - RESTORE_FPU(context); interrupt_handle_now(signal, code, context); }

===================================== src/lisp/k_cos.c ===================================== --- a/src/lisp/k_cos.c +++ b/src/lisp/k_cos.c @@ -75,7 +75,12 @@ C6 = -1.13596475577881948265e-11; /* 0xBDA8FAE9, 0xBE8838D4 */ ux.d = x; ix = ux.i[HIWORD]&0x7fffffff; /* ix = |x|'s high word*/ if(ix<0x3e400000) { /* if x < 2**27 */ - if(((int)x)==0) return one; /* generate inexact */ + /* return 1 with inexact unless x == 0 */ + if (x != 0) { + fdlibm_setexception(x, FDLIBM_INEXACT); + } + + return one; } z = x*x; r = z*(C1+z*(C2+z*(C3+z*(C4+z*(C5+z*C6)))));

===================================== src/lisp/k_sin.c ===================================== --- a/src/lisp/k_sin.c +++ b/src/lisp/k_sin.c @@ -67,8 +67,14 @@ S6 = 1.58969099521155010221e-10; /* 0x3DE5D93A, 0x5ACFD57C */

ux.d = x; ix = ux.i[HIWORD]&0x7fffffff; /* high word of x */ - if(ix<0x3e400000) /* |x| < 2**-27 */ - {if((int)x==0) return x;} /* generate inexact */ + if(ix<0x3e400000) { /* |x| < 2**-27 */ + /* return x inexact except 0 */ + if (x != 0) { + fdlibm_setexception(x, FDLIBM_INEXACT); + } + + return x; + } z = x*x; v = z*x; r = S2+z*(S3+z*(S4+z*(S5+z*S6)));

===================================== src/lisp/k_tan.c ===================================== --- a/src/lisp/k_tan.c +++ b/src/lisp/k_tan.c @@ -78,31 +78,34 @@ __kernel_tan(double x, double y, int iy) { hx = ux.i[HIWORD]; /* high word of x */ ix = hx & 0x7fffffff; /* high word of |x| */ if (ix < 0x3e300000) { /* x < 2**-28 */ - if ((int) x == 0) { /* generate inexact */ - if (((ix | ux.i[LOWORD]) | (iy + 1)) == 0) - return one / fabs(x); - else { - if (iy == 1) - return x; - else { /* compute -1 / (x+y) carefully */ - double a, t; + /* return x inexact except 0 */ + if (x != 0) { + fdlibm_setexception(x, FDLIBM_INEXACT); + }

- z = w = x + y; - uz.d = z; - uz.i[LOWORD] = 0; - z = ux.d; + if (((ix | ux.i[LOWORD]) | (iy + 1)) == 0) + return one / fabs(x); + else { + if (iy == 1) + return x; + else { /* compute -1 / (x+y) carefully */ + double a, t; + + z = w = x + y; + uz.d = z; + uz.i[LOWORD] = 0; + z = ux.d;

- v = y - (z - x); - t = a = -one / w; - uz.d = t; - uz.i[LOWORD] = 0; - t = uz.d; + v = y - (z - x); + t = a = -one / w; + uz.d = t; + uz.i[LOWORD] = 0; + t = uz.d;

- s = one + t * z; - return t + a * (s + t * v); - } - } + s = one + t * z; + return t + a * (s + t * v); } + } } if (ix >= 0x3FE59428) { /* |x| >= 0.6744 */ if (hx < 0) {

===================================== src/lisp/lisp.c ===================================== --- a/src/lisp/lisp.c +++ b/src/lisp/lisp.c @@ -622,7 +622,16 @@ main(int argc, const char *argv[], const char *envp[]) exit(1); } #ifndef sparc - dynamic_space_size = atoi(str) * 1024 * 1024; + dynamic_space_size = atoi(str); + + /* + * A size of 0 means using the largest possible space + */ + if (dynamic_space_size == 0) { + dynamic_space_size = DYNAMIC_SPACE_SIZE; + } else { + dynamic_space_size *= 1024 * 1024; + } #else { int val; @@ -646,7 +655,11 @@ main(int argc, const char *argv[], const char *envp[]) "Note: Rounding dynamic-space-size from %d MB to %d MB\n", val, dynamic_space_size); } - dynamic_space_size *= 1024 * 1024; + if (dynamic_space_size == 0) { + dynamic_space_size = DYNAMIC_SPACE_SIZE; + } else { + dynamic_space_size *= 1024 * 1024; + } } #endif if (dynamic_space_size > DYNAMIC_SPACE_SIZE) {

===================================== src/lisp/s_asinh.c ===================================== --- a/src/lisp/s_asinh.c +++ b/src/lisp/s_asinh.c @@ -32,8 +32,7 @@ static const double static double #endif one = 1.00000000000000000000e+00, /* 0x3FF00000, 0x00000000 */ -ln2 = 6.93147180559945286227e-01, /* 0x3FE62E42, 0xFEFA39EF */ -huge= 1.00000000000000000000e+300; +ln2 = 6.93147180559945286227e-01; /* 0x3FE62E42, 0xFEFA39EF */

#ifdef __STDC__ double fdlibm_asinh(double x) @@ -59,7 +58,12 @@ huge= 1.00000000000000000000e+300; }

if(ix< 0x3e300000) { /* |x|<2**-28 */ - if(huge+x>one) return x; /* return x inexact except 0 */ + /* return x inexact except 0 */ + if (x != 0) { + fdlibm_setexception(x, FDLIBM_INEXACT); + } + + return x; } if(ix>0x41b00000) { /* |x| > 2**28 */ w = __ieee754_log(fabs(x))+ln2;

===================================== src/lisp/s_atan.c ===================================== --- a/src/lisp/s_atan.c +++ b/src/lisp/s_atan.c @@ -79,8 +79,7 @@ static double aT[] = { #else static double #endif -one = 1.0, -huge = 1.0e300; +one = 1.0;

#ifdef __STDC__ double fdlibm_atan(double x) @@ -104,7 +103,12 @@ huge = 1.0e300; else return -atanhi[3]-atanlo[3]; } if (ix < 0x3fdc0000) { /* |x| < 0.4375 */ if (ix < 0x3e200000) { /* |x| < 2^-29 */ - if(huge+x>one) return x; /* raise inexact */ + /* return x inexact except 0 */ + if (x != 0) { + fdlibm_setexception(x, FDLIBM_INEXACT); + } + + return x; } id = -1; } else {

===================================== src/lisp/s_expm1.c ===================================== --- a/src/lisp/s_expm1.c +++ b/src/lisp/s_expm1.c @@ -160,8 +160,8 @@ Q5 = -2.01099218183624371326e-07; /* BE8AFDB7 6E09C32D */

} if(xsb!=0) { /* x < -56*ln2, return -1.0 with inexact */ - if(x+tiny<0.0) /* raise inexact */ - return tiny-one; /* return -1 */ + fdlibm_setexception(x, FDLIBM_INEXACT); + return tiny - one; } }

===================================== src/lisp/s_log1p.c ===================================== --- a/src/lisp/s_log1p.c +++ b/src/lisp/s_log1p.c @@ -85,7 +85,6 @@ static double #endif ln2_hi = 6.93147180369123816490e-01, /* 3fe62e42 fee00000 */ ln2_lo = 1.90821492927058770002e-10, /* 3dea39ef 35793c76 */ -two54 = 1.80143985094819840000e+16, /* 43500000 00000000 */ Lp1 = 6.666666666666735130e-01, /* 3FE55555 55555593 */ Lp2 = 3.999999999940941908e-01, /* 3FD99999 9997FA04 */ Lp3 = 2.857142874366239149e-01, /* 3FD24924 94229359 */ @@ -123,9 +122,14 @@ static double zero = 0.0; } } if(ax<0x3e200000) { /* |x| < 2**-29 */ - if(two54+x>zero /* raise inexact */ - &&ax<0x3c900000) /* |x| < 2**-54 */ + if (ax < 0x3c900000) { /* |x| < 2**-54 */ + /* return x inexact except 0 */ + if (x != 0) { + fdlibm_setexception(x, FDLIBM_INEXACT); + } + return x; + } else return x - x*x*0.5; }

===================================== src/lisp/s_scalbn.c ===================================== --- a/src/lisp/s_scalbn.c +++ b/src/lisp/s_scalbn.c @@ -26,9 +26,7 @@ static const double static double #endif two54 = 1.80143985094819840000e+16, /* 0x43500000, 0x00000000 */ -twom54 = 5.55111512312578270212e-17, /* 0x3C900000, 0x00000000 */ -huge = 1.0e+300, -tiny = 1.0e-300; +twom54 = 5.55111512312578270212e-17; /* 0x3C900000, 0x00000000 */

#ifdef __STDC__ double fdlibm_scalbn (double x, int n)

===================================== src/lisp/s_tanh.c ===================================== --- a/src/lisp/s_tanh.c +++ b/src/lisp/s_tanh.c @@ -78,7 +78,9 @@ static double one=1.0, two=2.0, tiny = 1.0e-300; } /* |x| > 22, return +-1 */ } else { - z = one - tiny; /* raised inexact flag */ + /* Always raise inexact flag */ + fdlibm_setexception(x, FDLIBM_INEXACT); + z = one - tiny; } return (jx>=0)? z: -z; }

===================================== src/lisp/setexception.c ===================================== --- a/src/lisp/setexception.c +++ b/src/lisp/setexception.c @@ -88,6 +88,10 @@ fdlibm_setexception(double x, enum FDLIBM_EXCEPTION type)

break; } + case FDLIBM_INEXACT: + feraiseexcept(FE_INEXACT); + ret = x; + break; default: /* Shouldn't happen! */ ret = 0.0;

===================================== src/lisp/x86-arch.c ===================================== --- a/src/lisp/x86-arch.c +++ b/src/lisp/x86-arch.c @@ -320,6 +320,12 @@ sigtrap_handler(HANDLER_ARGS) /* This is just for info in case monitor wants to print an approx */ current_control_stack_pointer = (unsigned long *) SC_SP(os_context);

+ + /* + * In many places in the switch below, we eventually throw instead + * of returning from the signal handler. So, just in case, set + * the current FPU modes from the saved context. + */ RESTORE_FPU(os_context);

/*

===================================== src/lisp/x86-validate-linux.h ===================================== --- a/src/lisp/x86-validate-linux.h +++ b/src/lisp/x86-validate-linux.h @@ -22,12 +22,21 @@ * 0x38000000->0x40000000 128M Control stack growing down. * 0x40000000->0x48000000 128M Reserved for shared libraries. * 0x58000000->0x58100000 16M Foreign Linkage Table - * 0x58100000->0xBE000000 1631M Dynamic Space. - * 0xBFFF0000->0xC0000000 Unknown Linux mapping + * 0x58100000->0xB7B00000 1530M Dynamic Space. + * 0xB7B82000->0xC0000000 Unknown Linux mapping, including stack * + * * (Note: 0x58000000 allows us to run on a Linux system on an AMD * x86-64. Hence we have a gap of unused memory starting at * 0x48000000.) + * + * It appears as if the actual upper limit depends on the particular + * Linux distribution. Ubuntu 11.10 (32-bit) appears to have + * something mapped at 0xb78b2000, so we can't allocate the dynamic + * space past that. That results in a max heap size of 1530 MB. + * However, Fedora 22 ther appears to be nothing mapped there. In + * fact it appears to be free all the way to 0xf7c1b000. That would + * allow a heap of size 2555 MB. */

#define READ_ONLY_SPACE_START (SpaceStart_TargetReadOnly) @@ -54,7 +63,7 @@ #define DYNAMIC_0_SPACE_START (SpaceStart_TargetDynamic)

#ifdef GENCGC -#define DYNAMIC_SPACE_SIZE (0x66000000) /* 1.632GB */ +#define DYNAMIC_SPACE_SIZE (0x5FA00000) /* 1.530GB */ #else #define DYNAMIC_SPACE_SIZE (0x04000000) /* 64MB */ #endif

===================================== tests/fdlibm.lisp ===================================== --- a/tests/fdlibm.lisp +++ b/tests/fdlibm.lisp @@ -6,7 +6,7 @@ (in-package "FDLIBM-TESTS")

(defparameter *qnan* - (kernel::with-float-traps-masked (:invalid) + (ext:with-float-traps-masked (:invalid) (* 0 ext:double-float-positive-infinity)) "Some randon quiet MaN value")

@@ -25,7 +25,7 @@ (assert-true (ext:float-nan-p (kernel:%cosh *qnan*)))

;; Same, but with overflow's masked - (kernel::with-float-traps-masked (:overflow) + (ext:with-float-traps-masked (:overflow) (assert-equal ext:double-float-positive-infinity (kernel:%cosh 1000d0)) (assert-equal ext:double-float-positive-infinity @@ -35,7 +35,7 @@ (assert-equal ext:double-float-positive-infinity (kernel:%cosh ext:double-float-negative-infinity))) ;; Test NaN - (kernel::with-float-traps-masked (:invalid) + (ext:with-float-traps-masked (:invalid) (assert-true (ext:float-nan-p (kernel:%cosh *snan*)))))

(define-test %sinh.exceptions @@ -48,7 +48,7 @@ (kernel:%sinh *snan*)) (assert-true (ext:float-nan-p (kernel:%sinh *qnan*))) ;; Same, but with overflow's masked - (kernel::with-float-traps-masked (:overflow) + (ext:with-float-traps-masked (:overflow) (assert-equal ext:double-float-positive-infinity (kernel:%sinh 1000d0)) (assert-equal ext:double-float-negative-infinity @@ -58,17 +58,35 @@ (assert-equal ext:double-float-negative-infinity (kernel:%sinh ext:double-float-negative-infinity))) ;; Test NaN - (kernel::with-float-traps-masked (:invalid) - (assert-true (ext:float-nan-p (kernel:%sinh *qnan*))))) - + (ext:with-float-traps-masked (:invalid) + (assert-true (ext:float-nan-p (kernel:%sinh *qnan*)))) + ;; sinh(x) = x for |x| < 2^-28. Should signal inexact unless x = 0. + (let ((x (scale-float 1d0 -29)) + (x0 0d0)) + (ext:with-float-traps-enabled (:inexact) + ;; This must not throw an inexact exception because the result + ;; is exact when the arg is 0. + (assert-eql 0d0 (kernel:%sinh x0))) + (ext:with-float-traps-enabled (:inexact) + ;; This must throw an inexact exception for non-zero x even + ;; though the result is exactly x. + (assert-error 'floating-point-inexact + (kernel:%sinh x)))))

(define-test %tanh.exceptions (:tag :fdlibm) (assert-true (ext:float-nan-p (kernel:%tanh *qnan*))) (assert-error 'floating-point-invalid-operation (kernel:%tanh *snan*)) - (kernel::with-float-traps-masked (:invalid) - (assert-true (ext:float-nan-p (kernel:%tanh *snan*))))) + (ext:with-float-traps-masked (:invalid) + (assert-true (ext:float-nan-p (kernel:%tanh *snan*)))) + ;; tanh(x) = +/- 1 for |x| > 22, raising inexact, always. + (let ((x 22.1d0)) + (ext:with-float-traps-enabled (:inexact) + ;; This must throw an inexact exception for non-zero x even + ;; though the result is exactly x. + (assert-error 'floating-point-inexact + (kernel:%tanh x)))))

(define-test %acosh.exceptions (:tag :fdlibm) @@ -76,10 +94,10 @@ (kernel:%acosh ext:double-float-positive-infinity)) (assert-error 'floating-point-invalid-operation (kernel:%acosh 0d0)) - (kernel::with-float-traps-masked (:overflow) + (ext:with-float-traps-masked (:overflow) (assert-equal ext:double-float-positive-infinity (kernel:%acosh ext:double-float-positive-infinity))) - (kernel::with-float-traps-masked (:invalid) + (ext:with-float-traps-masked (:invalid) (assert-true (ext:float-nan-p (kernel:%acosh 0d0)))))

(define-test %asinh.exceptions @@ -91,13 +109,24 @@ (assert-error 'floating-point-overflow (kernel:%asinh ext:double-float-negative-infinity)) (assert-true (ext:float-nan-p (kernel:%asinh *qnan*))) - (kernel::with-float-traps-masked (:overflow) + (ext:with-float-traps-masked (:overflow) (assert-equal ext:double-float-positive-infinity (kernel:%asinh ext:double-float-positive-infinity)) (assert-error ext:double-float-negative-infinity (kernel:%asinh ext:double-float-negative-infinity))) - (kernel::with-float-traps-masked (:invalid) - (assert-true (ext:float-nan-p (kernel:%asinh *snan*))))) + (ext:with-float-traps-masked (:invalid) + (assert-true (ext:float-nan-p (kernel:%asinh *snan*)))) + (let ((x (scale-float 1d0 -29)) + (x0 0d0)) + (ext:with-float-traps-enabled (:inexact) + ;; This must not throw an inexact exception because the result + ;; is exact when the arg is 0. + (assert-eql 0d0 (asinh x0))) + (ext:with-float-traps-enabled (:inexact) + ;; This must throw an inexact exception for non-zero x even + ;; though the result is exactly x. + (assert-error 'floating-point-inexact + (asinh x)))))

(define-test %atanh.exceptions (:tag :fdlibm) @@ -109,10 +138,10 @@ (kernel:%atanh 1d0)) (assert-error 'division-by-zero (kernel:%atanh -1d0)) - (kernel::with-float-traps-masked (:invalid) + (ext:with-float-traps-masked (:invalid) (assert-true (ext:float-nan-p (kernel:%atanh 2d0))) (assert-true (ext:float-nan-p (kernel:%atanh -2d0)))) - (kernel::with-float-traps-masked (:divide-by-zero) + (ext:with-float-traps-masked (:divide-by-zero) (assert-equal ext:double-float-positive-infinity (kernel:%atanh 1d0)) (assert-equal ext:double-float-negative-infinity @@ -127,12 +156,17 @@ (assert-error 'floating-point-invalid-operation (kernel:%expm1 *snan*)) (assert-true (ext:float-nan-p (kernel:%expm1 *qnan*))) - (kernel::with-float-traps-masked (:overflow) + (ext:with-float-traps-masked (:overflow) (assert-equal ext:double-float-positive-infinity (kernel:%expm1 709.8d0)) ) - (kernel::with-float-traps-masked (:invalid) - (assert-true (ext::float-nan-p (kernel:%expm1 *snan*))))) + (ext:with-float-traps-masked (:invalid) + (assert-true (ext::float-nan-p (kernel:%expm1 *snan*)))) + ;; expm1(x) = -1 for x < -56*log(2), signaling inexact + (let ((x (* -57 (log 2d0)))) + (ext:with-float-traps-enabled (:inexact) + (assert-error 'floating-point-inexact + (kernel:%expm1 x)))))

(define-test %log1p.exceptions (:tag :fdlibm) @@ -141,11 +175,23 @@ (assert-error 'floating-point-overflow (kernel:%log1p -1d0)) (assert-true (ext:float-nan-p (kernel:%log1p *qnan*))) - (kernel::with-float-traps-masked (:overflow) + (ext:with-float-traps-masked (:overflow) (assert-equal ext:double-float-negative-infinity (kernel:%log1p -1d0))) - (kernel::with-float-traps-masked (:invalid) - (assert-true (ext:float-nan-p (kernel:%log1p *snan*))))) + (ext:with-float-traps-masked (:invalid) + (assert-true (ext:float-nan-p (kernel:%log1p *snan*)))) + ;; log1p(x) = x for |x| < 2^-54, signaling inexact except for x = 0. + (let ((x (scale-float 1d0 -55)) + (x0 0d0)) + (ext:with-float-traps-enabled (:inexact) + ;; This must not throw an inexact exception because the result + ;; is exact when the arg is 0. + (assert-eql 0d0 (kernel:%log1p x0))) + (ext:with-float-traps-enabled (:inexact) + ;; This must throw an inexact exception for non-zero x even + ;; though the result is exactly x. + (assert-error 'floating-point-inexact + (kernel:%log1p x)))))

(define-test %exp.exceptions (:tag :fdlibm) @@ -158,7 +204,7 @@ (kernel:%exp ext:double-float-positive-infinity)) (assert-equal 0d0 (kernel:%exp -1000d0)) - (kernel::with-float-traps-masked (:overflow) + (ext:with-float-traps-masked (:overflow) (assert-equal ext:double-float-positive-infinity (kernel:%exp 710d0))) (let ((modes (ext:get-floating-point-modes))) @@ -167,7 +213,19 @@ (ext:set-floating-point-modes :traps '(:underflow)) (assert-error 'floating-point-underflow (kernel:%exp -1000d0))) - (apply #'ext:set-floating-point-modes modes)))) + (apply #'ext:set-floating-point-modes modes))) + (let ((x (scale-float 1d0 -29)) + (x0 0d0)) + ;; exp(x) = x, |x| < 2^-28, with inexact exception unlees x = 0 + (ext:with-float-traps-enabled (:inexact) + ;; This must not throw an inexact exception because the result + ;; is exact when the arg is 0. + (assert-eql 1d0 (kernel:%exp x0))) + (ext:with-float-traps-enabled (:inexact) + ;; This must throw an inexact exception for non-zero x even + ;; though the result is exactly x. + (assert-error 'floating-point-inexact + (kernel:%exp x)))))

(define-test %log.exception (:tag :fdlibm) @@ -180,12 +238,12 @@ (assert-error 'floating-point-invalid-operation (kernel:%log *snan*)) (assert-true (ext:float-nan-p (kernel:%log *qnan*))) - (kernel::with-float-traps-masked (:divide-by-zero) + (ext:with-float-traps-masked (:divide-by-zero) (assert-equal ext:double-float-negative-infinity (kernel:%log 0d0)) (assert-equal ext:double-float-negative-infinity (kernel:%log -0d0))) - (kernel::with-float-traps-masked (:invalid) + (ext:with-float-traps-masked (:invalid) (assert-true (ext:float-nan-p (kernel:%log -1d0))) (assert-true (ext:float-nan-p (kernel:%log *snan*)))))

@@ -195,7 +253,7 @@ (kernel:%acos 2d0)) (assert-error 'floating-point-invalid-operation (kernel:%acos -2d0)) - (kernel::with-float-traps-masked (:invalid) + (ext:with-float-traps-masked (:invalid) (assert-true (ext:float-nan-p (kernel:%acos 2d0))) (assert-true (ext:float-nan-p (kernel:%acos -2d0)))))

@@ -205,7 +263,7 @@ (kernel:%asin 2d0)) (assert-error 'floating-point-invalid-operation (kernel:%asin -2d0)) - (kernel::with-float-traps-masked (:invalid) + (ext:with-float-traps-masked (:invalid) (assert-true (ext:float-nan-p (kernel:%asin 2d0))) (assert-true (ext:float-nan-p (kernel:%asin -2d0)))))

@@ -214,8 +272,20 @@ (assert-error 'floating-point-invalid-operation (kernel:%atan *snan*)) (assert-true (ext:float-nan-p (kernel:%atan *qnan*))) - (kernel::with-float-traps-masked (:invalid) - (assert-true (ext:float-nan-p (kernel:%atan *snan*))))) + (ext:with-float-traps-masked (:invalid) + (assert-true (ext:float-nan-p (kernel:%atan *snan*)))) + ;; atan(x) = x for |x| < 2^-29, signaling inexact. + (let ((x (scale-float 1d0 -30)) + (x0 0d0)) + (ext:with-float-traps-enabled (:inexact) + ;; This must not throw an inexact exception because the result + ;; is exact when the arg is 0. + (assert-eql 0d0 (kernel:%atan x0))) + (ext:with-float-traps-enabled (:inexact) + ;; This must throw an inexact exception for non-zero x even + ;; though the result is exactly x. + (assert-error 'floating-point-inexact + (kernel:%atan x)))))

(define-test %log10.exceptions (:tag :fdlibm) @@ -230,12 +300,12 @@ (assert-true (ext:float-nan-p (kernel:%log10 *qnan*))) (assert-equal ext:double-float-positive-infinity (kernel:%log10 ext:double-float-positive-infinity)) - (kernel::with-float-traps-masked (:divide-by-zero) + (ext:with-float-traps-masked (:divide-by-zero) (assert-equal ext:double-float-negative-infinity (kernel:%log10 0d0)) (assert-equal ext:double-float-negative-infinity (kernel:%log10 -0d0))) - (kernel::with-float-traps-masked (:invalid) + (ext:with-float-traps-masked (:invalid) (assert-true (ext:float-nan-p (kernel:%log10 -1d0)))))

(define-test %scalbn.exceptions @@ -259,10 +329,353 @@ (kernel:%scalbn most-positive-double-float 2)) (assert-error 'floating-point-overflow (kernel:%scalbn most-negative-double-float 2)) - (kernel::with-float-traps-masked (:overflow) + (ext:with-float-traps-masked (:overflow) (assert-equal ext:double-float-positive-infinity (kernel:%scalbn ext:double-float-positive-infinity 1)) (assert-equal ext:double-float-positive-infinity (kernel:%scalbn most-positive-double-float 2)) (assert-equal ext:double-float-negative-infinity (kernel:%scalbn most-negative-double-float 2)))) + +;;; These tests taken from github.com/rtoy/fdlibm-js +(define-test acosh-basic-tests + (:tag :fdlibm) + ;; acosh(1) = 0 + (assert-eql 0d0 (acosh 1d0)) + ;; acosh(1.5) = log((sqrt(5)+3)/2, case 1 < x < 2 + (assert-eql 0.9624236501192069d0 (acosh 1.5d0)) + ;; acosh(4) = log(sqrt(15)+4), case 2 < x < 2^28 + (assert-eql 2.0634370688955608d0 (acosh 4d0)) + ;; acosh(2^50), case 2^28 < x + (assert-eql 35.35050620855721d0 (acosh (scale-float 1d0 50))) + ;; No overflow for most positive + (assert-eql 710.4758600739439d0 (acosh most-positive-double-float))) + +(define-test asinh-basic-tests + (:tag :fdlibm) + (assert-eql -0d0 (asinh -0d0)) + (assert-eql 0d0 (asinh 0d0)) + (let ((x (scale-float 1d0 -29)) + (x0 0d0)) + ;; asinh(x) = x for x < 2^-28 + (assert-eql x (asinh x)) + (assert-eql (- x) (asinh (- x)))) + (let ((x (scale-float 1d0 -28))) + ;; Case 2 > |x| >= 2^-28 + (assert-eql 3.725290298461914d-9 (asinh x)) + (assert-eql -3.725290298461914d-9 (asinh (- x)))) + (let ((x 1d0)) + ;; Case 2 > |x| >= 2^-28 + (assert-eql 0.881373587019543d0 (asinh x)) + (assert-eql -0.881373587019543d0 (asinh (- x)))) + (let ((x 5d0)) + ;; Case 2^28 > |x| > 2 + (assert-eql 2.3124383412727525d0 (asinh x)) + (assert-eql -2.3124383412727525d0 (asinh (- x)))) + (let ((x (scale-float 1d0 28))) + ;; Case 2^28 > |x| + (assert-eql 20.101268236238415d0 (asinh x)) + (assert-eql -20.101268236238415d0 (asinh (- x)))) + (let ((x most-positive-double-float)) + ;; No overflow for most-positive-double-float + (assert-eql 710.4758600739439d0 (asinh x)) + (assert-eql -710.4758600739439d0 (asinh (- x))))) + +(define-test atanh-basic-tests + (:tag :fdlibm) + (assert-eql +0d0 (atanh +0d0)) + (assert-eql -0d0 (atanh -0d0)) + ;; atanh(x) = x, |x| < 2^-28 + (let ((x (scale-float 1d0 -29))) + (assert-eql x (atanh x)) + (assert-eql (- x) (atanh (- x)))) + ;; atanh(0.25) = log(5/3)/2, |x| < 0.5 + (let ((x 0.25d0)) + (assert-eql 0.25541281188299536d0 (atanh x)) + (assert-eql -0.25541281188299536d0 (atanh (- x))) + ;; There's no guarantee that atanh(1/4) = log(5/3)2 in floating + ;; point, but it's true in this case with fdlibm + (assert-eql (/ (log (float 5/3 1d0)) 2) (atanh x))) + ;; atanh(0.75) = log(7)/2, 0.5 < |x| < 1 + (let ((x 0.75d0)) + (assert-eql 0.9729550745276566d0 (atanh x)) + (assert-eql -0.9729550745276566d0 (atanh (- x))) + ;; There's no guarantee that atanh(3/4) = log(7)2 in floating + ;; point, but it's true in this case with fdlibm + (assert-eql (/ (log 7d0) 2) (atanh x)))) + +(define-test cosh-basic-tests + (:tag :fdlibm) + ;; cosh(2^-55) = 1, tiny x case + (let ((x (scale-float 1d0 -55))) + (assert-eql 1d0 (cosh x)) + (assert-eql 1d0 (cosh (- x)))) + ;; cosh(2^-55) = 1, tiny x case + (let ((x (scale-float 1d0 -56))) + (assert-eql 1d0 (cosh x)) + (assert-eql 1d0 (cosh (- x)))) + ;; cosh(log(2)/4) = (sqrt(2) + 1)/2^(5/4), case |x| < log(2)/2 + (let ((x (/ (log 2d0) 4))) + ;; This depends on (/ (log 2d0) 4) producing the value we really + ;; want as the arg. + (assert-eql 1.0150517651282178d0 (cosh x)) + (assert-eql 1.0150517651282178d0 (cosh (- x)))) + ;; cosh(10*log(2)) = 1048577/2048, case log(2)/2 < |x| < 22 + (let ((x (* 10 (log 2d0))) + (y (float 1048577/2048 1d0))) + (assert-eql y (cosh x)) + (assert-eql y (cosh (- x)))) + ;; cosh(32*log(2)), case 22 <= |x| < log(maxdouble) + (let ((x (* 32 (log 2d0)))) + (assert-eql 2.1474836479999983d9 (cosh x)) + (assert-eql 2.1474836479999983d9 (cosh (- x)))) + ;; cosh(710.4758600739439), case log(maxdouble) <= |x| <= overflowthreshold + (let ((x 710.4758600739439d0)) + (assert-eql 1.7976931348621744d308 (cosh x)) + (assert-eql 1.7976931348621744d308 (cosh (- x))))) + +(define-test exp-basic-tests + (:tag :fdlibm) + ;; No overflow and no underflow + (let ((x 709.7822265625d0)) + (assert-eql 1.7968190737295725d308 (exp x)) + (assert-eql 5.565390609552841d-309 (exp (- x)))) + ;; exp(7.09782712893383973096e+02), no overflow + (assert-eql 1.7976931348622732d308 (exp 7.09782712893383973096d+02)) + ;; exp(-7.45133219101941108420e+02), no underflow + (assert-eql 4.9406564584124654d-324 (exp -7.45133219101941108420d+02)) + ;; Overflow + (assert-error 'floating-point-overflow (exp 709.7827128933841d0)) + ;; Case |x| < 2^-28 + (let ((x (scale-float 1d0 -29))) + (assert-eql (+ 1 x) (exp x)) + (assert-eql (- 1 x) (exp (- x)))) + ;; exp(0.5), case log(2)/2 < |x| < 3/2*log(2) + (let ((x 0.5d0)) + (assert-eql 1.6487212707001282d0 (exp x)) + (assert-eql 0.6065306597126334d0 (exp (- x)))) + ;; exp(2), case |x| > 3/2*log(2) + (let ((x 2d0)) + (assert-eql 7.38905609893065d0 (exp x)) + (assert-eql 0.1353352832366127d0 (exp (- x)))) + ;; exp(2^-1022), case k < -1021 + (assert-eql 1d0 (exp (scale-float 1d0 -1022))) + ;; exp(2^-1021), case k >= -1021 + (assert-eql 1d0 (exp (scale-float 1d0 -1021))) + ;; exp(7.09782712893383973096e+02), no overflow + (assert-eql 1.7976931348622732d308 (exp 7.09782712893383973096d+02)) + ;; overflow + (assert-error 'floating-point-overflow (exp 709.7827128933841d0)) + ;; exp(-7.45133219101941108420e+02), no underflow + (assert-eql 4.9406564584124654d-324 (exp -745.1332191019411d0)) + ;; exp(-745.1332191019412), underflows + (assert-eql 0d0 (exp -745.1332191019412d0)) + ;; exp(1000) overflow + (assert-error 'floating-point-overflow (exp 1000d0)) + ;; exp(-1000) underflow + (assert-eql 0d0 (exp -1000d0))) + +(define-test log-basic-tests + (:tag :fdlibm) + (assert-eql 0d0 (log 1d0)) + (assert-eql 1d0 (log (exp 1d0))) + (assert-eql -1d0 (log (exp -1d0))) + (assert-eql 0.5d0 (log (sqrt (exp 1d0)))) + (assert-eql -0.5d0 (log (sqrt (exp -1d0)))) + ;; Test a denormal arg + (assert-eql -709.08956571282410d0 (log (scale-float 1d0 -1023))) + ;; Largest double value + (assert-eql 709.7827128933840d0 (log most-positive-double-float)) + ;; Tests case 0 < f < 2^-20, k = 0 + ;; log(1+2^-21) + (assert-eql 4.7683704451632344d-7 (log (+ 1 (scale-float 1d0 -21)))) + ;; Tests case 0 < f < 2^-20, k = 1 + ;; log(2 + 2^-20) + (assert-eql 0.6931476573969898d0 (log (+ 2(scale-float 1d0 -20)))) + (assert-eql 1.3862943611198906d0 (log 4d0)) + ;; Tests main path, i > 0, k = 0 + (assert-eql 0.3220828910287846d0 + (log (kernel:make-double-float (+ #x3ff00000 #x6147a) 0))) + ;; Tests main path, i > 0, k = 1 + (assert-eql 0.35065625373947773d0 + (log (kernel:make-double-float (+ #x3ff00000 #x6b851) 0))) + ;; Tests main path, i > 0, k = -1 + (assert-eql -0.3710642895311607d0 + (log (kernel:make-double-float (+ #x3fe00000 #x6147a) 0))) + ;; Tests main path, i < 0, k = 0 + (assert-eql 0.3220821999597803d0 + (log (kernel:make-double-float (+ #x3ff00000 #x61479) 0))) + ;; Tests main path, i < 0, k = 1 + (assert-eql 1.0152293805197257d0 + (log (kernel:make-double-float (+ #x40000000 #x61479) 0))) + ;; Tests main path, i < 0, k = -1 + (assert-eql -0.37106498060016496d0 + (log (kernel:make-double-float (+ #x3fe00000 #x61479) 0)))) + +(define-test log-consistency + (:tag :fdlibm) + ;; |log(x) + log(1/x)| < 1.77635684e-15, x = 1.2^k, 0 <= k < 2000 + ;; The threshold is experimentally determined + (let ((x 1d0) + (max-value -1d0)) + (declare (double-float max-value) + (type (double-float 1d0) x)) + (dotimes (k 2000) + (let ((y (abs (+ (log x) (log (/ x)))))) + (setf max-value (max max-value y)) + (setf x (* x 1.4d0)))) + (assert-true (< max-value 1.77635684d-15))) + ;; |exp(log(x)) - x|/x < 5.6766649d-14, x = 1.4^k, 0 <= k < 2000 + (let ((x 1d0) + (max-error 0d0)) + (declare (double-float max-error) + (type (double-float 1d0) x)) + (dotimes (k 2000) + (let ((y (abs (/ (- (exp (log x)) x) x)))) + (setf max-error (max max-error y)) + (setf x (* x 1.4d0)))) + (assert-true (< max-error 5.6766649d-14))) + ;; |exp(log(x)) - x|/x < 5.68410245d-14, x = 1.4^(-k), 0 <= k < 2000 + (let ((x 1d0) + (max-error 0d0)) + (declare (double-float max-error) + (type (double-float (0d0)) x)) + (dotimes (k 2000) + (let ((y (abs (/ (- (exp (log x)) x) x)))) + (setf max-error (max max-error y)) + (setf x (/ x 1.4d0)))) + (assert-true (< max-error 5.68410245d-14)))) + +(define-test sinh-basic-tests + (:tag :fdlibm) + (assert-eql +0d0 (sinh 0d0)) + (assert-eql -0d0 (sinh -0d0)) + ;; sinh(x) = x, |x| < 2^-28 + (let ((x (scale-float 1d0 -29))) + (assert-eql x (sinh x)) + (assert-eql (- x) (sinh (- x)))) + ;; case |x| < 1 + (assert-eql 0.5210953054937474d0 (sinh 0.5d0)) + (assert-eql -0.5210953054937474d0 (sinh -0.5d0)) + ;; sinh(10*log(2)) = 1048575/2048, case |x| < 22 + (let ((x (* 10 (log 2d0))) + (y (float 1048575/2048 1d0))) + (assert-eql y (sinh x)) + (assert-eql (- y) (sinh (- x)))) + ;; sinh(10), case |x| < 22 + (let ((y 11013.232874703393d0)) + (assert-eql y (sinh 10d0)) + (assert-eql (- y) (sinh -10d0))) + ;; sinh(32*log(2)), case |x| in [22, log(maxdouble)] + (let ((x (* 32 (log 2d0))) + (y 2.1474836479999983d9)) + (assert-eql y (sinh x)) + (assert-eql (- y) (sinh (- x)))) + ;; sinh(100), case |x| in [22, log(maxdouble)] + (let ((y 1.3440585709080678d43)) + (assert-eql y (sinh 100d0)) + (assert-eql (- y) (sinh -100d0))) + ;; sinh(710....), no overflow, case |x| in [log(maxdouble), overflowthreshold] + (let ((x 710.4758600739439d0) + (y 1.7976931348621744d308)) + (assert-eql y (sinh x)) + (assert-eql (- y) (sinh (- x)))) + ;; sinh(710.475860073944), overflow, case |x| > ovfthreshold] + (let ((x 710.475860073944d0)) + (assert-error 'floating-point-overflow (sinh x)) + (assert-error 'floating-point-overflow (sinh (- x)))) + (assert-error 'floating-point-overflow (sinh 1000d0)) + (assert-error 'floating-point-overflow (sinh -1000d0))) + +(define-test tanh-basic-tests + (:tag :fdlibm) + ;; case |x| < 2^-55 + (let ((x (scale-float 1d0 -56))) + (assert-eql x (tanh x)) + (assert-eql (- x) (tanh (- x)))) + ;; tanh(log(2)) = 3/5, case |x| < 1 + (let ((x (log 2d0)) + (y (float 3/5 1d0))) + (assert-eql y (tanh x)) + (assert-eql (- y) (tanh (- x)))) + ;; tanh(2*log(2)) = 15/17, case |x| < 22 + (let ((x (* 2 (log 2d0))) + (y (float 15/17 1d0))) + (assert-eql y (tanh x)) + (assert-eql (- y) (tanh (- x)))) + ;; tanh(100) = 1, case |x| > 22 + (assert-eql 1d0 (tanh 100d0)) + (assert-eql -1d0 (tanh -100d0)) + ;; tanh(1d300), no overflow + (assert-eql 1d0 (tanh most-positive-double-float)) + (assert-eql -1d0 (tanh (- most-positive-double-float)))) + +(define-test %asin-basic-tests + (:tag :fdlibm) + (let ((x (scale-float 1d0 -28)) + (x0 0d0)) + ;; asin(x) = x for |x| < 2^-27, with inexact exception if x is not 0. + (assert-eql x (kernel:%asin x)) + (assert-eql (- x) (kernel:%asin (- x))))) + +(define-test %asin-exception + (:tag :fdlibm) + (let ((x (scale-float 1d0 -28)) + (x0 0d0)) + ;; asin(x) = x for |x| < 2^-27, with inexact exception if x is not 0. + (assert-eql x (kernel:%asin x)) + (assert-eql (- x) (kernel:%asin (- x))) + (ext:with-float-traps-enabled (:inexact) + ;; This must not throw an inexact exception because the result + ;; is exact when the arg is 0. + (assert-eql 0d0 (kernel:%asin x0))) + (ext:with-float-traps-enabled (:inexact) + ;; This must throw an inexact exception for non-zero x even + ;; though the result is exactly x. + (assert-error 'floating-point-inexact + (kernel:%asin x))))) + +(define-test %cos.exceptions + (:tag :fdlibm) + ;; cos(x) = 1 for |x| < 2^-27. Signal inexact unless x = 0 + (let ((x (scale-float 1d0 -28)) + (x0 0d0)) + (ext:with-float-traps-enabled (:inexact) + ;; This must not throw an inexact exception because the result + ;; is exact when the arg is 0. + (assert-eql 1d0 (kernel:%cos x0))) + (ext:with-float-traps-enabled (:inexact) + ;; This must throw an inexact exception for non-zero x even + ;; though the result is exactly x. + (assert-error 'floating-point-inexact + (kernel:%cos x))))) + +(define-test %sin.exceptions + (:tag :fdlibm) + ;; sin(x) = x for |x| < 2^-27. Signal inexact unless x = 0 + (let ((x (scale-float 1d0 -28)) + (x0 0d0)) + (ext:with-float-traps-enabled (:inexact) + ;; This must not throw an inexact exception because the result + ;; is exact when the arg is 0. + (assert-eql 0d0 (kernel:%sin x0))) + (ext:with-float-traps-enabled (:inexact) + ;; This must throw an inexact exception for non-zero x even + ;; though the result is exactly x. + (assert-error 'floating-point-inexact + (kernel:%sin x))))) + +(define-test %tan.exceptions + (:tag :fdlibm) + ;; tan(x) = x for |x| < 2^-28. Signal inexact unless x = 0 + (let ((x (scale-float 1d0 -29)) + (x0 0d0)) + (ext:with-float-traps-enabled (:inexact) + ;; This must not throw an inexact exception because the result + ;; is exact when the arg is 0. + (assert-eql 0d0 (kernel:%tan x0))) + (ext:with-float-traps-enabled (:inexact) + ;; This must throw an inexact exception for non-zero x even + ;; though the result is exactly x. + (assert-error 'floating-point-inexact + (kernel:%tan x)))))

Huge diff. To prevent performance issues it was hidden

View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/compare/275011da14a17167d5c039047...