cmucl-cvs December 2017

cmucl-cvs@common-lisp.net

1 participants
31 discussions

[Git][cmucl/cmucl][sparc64-dev] 123 commits: Initial version.
by Raymond Toy 30 Dec '17

30 Dec '17

Raymond Toy pushed to branch sparc64-dev at cmucl / cmucl Commits: 6eca756b by Raymond Toy at 2016-10-06T19:24:46-07:00 Initial version. - - - - - 45a6d985 by Raymond Toy at 2016-10-06T20:05:12-07:00 Download cmucl binaries. - - - - - 7383a39c by Raymond Toy at 2016-10-06T20:07:13-07:00 Use correct syntax - - - - - 8296f92f by Raymond Toy at 2016-10-06T20:08:24-07:00 Add test job - - - - - 2830e140 by Raymond Toy at 2017-08-26T21:53:36-07:00 Print more info for dynamic space lossage If we get dynamic space lossage, print out the actual address and the expected addresses for the dynamic space so we can see what happened. This is really useful if you change the dynamic space address but didn't update everything correctly. - - - - - c40b7a6b by Raymond Toy at 2017-08-29T10:38:13-07:00 Fix #40: Move start of heap space higher This is a workaround for issue #40. By moving the start of the heap to a higher address, we can still run on older systems (albeit with reduced max heap size), and run on newer systesm where the C code is now mapped at or overlapping the (old) heap start. Arbitrarily choose 0x60000000 as a compromise. This also requires moving the foreign linkage start to a different address because the old address overlaps the new C area. Ideally, we could fix this if we could map the heap wherever the OS wants to put it, but we're not there yet. Use boot-2017-04.lisp to bootstrap this change from the 2017-04 snapshot. - - - - - 48f8ebb9 by Raymond Toy at 2017-08-29T10:54:21-07:00 Add handler-bind to auto restart Changing defconstant's signal an error. Add a handler-bind to restart and continue with the changed values. - - - - - aba0bc5c by Raymond Toy at 2017-08-29T10:56:15-07:00 Rename to boot-2017-04-1.lisp - - - - - dbf7c0af by Raymond Toy at 2017-08-29T18:31:19+00:00 Merge branch 'rtoy-fix-40-map-heap-higher' into 'master' Fix #40: Move start of heap space higher Closes #40 See merge request !21 - - - - - 3b4f3977 by Raymond Toy at 2017-08-30T21:21:56-07:00 Fix compiler warning about else Add braces around the else clause that's indented as if it were part of the else clause. Inspection of the algorithm indicates that this is probably the intended code and in this case doesn't change what gets executed because the following statements would have been anyway. Also verified a few random values that `(asin x)` and `(asin (float x 1w0))` produce the same values. Only need to test 2^-27 <= x < 0.5. - - - - - 9c2dccfb by Raymond Toy at 2017-08-31T19:52:00-07:00 Merge branch 'master' into rtoy-gitlab-ci - - - - - cd429e9f by Raymond Toy at 2017-09-02T13:15:29-07:00 Use wget instead of curl - - - - - 0a87366f by Raymond Toy at 2017-09-02T13:25:43-07:00 Install wget - - - - - 5c92a00f by Raymond Toy at 2017-09-02T13:28:51-07:00 Install bzip2 so we can untar the cmucl tarballs - - - - - 92f8697e by Raymond Toy at 2017-09-02T13:33:56-07:00 More setup for building cmucl - untar the snapshot into the snapshot directory - git clone the cmucl repo - - - - - bcd2a53b by Raymond Toy at 2017-09-02T13:35:52-07:00 Use the correct paths when untarring. - - - - - 760d9c6d by Raymond Toy at 2017-09-02T13:38:01-07:00 Need to install git. While we're at it install make, gcc, and gcc 32-bit. - - - - - 373aaa60 by Raymond Toy at 2017-09-02T13:43:43-07:00 Build cmucl and run tests Update snapshot to 2017-04 snapshot too. - - - - - 3f6fd3df by Raymond Toy at 2017-09-02T13:47:20-07:00 Oops. Use correct tarball names - - - - - 119a7980 by Raymond Toy at 2017-09-02T13:53:35-07:00 Add some debugging stuff. - Print out the SHELL - Set prompt to include PWD - Where is `time` and why can't the shell find it? - - - - - 38a3f48e by Raymond Toy at 2017-09-02T14:01:45-07:00 More debugging to see what we have - - - - - 745ad37b by Raymond Toy at 2017-09-02T14:06:26-07:00 Don't need to do a git clone; install /usr/bin/time too. The runner already has the git repo checked out at $PWD, so we're ready to go. Try to install time so build.sh will run. - - - - - 7bdf20d1 by Raymond Toy at 2017-09-02T14:09:34-07:00 Use correct path to the snapshot build - - - - - 15a4c0f5 by Raymond Toy at 2017-09-02T14:59:47-07:00 Need to install bc Needed to update lisp/version. - - - - - 4312fc44 by Raymond Toy at 2017-09-03T04:55:21+00:00 Add pipeline status to readme - - - - - b53bfd60 by Raymond Toy at 2017-09-02T21:56:52-07:00 Merge branch 'master' into rtoy-gitlab-ci - - - - - 7bc8b28c by Raymond Toy at 2017-09-03T05:10:25+00:00 Use correct pipeline marker for gitlab-ci branch - - - - - 24ed6116 by Raymond Toy at 2017-09-03T09:16:07-07:00 More testing of CI - Don't need to install git anymore - exit early from build script to see if that makes the test fail. - - - - - 9b8d5fc4 by Raymond Toy at 2017-09-03T09:24:18-07:00 Remove debugging stuff and early exit - Early exit (with non-zero exit code) does cause the pipeline to fail, as expected. - - - - - 3d227b6b by Raymond Toy at 2017-09-03T09:50:28-07:00 Install git (again) While not strictly necessary, make-dist.sh uses git to determine a default lisp-implmenetation-version. We could just use -V to do that, but I think it's best to have git so that the pipeline looks as much like normal development as possible. - - - - - c3d967c1 by Raymond Toy at 2017-09-05T20:40:19-07:00 Make test fail to see how pipeline works. - - - - - ea868e0f by Raymond Toy at 2017-09-05T20:54:33-07:00 Revert change. The failed test causes the pipeline to fail, as expected. - - - - - 37d69509 by Raymond Toy at 2017-09-06T04:05:12+00:00 Merge branch 'rtoy-gitlab-ci' into 'master' Enable gitlab continuous integration See merge request !22 - - - - - 4acd1d80 by Raymond Toy at 2017-09-05T21:30:11-07:00 Point pipeline status to the master branch. Was pointing to the rtoy-gitlab-ci branch, but we want this to be the status of the master branch. - - - - - f05cb10a by Raymond Toy at 2017-09-08T20:38:41-07:00 Fix #41: Report proper process status The main problem is that we weren't calling wait3 with WCONTINUED so that we would be signaled when the process continues. And we also need to check that result of wait call was WCONTINUED> Replace the wait3 routine with a C routine (prog_status) so we don't have to deal with the OS-specific flags. This function basically returns what the lisp function wait3 did. Use this function in GET-PROCESSES-STATUS-CHANGES. - runprog.c: - Add prog_status - run-program.lisp: - Use prog_status instead of wait3 - issues.lisp: - Add basic test - - - - - 65ce358d by Raymond Toy at 2017-09-15T22:50:47-07:00 Fix up minor issues in implementation - process-alive-p should return T for continued processes - Simplify prog-status slightly by making the status code array start :signaled instead of nil. - Update prog_status with enum to specify the codes to make it clearer what they mean and to make it clearer that it matches the expectations in prog-status. - - - - - 99ebe80c by Raymond Toy at 2017-09-16T21:02:40+00:00 Merge branch 'rtoy-fix-issue-41' into 'master' Fix #41: Report proper process status Closes #41 See merge request !23 - - - - - 81e08ecb by Raymond Toy at 2017-09-16T14:49:33-07:00 Clean up prog_status - If `waidpid` returns 0 or -1, we should return. - Make the fprintf message a bit clearer on what's happening when we have some kind of status that we didn't handle. - - - - - e1f12db9 by Raymond Toy at 2017-09-16T14:54:10-07:00 Remove wait3 stuff `wait3` is removed along with alien routine and the constants. - - - - - ec29ec51 by Raymond Toy at 2017-09-16T15:23:32-07:00 Fix #44: Add docstrings for process accessors Adds docstrings for the exported process accessors: `process-pid`, `process-exit-code`, `process-core-dumped`, `process-pty`, `process-input`, `process-output`, `process-error`, `process-status-hook`, `process-plist`. - - - - - f99b8125 by Raymond Toy at 2017-09-16T23:29:58+00:00 Merge branch 'rtoy-fix-44-add-docstrings-process' into 'master' Fix #44: Add docstrings for process accessors Closes #44 See merge request !24 - - - - - 7f3040a7 by Raymond Toy at 2017-09-16T16:36:54-07:00 Regenerate do to new docstrings - - - - - 39dff2ee by Raymond Toy at 2017-09-23T10:27:44-07:00 Update from logs - - - - - 12018284 by Raymond Toy at 2017-09-30T13:51:23-07:00 Fix #45: Handle relative paths in `run-program` This is basically the solution proposed by Elias Pipping with a few minor tweaks. - In `run-program`, don't merge `program` with the "path:" search-list. `spawn` will handle this. - In `spawn`, if the first call to execve fails, instead of trying "/bin/sh", use "/usr/bin/env" which will use the user's PATH if necessary to find the program. - - - - - 3665075a by Raymond Toy at 2017-09-30T14:18:55-07:00 Add test for issue #45 Add the tests given in issue #45. - - - - - 00689a63 by Raymond Toy at 2017-09-30T14:20:44-07:00 Ignore test directory needed for issue.45 test - - - - - d2efe772 by Raymond Toy at 2017-09-30T14:21:03-07:00 Regenerated - - - - - ba357de8 by Raymond Toy at 2017-09-30T21:31:16+00:00 Merge branch 'rtoy-fix-45-run-program-paths' into 'master' Fix #45 :Handle relative paths in `run-program` Closes #45 See merge request cmucl/cmucl!25 - - - - - aba5f454 by Raymond Toy at 2017-10-07T09:00:19-07:00 Update to ASDF version 3.3.0 - - - - - 706a62ce by Raymond Toy at 2017-10-07T13:59:30-07:00 Regenerate piglatin translations [ci skip] - - - - - fffafb5a by Raymond Toy at 2017-10-07T14:02:06-07:00 Note that the included asdf version is 3.3.0 [ci skip] - - - - - a5662d50 by Raymond Toy at 2017-10-07T14:54:00-07:00 Rename stdin/stdout/stderr to proc_* Because we include stdio.h now, Solaris defines stdin, stdout, and stderr in a way that they can't be used to name the args to the spawn function. Hence rename these args. - - - - - a368558e by Raymond Toy at 2017-10-08T15:17:59-07:00 Move defsystem for pcl-tests to its own file. The upgrade to ASDF 3.3.0 broke the pcl-tests; this version doesn't like having the defsystem in the same file. Thus, move the defsystem to its own file and load it up in pcl.lisp (via require). - - - - - 70bdb7b9 by Raymond Toy at 2017-10-10T21:39:19-07:00 Update paths for snapshot-2017-10 Download the 2017-10 binaries and update build.sh options to build with this snapshot. - - - - - e32c4479 by Raymond Toy at 2017-10-15T10:04:15-07:00 Release 21c Use `-B boot-21c` to bootstrap the release from 21b to 21c. - 21b/boot-21c.lisp: - Add boot-21c.lisp to update the version number - compiler/byte-comp.lisp - Update the actual version number - - - - - 6217c780 by Raymond Toy at 2017-10-15T10:05:41-07:00 Add -B flag to bootstrap the release number change - - - - - 1fd413e3 by Raymond Toy at 2017-10-15T10:05:55-07:00 Remove WIP. - - - - - e1aa8483 by Raymond Toy at 2017-10-15T10:08:19-07:00 Add release-21d.md release notes. - - - - - d3856cfb by Raymond Toy at 2017-10-15T20:24:48-07:00 Rename release-21c.txt to .md. - - - - - c8de8f63 by Raymond Toy at 2017-10-15T20:26:19-07:00 Add some additional markup. * Strike out the closed tickets * Color (maybe?) the WIP in red. - - - - - e8764af3 by Raymond Toy at 2017-10-15T20:29:35-07:00 More markup. - - - - - dca5c95f by Raymond Toy at 2017-10-15T20:35:40-07:00 More markdown changes - - - - - 4c0780dc by Raymond Toy at 2017-10-16T03:49:14+00:00 Merge branch 'rtoy-convert-release-notes-to-md' into 'master' Convert release-21c.txt to md file See merge request cmucl/cmucl!26 - - - - - 48afbb09 by Raymond Toy at 2017-10-27T21:00:48-07:00 Merge branch 'master' into 21c-branch - - - - - 9f2679a6 by Raymond Toy at 2017-10-27T21:03:02-07:00 Remove WIP and fix typo. - - - - - 9697034f by Raymond Toy at 2017-10-27T21:03:30-07:00 Fix up markdown markup - - - - - e87e8196 by Raymond Toy at 2017-10-28T15:32:21+00:00 Merge branch '21c-branch' into 'master' 21c branch See merge request cmucl/cmucl!27 - - - - - 66bc460b by Raymond Toy at 2017-11-03T10:04:36-07:00 Download the 21c release for CI - - - - - 4bb76458 by Raymond Toy at 2017-11-04T09:21:05-07:00 Set tag for linux These commands currently only work on linux. Set a tag to see if this works to enable the linux runner. - - - - - 087c0b7c by Raymond Toy at 2017-11-04T09:26:51-07:00 Fix syntax errors. Validated via ci lint. - - - - - c7a93905 by Raymond Toy at 2017-11-04T09:33:20-07:00 Set up stages Let's see how that goes. - - - - - 0de37607 by Raymond Toy at 2017-11-04T09:41:02-07:00 Put everything in one job with a linux tag. - - - - - b660ef49 by Raymond Toy at 2017-11-04T14:19:22-07:00 Add osx support. - - - - - f6d1282d by Raymond Toy at 2017-11-04T14:42:56-07:00 OSX: Download binaries and build. - - - - - 951e9c14 by Raymond Toy at 2017-11-04T15:18:57-07:00 Run tests on osx for real - - - - - fa6eae8e by Raymond Toy at 2017-11-04T16:24:23-07:00 Merge branch 'master' into rtoy-rework-ci # Conflicts: # .gitlab-ci.yml - - - - - de68cb52 by Raymond Toy at 2017-11-05T00:05:04+00:00 Merge branch 'rtoy-rework-ci' into 'master' Update CI to support linux and osx runners See merge request cmucl/cmucl!28 - - - - - 8ac7e849 by Raymond Toy at 2017-11-04T21:31:06-07:00 Increase buffer size to prevent writing past the end The char buffer size is potentially too small and it's possible to write past the end of the buffer with a large integer. Fixes a compiler warning. - - - - - 4abbe215 by Raymond Toy at 2017-11-04T21:33:00-07:00 Fix indentation to make scoping clearer. Compiler warns that indentation makes the scope of the for loop unclear. Indent the code to make it clear. - - - - - 42192ed3 by Raymond Toy at 2017-11-15T21:06:19-08:00 Update to asdf 3.3.1 - - - - - 3ed48010 by Raymond Toy at 2017-11-15T21:18:47-08:00 Add asdf 3.3.1 docs [skip-ci] - - - - - cf370246 by Raymond Toy at 2017-12-02T09:43:57-08:00 Update release notes - - - - - 9bba906a by Raymond Toy at 2017-12-14T19:31:56-08:00 Initial support for xoroshiro128+ RNG Not yet integrated but the basic vop and other methods do work and produce the same output as the reference C code (not included). - - - - - b119b34f by Raymond Toy at 2017-12-15T09:00:38-08:00 Initial implementation of xoroshiro rng Not yet tested or integrated. - - - - - 8707116f by Raymond Toy at 2017-12-15T15:40:08-08:00 Random cleanups and updates Make some things work on x86: * Can create a random state and initialize it to the desired state * xoroshiro-chunk produces the correct values for the first few calls - - - - - eea11e07 by Raymond Toy at 2017-12-15T15:41:13-08:00 Compile and load xoroshiro rng Make xoroshiro rng available in the core. Basic things work on x86 but not yet integrated in anyway. - - - - - 192fe3b6 by Raymond Toy at 2017-12-16T08:16:46-08:00 Simplify state Don't need an array for the cached value; (unsigned-byte 32) is a specialized structure slot, so no consing. Some random cleanups and comments. - - - - - c62e3467 by Raymond Toy at 2017-12-16T08:17:24-08:00 Add tests for xoroshiro generator - - - - - edcbb7d3 by Raymond Toy at 2017-12-16T20:53:21-08:00 Test portable version of xoroshiro-next - - - - - 95a01145 by Raymond Toy at 2017-12-16T21:05:41-08:00 Put back the original version, optimized for x86. - - - - - d539b6a0 by Raymond Toy at 2017-12-17T13:04:59-08:00 Define xoroshiro-next before xoroshiro-chunk. - - - - - dbc0518d by Raymond Toy at 2017-12-18T21:02:39-08:00 Fix typos add jump function * Fix typos in names so we can call the functions. * Add jump function to allow generating new distinct sequences. * Add simple function to print the state using integers instead of doubles. (Untested.) - - - - - 0b94ee3d by Raymond Toy at 2017-12-19T09:02:25-08:00 Add custom xoro-random-state printer Custom printer to print the state as array of integers instead of doubles. Makes it easier to see and match what the C code does. - - - - - f9203f85 by Raymond Toy at 2017-12-19T10:04:50-08:00 Print and set state as 64-bit integers The xoroshiro128+ algorithm is defined using uint64_t types, but we hack it to store the state as double-float's. This is a bit confusing, so add a printer to print the state as an array of two uint64_t's. Adjust init-xoro-state to allow initializing the state using an array of 2 64-bit ints. - - - - - 09bbc248 by Raymond Toy at 2017-12-19T17:32:05-08:00 Add cross-compile scripts for building xoroshiro128+. - - - - - 38db18cb by Raymond Toy at 2017-12-19T17:33:27-08:00 Set version 21c now. Bootstrap files are from 21c directory instead of 21b. - - - - - cba9bad7 by Raymond Toy at 2017-12-19T17:34:28-08:00 Update xoroshiro methods to standard names - - - - - 8d363473 by Raymond Toy at 2017-12-19T17:35:19-08:00 Make random-mt19937 function only when :random-mt19937 is set - - - - - 7362e561 by Raymond Toy at 2017-12-19T17:35:41-08:00 Disable some deftransforms for now - - - - - 68596489 by Raymond Toy at 2017-12-19T17:36:27-08:00 Add rand-xoroshiro to the build files Compile/load rand-xoroshiro if :random-xoroshiro is a feature. - - - - - b8d326cc by Raymond Toy at 2017-12-19T17:46:39-08:00 Update CI to do the required cross-compile - - - - - f5df8745 by Raymond Toy at 2017-12-19T18:18:23-08:00 Update tests to match xoroshiro implementation. - - - - - be17d9f4 by Raymond Toy at 2017-12-19T19:01:35-08:00 Conditionalize on random-xoroshiro. These tests test the actual implementation details of the xoroshiro128+ generator, so conditionalize it for this generator. - - - - - 0c2284a7 by Raymond Toy at 2017-12-19T19:03:21-08:00 Add cross script for sparc This changes the RNG to xoroshiro128+ for sparc. - - - - - 4720c794 by Raymond Toy at 2017-12-19T19:03:27-08:00 Add comment - - - - - 5ca98fb1 by Raymond Toy at 2017-12-20T13:59:20-08:00 Add documentation and inline xoroshiro-gen Not sure about inlining that; it makes random-chunk bigger and all callers of random-chunk bigger too. Nice speed win, however. A test of generating 50000000 single-float values shows xoroshiro128+ takes 0.58 sec vs 0.98 using MT19937 on my machine. - - - - - 96c90caf by Raymond Toy at 2017-12-20T14:00:25-08:00 Remove old stuff; conditionalize on :random-xoroshiro - - - - - 9cd66071 by Raymond Toy at 2017-12-20T16:30:41-08:00 Document the jump function and add test. * rand-xoroshiro.lisp: * Rename xoroshiro-jump to random-state-jump * Add documentation/comments. * tests/rng.lisp * Add tests for the RNG jump function. - - - - - 96c58393 by Raymond Toy at 2017-12-27T09:46:59-08:00 Modify random-state-jump to use 32-bit ints Break the constants in the jump function into 32-bit chunks so we operate on 32-bit integers instead of 64-bit integers. This is a minor optimization. - - - - - ab6d2c6a by Raymond Toy at 2017-12-27T10:29:26-08:00 Fix compiler warning in VEC-INIT-XORO-STATE Set default value for state in VEC-INIT-XORO-STATE. If not given, initialize it to the correct array. - - - - - 164cf685 by Raymond Toy at 2017-12-27T12:17:25-08:00 Implement vop for xoroshiro-next Not yet working. Cross-compile works and generates appropriate code, but can't rebuild lisp using the cross-compiled lisp. - - - - - 757fb170 by Raymond Toy at 2017-12-27T15:25:08-08:00 Remove extra trailing unmatched parenthesis - - - - - 6fbd959e by Raymond Toy at 2017-12-28T09:04:13-08:00 Fix logic mistakes in sparc xoroshiro impl Also compute the array offsets just once so we're consistent between loading and storing. - - - - - 11a14537 by Raymond Toy at 2017-12-28T09:04:27-08:00 Export random-state-jump - - - - - 448e9970 by Raymond Toy at 2017-12-28T09:53:39-08:00 Use the xoroshiro vop on sparc The vop greatly speeds up the generator on sparc. The time to generate 10,000,000 single-floats (on a 1 GHz Ultrasparc 3i) is: mt19937: 1.32 sec xoroshiro: 1.03 sec So xoroshiro is 22% faster than mt19937. - - - - - 58f107b1 by Raymond Toy at 2017-12-28T12:26:31-08:00 Print random state in hex Add comment for %random-double-float to use xoroshiro-gen directly instead of random-chunk twice. A minor micro optimization. - - - - - 86599903 by Raymond Toy at 2017-12-28T19:53:42-08:00 Add comments. - - - - - 562752c0 by Raymond Toy at 2017-12-28T19:54:11-08:00 Regenerated from sources - - - - - e5bd7ef7 by Raymond Toy at 2017-12-29T08:57:34-08:00 Fix typo in reader conditional. Don't use the portable xoroshiro-gen on x86 and sparc! - - - - - d8ef7876 by Raymond Toy at 2017-12-29T10:20:13-08:00 Update release notes - - - - - fb3f58ea by Raymond Toy at 2017-12-29T18:32:07+00:00 Merge branch 'rtoy-xoro-default' into 'master' Change random number generator from MT19937 to xoroshiro128+ Closes #48 See merge request cmucl/cmucl!29 - - - - - 395af224 by Raymond Toy at 2017-12-29T15:57:59-08:00 RANDOM should do the same as the deftransform would do. Make RANDOM compute the value the same way as the deftransform would do when the arg is a 32-bit integer. The deftransform is still currently disabled for random-xoroshiro, though. - - - - - 65bcf797 by Raymond Toy at 2017-12-29T22:20:37-08:00 Merge branch 'master' into sparc64-dev - - - - - 30 changed files: - .gitignore - + .gitlab-ci.yml - README.md - bin/build.sh - bin/run-tests.sh - + src/bootfiles/21b/boot-2017-04-1.lisp - + src/bootfiles/21b/boot-21c.lisp - + src/bootfiles/21c/boot-21c-cross-sparc.lisp - + src/bootfiles/21c/boot-21c-cross-x86.lisp - + src/bootfiles/21c/boot-21c-cross.lisp - src/code/commandline.lisp - src/code/exports.lisp - + src/code/rand-xoroshiro.lisp - src/code/run-program.lisp - src/code/x86-vm.lisp - src/compiler/byte-comp.lisp - src/compiler/float-tran.lisp - src/compiler/sparc/arith.lisp - src/compiler/x86/arith.lisp - src/compiler/x86/insts.lisp - src/compiler/x86/parms.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-21c.txt → src/general-info/release-21c.md - + src/general-info/release-21d.md - src/i18n/locale/cmucl.pot - src/i18n/locale/en(a)piglatin/LC_MESSAGES/cmucl.po - src/i18n/locale/ko/LC_MESSAGES/cmucl.po The diff was not included because it is too large. View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/compare/3e1e87d391fab3f26f2e38ae… --- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/compare/3e1e87d391fab3f26f2e38ae… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][master] RANDOM should do the same as the deftransform would do.
by Raymond Toy 30 Dec '17

30 Dec '17

Raymond Toy pushed to branch master at cmucl / cmucl Commits: 395af224 by Raymond Toy at 2017-12-29T15:57:59-08:00 RANDOM should do the same as the deftransform would do. Make RANDOM compute the value the same way as the deftransform would do when the arg is a 32-bit integer. The deftransform is still currently disabled for random-xoroshiro, though. - - - - - 1 changed file: - src/code/rand-xoroshiro.lisp Changes: ===================================== src/code/rand-xoroshiro.lisp ===================================== --- a/src/code/rand-xoroshiro.lisp +++ b/src/code/rand-xoroshiro.lisp @@ -474,8 +474,11 @@ (declare (inline %random-single-float %random-double-float)) (cond ((typep arg '(integer 1 #x100000000)) - ;; Let the compiler deftransform take care of this case. - (%random-integer arg state)) + ;; Do the same thing as the deftransform would do. + (if (= arg (expt 2 32)) + (random-chunk state) + (values (bignum::%multiply (random-chunk state) + arg)))) ((and (typep arg 'single-float) (> arg 0.0F0)) (%random-single-float arg state)) ((and (typep arg 'double-float) (> arg 0.0D0)) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/395af2246b028691a323c1fcb… --- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/395af2246b028691a323c1fcb… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][rtoy-make-double-unsigned] Update MAKE-DOUBLE-FLOAT vop for unsigned
by Raymond Toy 29 Dec '17

29 Dec '17

Raymond Toy pushed to branch rtoy-make-double-unsigned at cmucl / cmucl Commits: f3dee356 by Raymond Toy at 2017-12-29T14:35:37-08:00 Update MAKE-DOUBLE-FLOAT vop for unsigned Update vop for sparc and ppc to accept unsigned first arg instead of signed, like on x86, allowing MAKE-DOUBLE-FLOAT to support both signed and unsigned 32-bit integers (for the first arg). - - - - - 2 changed files: - src/compiler/ppc/float.lisp - src/compiler/sparc/float.lisp Changes: ===================================== src/compiler/ppc/float.lisp ===================================== --- a/src/compiler/ppc/float.lisp +++ b/src/compiler/ppc/float.lisp @@ -733,12 +733,12 @@ (* (tn-offset res) vm:word-bytes))))))))) (define-vop (make-double-float) - (:args (hi-bits :scs (signed-reg)) + (:args (hi-bits :scs (unsigned-reg)) (lo-bits :scs (unsigned-reg))) (:results (res :scs (double-reg) :load-if (not (sc-is res double-stack)))) (:temporary (:scs (double-stack)) temp) - (:arg-types signed-num unsigned-num) + (:arg-types unsigned-num unsigned-num) (:result-types double-float) (:translate make-double-float) (:policy :fast-safe) ===================================== src/compiler/sparc/float.lisp ===================================== --- a/src/compiler/sparc/float.lisp +++ b/src/compiler/sparc/float.lisp @@ -1297,12 +1297,12 @@ (* (tn-offset res) vm:word-bytes))))))))) (define-vop (make-double-float) - (:args (hi-bits :scs (signed-reg)) + (:args (hi-bits :scs (unsigned-reg)) (lo-bits :scs (unsigned-reg))) (:results (res :scs (double-reg) :load-if (not (sc-is res double-stack)))) (:temporary (:scs (double-stack)) temp) - (:arg-types signed-num unsigned-num) + (:arg-types unsigned-num unsigned-num) (:result-types double-float) (:translate make-double-float) (:policy :fast-safe) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/f3dee356f056915accbb5f22a… --- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/f3dee356f056915accbb5f22a… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl] Pushed new branch rtoy-make-double-unsigned
by Raymond Toy 29 Dec '17

29 Dec '17

Raymond Toy pushed new branch rtoy-make-double-unsigned at cmucl / cmucl --- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/tree/rtoy-make-double-unsigned You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][master] 38 commits: Initial support for xoroshiro128+ RNG
by Raymond Toy 29 Dec '17

29 Dec '17

Raymond Toy pushed to branch master at cmucl / cmucl Commits: 9bba906a by Raymond Toy at 2017-12-14T19:31:56-08:00 Initial support for xoroshiro128+ RNG Not yet integrated but the basic vop and other methods do work and produce the same output as the reference C code (not included). - - - - - b119b34f by Raymond Toy at 2017-12-15T09:00:38-08:00 Initial implementation of xoroshiro rng Not yet tested or integrated. - - - - - 8707116f by Raymond Toy at 2017-12-15T15:40:08-08:00 Random cleanups and updates Make some things work on x86: * Can create a random state and initialize it to the desired state * xoroshiro-chunk produces the correct values for the first few calls - - - - - eea11e07 by Raymond Toy at 2017-12-15T15:41:13-08:00 Compile and load xoroshiro rng Make xoroshiro rng available in the core. Basic things work on x86 but not yet integrated in anyway. - - - - - 192fe3b6 by Raymond Toy at 2017-12-16T08:16:46-08:00 Simplify state Don't need an array for the cached value; (unsigned-byte 32) is a specialized structure slot, so no consing. Some random cleanups and comments. - - - - - c62e3467 by Raymond Toy at 2017-12-16T08:17:24-08:00 Add tests for xoroshiro generator - - - - - edcbb7d3 by Raymond Toy at 2017-12-16T20:53:21-08:00 Test portable version of xoroshiro-next - - - - - 95a01145 by Raymond Toy at 2017-12-16T21:05:41-08:00 Put back the original version, optimized for x86. - - - - - d539b6a0 by Raymond Toy at 2017-12-17T13:04:59-08:00 Define xoroshiro-next before xoroshiro-chunk. - - - - - dbc0518d by Raymond Toy at 2017-12-18T21:02:39-08:00 Fix typos add jump function * Fix typos in names so we can call the functions. * Add jump function to allow generating new distinct sequences. * Add simple function to print the state using integers instead of doubles. (Untested.) - - - - - 0b94ee3d by Raymond Toy at 2017-12-19T09:02:25-08:00 Add custom xoro-random-state printer Custom printer to print the state as array of integers instead of doubles. Makes it easier to see and match what the C code does. - - - - - f9203f85 by Raymond Toy at 2017-12-19T10:04:50-08:00 Print and set state as 64-bit integers The xoroshiro128+ algorithm is defined using uint64_t types, but we hack it to store the state as double-float's. This is a bit confusing, so add a printer to print the state as an array of two uint64_t's. Adjust init-xoro-state to allow initializing the state using an array of 2 64-bit ints. - - - - - 09bbc248 by Raymond Toy at 2017-12-19T17:32:05-08:00 Add cross-compile scripts for building xoroshiro128+. - - - - - 38db18cb by Raymond Toy at 2017-12-19T17:33:27-08:00 Set version 21c now. Bootstrap files are from 21c directory instead of 21b. - - - - - cba9bad7 by Raymond Toy at 2017-12-19T17:34:28-08:00 Update xoroshiro methods to standard names - - - - - 8d363473 by Raymond Toy at 2017-12-19T17:35:19-08:00 Make random-mt19937 function only when :random-mt19937 is set - - - - - 7362e561 by Raymond Toy at 2017-12-19T17:35:41-08:00 Disable some deftransforms for now - - - - - 68596489 by Raymond Toy at 2017-12-19T17:36:27-08:00 Add rand-xoroshiro to the build files Compile/load rand-xoroshiro if :random-xoroshiro is a feature. - - - - - b8d326cc by Raymond Toy at 2017-12-19T17:46:39-08:00 Update CI to do the required cross-compile - - - - - f5df8745 by Raymond Toy at 2017-12-19T18:18:23-08:00 Update tests to match xoroshiro implementation. - - - - - be17d9f4 by Raymond Toy at 2017-12-19T19:01:35-08:00 Conditionalize on random-xoroshiro. These tests test the actual implementation details of the xoroshiro128+ generator, so conditionalize it for this generator. - - - - - 0c2284a7 by Raymond Toy at 2017-12-19T19:03:21-08:00 Add cross script for sparc This changes the RNG to xoroshiro128+ for sparc. - - - - - 4720c794 by Raymond Toy at 2017-12-19T19:03:27-08:00 Add comment - - - - - 5ca98fb1 by Raymond Toy at 2017-12-20T13:59:20-08:00 Add documentation and inline xoroshiro-gen Not sure about inlining that; it makes random-chunk bigger and all callers of random-chunk bigger too. Nice speed win, however. A test of generating 50000000 single-float values shows xoroshiro128+ takes 0.58 sec vs 0.98 using MT19937 on my machine. - - - - - 96c90caf by Raymond Toy at 2017-12-20T14:00:25-08:00 Remove old stuff; conditionalize on :random-xoroshiro - - - - - 9cd66071 by Raymond Toy at 2017-12-20T16:30:41-08:00 Document the jump function and add test. * rand-xoroshiro.lisp: * Rename xoroshiro-jump to random-state-jump * Add documentation/comments. * tests/rng.lisp * Add tests for the RNG jump function. - - - - - 96c58393 by Raymond Toy at 2017-12-27T09:46:59-08:00 Modify random-state-jump to use 32-bit ints Break the constants in the jump function into 32-bit chunks so we operate on 32-bit integers instead of 64-bit integers. This is a minor optimization. - - - - - ab6d2c6a by Raymond Toy at 2017-12-27T10:29:26-08:00 Fix compiler warning in VEC-INIT-XORO-STATE Set default value for state in VEC-INIT-XORO-STATE. If not given, initialize it to the correct array. - - - - - 164cf685 by Raymond Toy at 2017-12-27T12:17:25-08:00 Implement vop for xoroshiro-next Not yet working. Cross-compile works and generates appropriate code, but can't rebuild lisp using the cross-compiled lisp. - - - - - 6fbd959e by Raymond Toy at 2017-12-28T09:04:13-08:00 Fix logic mistakes in sparc xoroshiro impl Also compute the array offsets just once so we're consistent between loading and storing. - - - - - 11a14537 by Raymond Toy at 2017-12-28T09:04:27-08:00 Export random-state-jump - - - - - 448e9970 by Raymond Toy at 2017-12-28T09:53:39-08:00 Use the xoroshiro vop on sparc The vop greatly speeds up the generator on sparc. The time to generate 10,000,000 single-floats (on a 1 GHz Ultrasparc 3i) is: mt19937: 1.32 sec xoroshiro: 1.03 sec So xoroshiro is 22% faster than mt19937. - - - - - 58f107b1 by Raymond Toy at 2017-12-28T12:26:31-08:00 Print random state in hex Add comment for %random-double-float to use xoroshiro-gen directly instead of random-chunk twice. A minor micro optimization. - - - - - 86599903 by Raymond Toy at 2017-12-28T19:53:42-08:00 Add comments. - - - - - 562752c0 by Raymond Toy at 2017-12-28T19:54:11-08:00 Regenerated from sources - - - - - e5bd7ef7 by Raymond Toy at 2017-12-29T08:57:34-08:00 Fix typo in reader conditional. Don't use the portable xoroshiro-gen on x86 and sparc! - - - - - d8ef7876 by Raymond Toy at 2017-12-29T10:20:13-08:00 Update release notes - - - - - fb3f58ea by Raymond Toy at 2017-12-29T18:32:07+00:00 Merge branch 'rtoy-xoro-default' into 'master' Change random number generator from MT19937 to xoroshiro128+ Closes #48 See merge request cmucl/cmucl!29 - - - - - 18 changed files: - .gitlab-ci.yml - bin/build.sh - + src/bootfiles/21c/boot-21c-cross-sparc.lisp - + src/bootfiles/21c/boot-21c-cross-x86.lisp - + src/bootfiles/21c/boot-21c-cross.lisp - src/code/exports.lisp - + src/code/rand-xoroshiro.lisp - src/code/x86-vm.lisp - src/compiler/float-tran.lisp - src/compiler/sparc/arith.lisp - src/compiler/x86/arith.lisp - src/compiler/x86/insts.lisp - src/general-info/release-21d.md - src/i18n/locale/cmucl.pot - src/tools/worldbuild.lisp - src/tools/worldcom.lisp - src/tools/worldload.lisp - + tests/rng.lisp Changes: ===================================== .gitlab-ci.yml ===================================== --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -8,7 +8,10 @@ linux-runner: - mkdir snapshot - (cd snapshot; tar xjf ../cmucl-21c-x86-linux.tar.bz2; tar xjf ../cmucl-21c-x86-linux.extra.tar.bz2) script: - - bin/build.sh -C "" -o ./snapshot/bin/lisp + - bin/create-target.sh xtarget x86_linux x86 + - bin/create-target.sh xcross x86_linux x86 + - bin/cross-build-world.sh -crl xtarget xcross src/bootfiles/21c/boot-21c-cross.lisp ./snapshot/bin/lisp + - bin/build.sh -C "" -o xtarget/lisp/lisp - bin/make-dist.sh -I dist linux-4 - bin/run-tests.sh -l dist/bin/lisp 2>&1 | tee test.log @@ -20,6 +23,9 @@ osx-runner: - mkdir snapshot - (cd snapshot; tar xjf ../cmucl-21c-x86-darwin.tar.bz2) script: - - bin/build.sh -C "" -o ./snapshot/bin/lisp + - bin/create-target.sh xtarget x86_darwin + - bin/create-target.sh xcross x86_darwin + - bin/cross-build-world.sh -crl xtarget xcross src/bootfiles/21c/boot-21c-cross.lisp ./snapshot/bin/lisp + - bin/build.sh -C "" -o xtarget/lisp/lisp - bin/make-dist.sh -I dist darwin-4 - bin/run-tests.sh -l dist/bin/lisp 2>&1 | tee test.log ===================================== bin/build.sh ===================================== --- a/bin/build.sh +++ b/bin/build.sh @@ -39,7 +39,7 @@ ENABLE2="yes" ENABLE3="yes" ENABLE4="yes" -version=21b +version=21c SRCDIR=src BINDIR=bin TOOLDIR=$BINDIR ===================================== src/bootfiles/21c/boot-21c-cross-sparc.lisp ===================================== --- /dev/null +++ b/src/bootfiles/21c/boot-21c-cross-sparc.lisp @@ -0,0 +1,237 @@ +(in-package :cl-user) + +;;; Rename the SPARC package and backend so that new-backend does the +;;; right thing. +(rename-package "SPARC" "OLD-SPARC" '("OLD-VM")) +(setf (c:backend-name c:*native-backend*) "OLD-SPARC") + +(c::new-backend "SPARC" + ;; Features to add here + '(:sparc + :sparc-v9 ; For Ultrasparc processors + :complex-fp-vops ; Some slightly faster FP vops on complex numbers + :linkage-table + :stack-checking ; Throw error if we run out of stack + :heap-overflow-check ; Throw error if we run out of + ; heap (This requires gencgc!) + :gencgc ; Generational GC + :relative-package-names ; Relative package names from Allegro + :conservative-float-type + :hash-new + :random-xoroshiro ; xoroshiro128+ RNG + :cmu ; Announce this is CMUCL + :cmu20 :cmu20a ; Current version identifier + :modular-arith ; Modular arithmetic + :double-double ; Double-double float support + ) + ;; Features to remove from current *features* here + '(:sparc-v8 :sparc-v7 ; Choose only one of :sparc-v7, :sparc-v8, :sparc-v9 + ;; Other architectures we aren't using. + :x86 :x86-bootstrap + :alpha :osf1 :mips + ;; Really old stuff that should have been removed long ago. + :propagate-fun-type :propagate-float-type :constrain-float-type + ;; Other OSes were not using + :openbsd :freebsd :glibc2 :linux + :pentium + :long-float + :new-random + :random-mt19937 ; MT-19937 generator + :small)) + +;;; May need to add some symbols to *features* and +;;; sys::*runtime-features* as well. This might be needed even if we +;;; have those listed above, because of the code checks for things in +;;; *features* and not in the backend-features.. So do that here. + + +;;; Extern-alien-name for the new backend. +(in-package :vm) +(defun extern-alien-name (name) + (declare (type simple-string name)) + #+(and bsd (not elf)) + (concatenate 'string "_" name) + #-(and bsd (not elf)) + name) +;; When compiling the compiler, vm:fixup-code-object and +;; vm:sanctify-for-execution are undefined. Import these to get rid +;; of that error. +(import 'old-vm::fixup-code-object) +(import 'old-vm::sanctify-for-execution) +(export 'extern-alien-name) +(export 'fixup-code-object) +(export 'sanctify-for-execution) + +(in-package :cl-user) + +;;; Compile the new backend. +(pushnew :bootstrap *features*) +(pushnew :building-cross-compiler *features*) +(load "target:tools/comcom") + +;;; Load the new backend. +(setf (search-list "c:") + '("target:compiler/")) +(setf (search-list "vm:") + '("c:sparc/" "c:generic/")) +(setf (search-list "assem:") + '("target:assembly/" "target:assembly/sparc/")) + +;; Load the backend of the compiler. + +(in-package "C") + +(load "vm:vm-macs") +(load "vm:parms") +(load "vm:objdef") +(load "vm:interr") +(load "assem:support") + +(load "target:compiler/srctran") +(load "vm:vm-typetran") +(load "target:compiler/float-tran") +(load "target:compiler/saptran") + +(load "vm:macros") +(load "vm:utils") + +(load "vm:vm") +(load "vm:insts") +(load "vm:primtype") +(load "vm:move") +(load "vm:sap") +(load "vm:system") +(load "vm:char") +(load "vm:float") + +(load "vm:memory") +(load "vm:static-fn") +(load "vm:arith") +(load "vm:cell") +(load "vm:subprim") +(load "vm:debug") +(load "vm:c-call") +(load "vm:print") +(load "vm:alloc") +(load "vm:call") +(load "vm:nlx") +(load "vm:values") +(load "vm:array") +(load "vm:pred") +(load "vm:type-vops") + +(load "assem:assem-rtns") + +(load "assem:array") +(load "assem:arith") +(load "assem:alloc") + +(load "c:pseudo-vops") + +(check-move-function-consistency) + +(load "vm:new-genesis") + +;;; OK, the cross compiler backend is loaded. + +(setf *features* (remove :building-cross-compiler *features*)) + +;;; Info environment hacks. +(macrolet ((frob (&rest syms) + `(progn ,@(mapcar #'(lambda (sym) + `(defconstant ,sym + (symbol-value + (find-symbol ,(symbol-name sym) + :vm)))) + syms)))) + (frob OLD-VM:BYTE-BITS OLD-VM:WORD-BITS + OLD-VM:CHAR-BITS + OLD-VM:CHAR-BYTES + OLD-VM:LOWTAG-BITS + #+long-float OLD-VM:SIMPLE-ARRAY-LONG-FLOAT-TYPE + OLD-VM:SIMPLE-ARRAY-DOUBLE-FLOAT-TYPE + OLD-VM:SIMPLE-ARRAY-SINGLE-FLOAT-TYPE + #+long-float OLD-VM:SIMPLE-ARRAY-COMPLEX-LONG-FLOAT-TYPE + OLD-VM:SIMPLE-ARRAY-COMPLEX-DOUBLE-FLOAT-TYPE + OLD-VM:SIMPLE-ARRAY-COMPLEX-SINGLE-FLOAT-TYPE + OLD-VM:SIMPLE-ARRAY-UNSIGNED-BYTE-2-TYPE + OLD-VM:SIMPLE-ARRAY-UNSIGNED-BYTE-4-TYPE + OLD-VM:SIMPLE-ARRAY-UNSIGNED-BYTE-8-TYPE + OLD-VM:SIMPLE-ARRAY-UNSIGNED-BYTE-16-TYPE + OLD-VM:SIMPLE-ARRAY-UNSIGNED-BYTE-32-TYPE + OLD-VM:SIMPLE-ARRAY-SIGNED-BYTE-8-TYPE + OLD-VM:SIMPLE-ARRAY-SIGNED-BYTE-16-TYPE + OLD-VM:SIMPLE-ARRAY-SIGNED-BYTE-30-TYPE + OLD-VM:SIMPLE-ARRAY-SIGNED-BYTE-32-TYPE + OLD-VM:SIMPLE-BIT-VECTOR-TYPE + OLD-VM:SIMPLE-STRING-TYPE OLD-VM:SIMPLE-VECTOR-TYPE + OLD-VM:SIMPLE-ARRAY-TYPE OLD-VM:VECTOR-DATA-OFFSET + OLD-VM:DOUBLE-FLOAT-DIGITS + old-vm:single-float-digits + OLD-VM:DOUBLE-FLOAT-EXPONENT-BYTE + OLD-VM:DOUBLE-FLOAT-NORMAL-EXPONENT-MAX + OLD-VM:DOUBLE-FLOAT-SIGNIFICAND-BYTE + OLD-VM:SINGLE-FLOAT-EXPONENT-BYTE + OLD-VM:SINGLE-FLOAT-NORMAL-EXPONENT-MAX + OLD-VM:SINGLE-FLOAT-SIGNIFICAND-BYTE + ) + #+double-double + (frob OLD-VM:SIMPLE-ARRAY-COMPLEX-DOUBLE-DOUBLE-FLOAT-TYPE + OLD-VM:SIMPLE-ARRAY-DOUBLE-DOUBLE-FLOAT-TYPE) + ) + +;; Modular arith hacks. When cross-compiling, the compiler wants to +;; constant-fold some stuff, and it needs the following functions to +;; do so. This just gets rid of the hundreds of errors that happen. +(setf (fdefinition 'vm::ash-left-mod32) #'old-vm::ash-left-mod32) +(setf (fdefinition 'vm::lognot-mod32) #'old-vm::lognot-mod32) +;; End modular arith hacks + +(let ((function (symbol-function 'kernel:error-number-or-lose))) + (let ((*info-environment* (c:backend-info-environment c:*target-backend*))) + (setf (symbol-function 'kernel:error-number-or-lose) function) + (setf (info function kind 'kernel:error-number-or-lose) :function) + (setf (info function where-from 'kernel:error-number-or-lose) :defined))) + +(defun fix-class (name) + (let* ((new-value (find-class name)) + (new-layout (kernel::%class-layout new-value)) + (new-cell (kernel::find-class-cell name)) + (*info-environment* (c:backend-info-environment c:*target-backend*))) + (remhash name kernel::*forward-referenced-layouts*) + (kernel::%note-type-defined name) + (setf (info type kind name) :instance) + (setf (info type class name) new-cell) + (setf (info type compiler-layout name) new-layout) + new-value)) +(fix-class 'c::vop-parse) +(fix-class 'c::operand-parse) + +#+random-mt19937 +(declaim (notinline kernel:random-chunk)) + +(setf c:*backend* c:*target-backend*) + +;;; Extern-alien-name for the new backend. +(in-package :vm) +(defun extern-alien-name (name) + (declare (type simple-string name)) + name) +(export 'extern-alien-name) +(export 'fixup-code-object) +(export 'sanctify-for-execution) +(in-package :cl-user) + +;;; Don't load compiler parts from the target compilation + +(defparameter *load-stuff* nil) + +;; Sometimes during cross-compile sparc::any-reg isn't defined during +;; cross-compile. +;; +;; hack, hack, hack: Make old-vm::any-reg the same as +;; sparc::any-reg as an SC. Do this by adding old-vm::any-reg +;; to the hash table with the same value as sparc::any-reg. +(let ((ht (c::backend-sc-names c::*target-backend*))) + (setf (gethash 'old-vm::any-reg ht) + (gethash 'vm::any-reg ht))) ===================================== src/bootfiles/21c/boot-21c-cross-x86.lisp ===================================== --- /dev/null +++ b/src/bootfiles/21c/boot-21c-cross-x86.lisp @@ -0,0 +1,225 @@ +;; Basic cross-compile script for cross-compiling from x86 to x86. +;; May require tweaking for more difficult cross-compiles. + +(in-package :cl-user) + +;;; Rename the X86 package and backend so that new-backend does the +;;; right thing. +(rename-package "X86" "OLD-X86" '("OLD-VM")) +(setf (c:backend-name c:*native-backend*) "OLD-X86") + +(c::new-backend "X86" + ;; Features to add here. These are just examples. You may not + ;; need to list anything here. We list them here anyway as a + ;; record of typical features for all x86 ports. + '(:x86 :i486 :pentium + :stack-checking ; Catches stack overflow + :heap-overflow-check ; Catches heap overflows + :relative-package-names ; relative package names + :mp ; multiprocessing + :gencgc ; Generational GC + :conservative-float-type + :hash-new + :random-xoroshiro ; xoroshiro128+ RNG + :cmu :cmu20 :cmu20a ; Version features + :double-double ; double-double float support + ) + ;; Features to remove from current *features* here. Normally don't + ;; need to list anything here unless you are trying to remove a + ;; feature. + '(:x86-bootstrap + ;; :alpha :osf1 :mips + :propagate-fun-type :propagate-float-type :constrain-float-type + ;; :openbsd :freebsd :glibc2 :linux + :long-float :new-random :small + :random-mt19937)) + +;;; Compile the new backend. +(pushnew :bootstrap *features*) +(pushnew :building-cross-compiler *features*) + +;; Make fixup-code-object and sanctify-for-execution in the VM package +;; be the same as the original. Needed to get rid of a compiler error +;; in generic/core.lisp. (This halts cross-compilations if the +;; compiling lisp uses the -batch flag. +(import 'old-vm::fixup-code-object "VM") +(import 'old-vm::sanctify-for-execution "VM") +(export 'vm::fixup-code-object "VM") +(export 'vm::sanctify-for-execution "VM") + +(do-external-symbols (sym "OLD-VM") + (export (intern (symbol-name sym) "VM") "VM")) + +(load "target:tools/comcom") + +;;; Load the new backend. +(setf (search-list "c:") + '("target:compiler/")) +(setf (search-list "vm:") + '("c:x86/" "c:generic/")) +(setf (search-list "assem:") + '("target:assembly/" "target:assembly/x86/")) + +;; Load the backend of the compiler. + +(in-package "C") + +(load "vm:vm-macs") +(load "vm:parms") +(load "vm:objdef") +(load "vm:interr") +(load "assem:support") + +(load "target:compiler/srctran") +(load "vm:vm-typetran") +(load "target:compiler/float-tran") +(load "target:compiler/saptran") + +(load "vm:macros") +(load "vm:utils") + +(load "vm:vm") +(load "vm:insts") +(load "vm:primtype") +(load "vm:move") +(load "vm:sap") +(when (target-featurep :sse2) + (load "vm:sse2-sap")) +(load "vm:system") +(load "vm:char") +(if (target-featurep :sse2) + (load "vm:float-sse2") + (load "vm:float")) + +(load "vm:memory") +(load "vm:static-fn") +(load "vm:arith") +(load "vm:cell") +(load "vm:subprim") +(load "vm:debug") +(load "vm:c-call") +(if (target-featurep :sse2) + (load "vm:sse2-c-call") + (load "vm:x87-c-call")) + +(load "vm:print") +(load "vm:alloc") +(load "vm:call") +(load "vm:nlx") +(load "vm:values") +;; These need to be loaded before array because array wants to use +;; some vops as templates. +(load (if (target-featurep :sse2) + "vm:sse2-array" + "vm:x87-array")) +(load "vm:array") +(load "vm:pred") +(load "vm:type-vops") + +(load "assem:assem-rtns") + +(load "assem:array") +(load "assem:arith") +(load "assem:alloc") + +(load "c:pseudo-vops") + +(check-move-function-consistency) + +(load "vm:new-genesis") + +;;; OK, the cross compiler backend is loaded. + +(setf *features* (remove :building-cross-compiler *features*)) + +;;; Info environment hacks. +(macrolet ((frob (&rest syms) + `(progn ,@(mapcar #'(lambda (sym) + `(defconstant ,sym + (symbol-value + (find-symbol ,(symbol-name sym) + :vm)))) + syms)))) + (frob OLD-VM:BYTE-BITS OLD-VM:WORD-BITS + OLD-VM:CHAR-BITS + OLD-VM:CHAR-BYTES + #+long-float OLD-VM:SIMPLE-ARRAY-LONG-FLOAT-TYPE + OLD-VM:SIMPLE-ARRAY-DOUBLE-FLOAT-TYPE + OLD-VM:SIMPLE-ARRAY-SINGLE-FLOAT-TYPE + #+long-float OLD-VM:SIMPLE-ARRAY-COMPLEX-LONG-FLOAT-TYPE + OLD-VM:SIMPLE-ARRAY-COMPLEX-DOUBLE-FLOAT-TYPE + OLD-VM:SIMPLE-ARRAY-COMPLEX-SINGLE-FLOAT-TYPE + OLD-VM:SIMPLE-ARRAY-UNSIGNED-BYTE-2-TYPE + OLD-VM:SIMPLE-ARRAY-UNSIGNED-BYTE-4-TYPE + OLD-VM:SIMPLE-ARRAY-UNSIGNED-BYTE-8-TYPE + OLD-VM:SIMPLE-ARRAY-UNSIGNED-BYTE-16-TYPE + OLD-VM:SIMPLE-ARRAY-UNSIGNED-BYTE-32-TYPE + OLD-VM:SIMPLE-ARRAY-SIGNED-BYTE-8-TYPE + OLD-VM:SIMPLE-ARRAY-SIGNED-BYTE-16-TYPE + OLD-VM:SIMPLE-ARRAY-SIGNED-BYTE-30-TYPE + OLD-VM:SIMPLE-ARRAY-SIGNED-BYTE-32-TYPE + OLD-VM:SIMPLE-BIT-VECTOR-TYPE + OLD-VM:SIMPLE-STRING-TYPE OLD-VM:SIMPLE-VECTOR-TYPE + OLD-VM:SIMPLE-ARRAY-TYPE OLD-VM:VECTOR-DATA-OFFSET + OLD-VM:DOUBLE-FLOAT-EXPONENT-BYTE + OLD-VM:DOUBLE-FLOAT-NORMAL-EXPONENT-MAX + OLD-VM:DOUBLE-FLOAT-SIGNIFICAND-BYTE + OLD-VM:SINGLE-FLOAT-EXPONENT-BYTE + OLD-VM:SINGLE-FLOAT-NORMAL-EXPONENT-MAX + OLD-VM:SINGLE-FLOAT-SIGNIFICAND-BYTE + ) + #+double-double + (frob OLD-VM:SIMPLE-ARRAY-COMPLEX-DOUBLE-DOUBLE-FLOAT-TYPE + OLD-VM:SIMPLE-ARRAY-DOUBLE-DOUBLE-FLOAT-TYPE)) + +;; Modular arith hacks +(setf (fdefinition 'vm::ash-left-mod32) #'old-vm::ash-left-mod32) +(setf (fdefinition 'vm::lognot-mod32) #'old-vm::lognot-mod32) +;; End arith hacks + +(let ((function (symbol-function 'kernel:error-number-or-lose))) + (let ((*info-environment* (c:backend-info-environment c:*target-backend*))) + (setf (symbol-function 'kernel:error-number-or-lose) function) + (setf (info function kind 'kernel:error-number-or-lose) :function) + (setf (info function where-from 'kernel:error-number-or-lose) :defined))) + +(defun fix-class (name) + (let* ((new-value (find-class name)) + (new-layout (kernel::%class-layout new-value)) + (new-cell (kernel::find-class-cell name)) + (*info-environment* (c:backend-info-environment c:*target-backend*))) + (remhash name kernel::*forward-referenced-layouts*) + (kernel::%note-type-defined name) + (setf (info type kind name) :instance) + (setf (info type class name) new-cell) + (setf (info type compiler-layout name) new-layout) + new-value)) +(fix-class 'c::vop-parse) +(fix-class 'c::operand-parse) + +#+random-mt19937 +(declaim (notinline kernel:random-chunk)) + +(setf c:*backend* c:*target-backend*) + +;;; Extern-alien-name for the new backend. +(in-package :vm) +(defun extern-alien-name (name) + (declare (type simple-string name)) + #-elf + (concatenate 'simple-string "_" name) + #+elf + name) +(export 'extern-alien-name) +(in-package :cl-user) + +;;; Don't load compiler parts from the target compilation + +(defparameter *load-stuff* nil) + +;; hack, hack, hack: Make old-vm::any-reg the same as +;; x86::any-reg as an SC. Do this by adding old-vm::any-reg +;; to the hash table with the same value as x86::any-reg. +(let ((ht (c::backend-sc-names c::*target-backend*))) + (setf (gethash 'old-vm::any-reg ht) + (gethash 'vm::any-reg ht))) ===================================== src/bootfiles/21c/boot-21c-cross.lisp ===================================== --- /dev/null +++ b/src/bootfiles/21c/boot-21c-cross.lisp @@ -0,0 +1,13 @@ +;; Cross-compile script to change the default random number generator +;; from MT19937 to xoroshiro128+. + +;; The cross-script is basically the default platform script, but we +;; remove :random-mt19937 and add :random-xoroshiro to the backend +;; features. + +#+x86 +(load "src/bootfiles/21c/boot-21c-cross-x86.lisp") + +#+sparc +(load "src/bootfiles/21c/boot-21c-cross-sparc.lisp") + ===================================== src/code/exports.lisp ===================================== --- a/src/code/exports.lisp +++ b/src/code/exports.lisp @@ -2550,7 +2550,9 @@ "SIMPLE-ARRAY-COMPLEX-DOUBLE-DOUBLE-FLOAT-P" "OBJECT-NOT-SIMPLE-ARRAY-COMPLEX-DOUBLE-DOUBLE-FLOAT-ERROR" "DD-PI" - "INVALID-CASE")) + "INVALID-CASE") + #+random-xoroshiro + (:export "RANDOM-STATE-JUMP")) (dolist (name ===================================== src/code/rand-xoroshiro.lisp ===================================== --- /dev/null +++ b/src/code/rand-xoroshiro.lisp @@ -0,0 +1,534 @@ +;;; -*- Mode: Lisp; Package: Kernel -*- +;;; +;;; ********************************************************************** +;;; This code was written as part of CMU Common Lisp and has been +;;; placed in the public domain, and is provided 'as is'. +;;; +(ext:file-comment + "$Header: src/code/rand-xoroshiro.lisp $") + +;;; +;;; ********************************************************************** +;;; +;;; Support for the xoroshiro128+ random number generator by David +;;; Blackman and Sebastiano Vigna (vigna(a)acm.org). See +;;; http://xoroshiro.di.unimi.it/. + +(in-package "LISP") +(intl:textdomain "cmucl") + +(export '(random-state random-state-p random *random-state* + make-random-state)) + +(in-package "KERNEL") +(export '(%random-single-float %random-double-float random-chunk init-random-state + random-state-jump)) + +(sys:register-lisp-feature :random-xoroshiro) + + +;;;; Random state hackery: + +;; Generate a random seed that can be used for seeding the generator. +;; If /dev/urandom is available, it is used to generate random data as +;; the seed. Otherwise, the current time is used as the seed. +(defun generate-seed (&optional (nwords 1)) + ;; On some systems (as reported by Ole Rohne on cmucl-imp), + ;; /dev/urandom isn't what we think it is, so if it doesn't work, + ;; silently generate the seed from the current time. + (or (ignore-errors + (let ((words (make-array nwords :element-type '(unsigned-byte 32)))) + (with-open-file (rand "/dev/urandom" + :direction :input + :element-type '(unsigned-byte 32)) + (read-sequence words rand)) + (if (= nwords 1) + (aref words 0) + (let ((vec (make-array (floor nwords 2) :element-type '(unsigned-byte 64)))) + (do ((k 0 (+ k 1)) + (j 0 (+ j 2))) + ((>= k (length vec)) + vec) + (setf (aref vec k) + (logior (ash (aref words j) 32) + (aref words (+ j 1))))))))) + (logand (get-universal-time) #xffffffff))) + +(defun int-init-xoro-state (&optional (seed 5772156649015328606) state) + (let ((state (or state (make-array 2 :element-type 'double-float))) + (splitmix-state (ldb (byte 64 0) seed))) + (flet ((splitmix64 () + ;; See http://xoroshiro.di.unimi.it/splitmix64.c for the + ;; definitive reference. The basic algorithm, where x is + ;; the 64-bit state of the generator, is: + ;; + ;; uint64_t z = (x += 0x9e3779b97f4a7c15); + ;; z = (z ^ (z >> 30)) * 0xbf58476d1ce4e5b9; + ;; z = (z ^ (z >> 27)) * 0x94d049bb133111eb; + ;; return z ^ (z >> 31); + ;; + ;; This is only used occasionally for initializing the + ;; RNG, so this is a very straight-forward + ;; implementation. + (let ((z (setf splitmix-state + (ldb (byte 64 0) (+ splitmix-state #x9e3779b97f4a7c15))))) + (declare (type (unsigned-byte 64) z)) + (setf z (ldb (byte 64 0) + (* (logxor z (ash z -30)) + #xbf58476d1ce4e5b9))) + (setf z (ldb (byte 64 0) + (* (logxor z (ash z -27)) + #x94d049bb133111eb))) + (logxor z (ash z -31)))) + (make-double (x) + (let ((lo (ldb (byte 32 0) x)) + (hi (ldb (byte 32 32) x))) + (kernel:make-double-float + (if (< hi #x80000000) + hi + (- hi #x100000000)) + lo)))) + (let* ((s0 (splitmix64)) + (s1 (splitmix64))) + (setf (aref state 0) (make-double s0) + (aref state 1) (make-double s1)) + state)))) + +;; Initialize from an array. The KEY is a 2-element array of unsigned +;; 64-bit integers. The state is set to the given 64-bit integer +;; values. +(defun vec-init-xoro-state (key &optional (state (make-array 2 :element-type 'double-float))) + (declare (type (array (unsigned-byte 64) (2)) key) + (type (simple-array double-float (2)) state)) + (flet ((make-double (x) + (declare (type (unsigned-byte 64) x)) + (let ((hi (ldb (byte 32 32) x)) + (lo (ldb (byte 32 0) x))) + (kernel:make-double-float + (if (< hi #x80000000) + hi + (- hi #x100000000)) + lo)))) + (setf (aref state 0) (make-double (aref key 0)) + (aref state 1) (make-double (aref key 1))) + state)) + +;; The default seed is the digits of Euler's constant, 0.5772.... +(defun init-random-state (&optional (seed 5772156649015328606) state) + _N"Generate an random state vector from the given SEED. The seed can be + either an integer or a vector of (unsigned-byte 64)" + (declare (type (or null integer + (array (unsigned-byte 64) (*))) + seed)) + (let ((state (or state (make-array 2 :element-type 'double-float)))) + (etypecase seed + (integer + (int-init-xoro-state (ldb (byte 64 0) seed) state)) + ((array (unsigned-byte 64) (2)) + (vec-init-xoro-state seed state))))) + +(defstruct (random-state + (:constructor make-random-object) + (:print-function %print-xoro-state) + (:make-load-form-fun :just-dump-it-normally)) + ;; The state of the RNG. The actual algorithm uses 2 64-bit words + ;; of state. To reduce consing, we use an array of double-float's + ;; since a double-float is 64 bits long. At no point do we operate + ;; on these as floats; they're just convenient objects to hold the + ;; state we need. + (state (init-random-state) + :type (simple-array double-float (2))) + ;; The generator produces 64-bit results. We separate the 64-bit + ;; result into two parts. One is returned and the other is cached + ;; here for later use. + (rand 0 :type (unsigned-byte 32)) + ;; Indicates if RAND holds a valid value. If NIL, we need to + ;; generate a new 64-bit result. + (cached-p nil :type (member t nil))) + +(defun %print-xoro-state (rng-state stream depth) + (declare (ignore depth)) + ;; Basically the same as the default structure printer, but we want + ;; to print the state as an array of integers instead of doubles, + ;; because it's a bit confusing to see the state as doubles. + (let ((state (random-state-state rng-state))) + (pprint-logical-block (stream nil :prefix "#S(" :suffix ")") + (prin1 'random-state stream) + (write-char #\space stream) + (pprint-indent :block 2 stream) + (pprint-newline :linear stream) + (prin1 :state stream) + (write-char #\space stream) + (pprint-newline :miser stream) + (pprint-logical-block (stream nil :prefix "#.(" :suffix ")") + (prin1 'init-random-state stream) + (write-char #\space stream) + (flet ((c (x) + (multiple-value-bind (hi lo) + (double-float-bits x) + (logior (ash (ldb (byte 32 0) hi) 32) + lo)))) + (write (make-array 2 :element-type '(unsigned-byte 64) + :initial-contents (list (c (aref state 0)) + (c (aref state 1)))) + :stream stream + :base 16 + :radix t))) + (write-char #\space stream) + (pprint-newline :linear stream) + + (prin1 :rand stream) + (write-char #\space stream) + (pprint-newline :miser stream) + (prin1 (random-state-rand rng-state) stream) + (write-char #\space stream) + (pprint-newline :linear stream) + + (prin1 :cached-p stream) + (write-char #\space stream) + (pprint-newline :miser stream) + (prin1 (random-state-cached-p rng-state) stream)))) + +(defvar *random-state* + (make-random-object)) + +(defun make-random-state (&optional state) + _N"Make a random state object. If STATE is not supplied, return a copy + of the default random state. If STATE is a random state, then return a + copy of it. If STATE is T then return a random state generated from + the universal time or /dev/urandom if available." + (flet ((copy-random-state (state) + (let ((old-state (random-state-state state)) + (new-state + (make-array 2 :element-type 'double-float))) + (setf (aref new-state 0) (aref old-state 0)) + (setf (aref new-state 1) (aref old-state 1)) + (make-random-object :state new-state + :rand (random-state-rand state) + :cached-p (random-state-cached-p state))))) + (cond ((not state) + (copy-random-state *random-state*)) + ((random-state-p state) + (copy-random-state state)) + ((eq state t) + (make-random-object :state (init-random-state (generate-seed 4)) + :rand 0 + :cached-p nil)) + (t + (error _"Argument is not a RANDOM-STATE, T, or NIL: ~S" state))))) + +(defun rand-initializer () + (init-random-state (generate-seed) + (random-state-state *random-state*))) + +(pushnew 'rand-initializer ext:*after-save-initializations*) + +;;;; Random entries: + +;; Sparc and x86 have vops to implement xoroshiro-gen that are much +;; faster than the portable lisp version. Use them. +#+(or x86 sparc) +(declaim (inline xoroshiro-gen)) +#+(or x86 sparc) +(defun xoroshiro-gen (state) + (declare (type (simple-array double-float (2)) state) + (optimize (speed 3) (safety 0))) + (vm::xoroshiro-next state)) + +#-(or x86 sparc) +(defun xoroshiro-gen (state) + (declare (type (simple-array double-float (2)) state) + (optimize (speed 3) (safety 0))) + ;; Portable implementation of the xoroshiro128+ generator. See + ;; http://xoroshiro.di.unimi.it/xoroshiro128plus.c for the + ;; definitive definition. + ;; + ;; uint64_t s[2]; + ;; + ;; static inline uint64_t rotl(const uint64_t x, int k) { + ;; return (x << k) | (x >> (64 - k)); + ;; } + ;; + ;; uint64_t next(void) { + ;; const uint64_t s0 = s[0]; + ;; uint64_t s1 = s[1]; + ;; const uint64_t result = s0 + s1; + ;; + ;; s1 ^= s0; + ;; s[0] = rotl(s0, 55) ^ s1 ^ (s1 << 14); // a, b + ;; s[1] = rotl(s1, 36); // c + ;; + ;; return result; + ;; } + ;; + (flet ((rotl-55 (x1 x0) + ;; Rotate [x1|x0] left 55 bits, returning the result as two + ;; values. + (declare (type (unsigned-byte 32) x0 x1) + (optimize (speed 3) (safety 0))) + ;; x << 55 + (let ((sl55-h (ldb (byte 32 0) (ash x0 (- 55 32)))) + (sl55-l 0)) + ;; x >> 9 + (let ((sr9-h (ash x1 -9)) + (sr9-l (ldb (byte 32 0) + (logior (ash x0 -9) + (ash x1 23))))) + (values (logior sl55-h sr9-h) + (logior sl55-l sr9-l))))) + (rotl-36 (x1 x0) + ;; Rotate [x1|x0] left 36 bits, returning the result as two + ;; values. + (declare (type (unsigned-byte 32) x0 x1) + (optimize (speed 3) (safety 0))) + ;; x << 36 + (let ((sl36-h (ldb (byte 32 0) (ash x0 4)))) + ;; x >> 28 + (let ((sr28-l (ldb (byte 32 0) + (logior (ash x0 -28) + (ash x1 4)))) + (sr28-h (ash x1 -28))) + (values (logior sl36-h sr28-h) + sr28-l)))) + (shl-14 (x1 x0) + ;; Shift [x1|x0] left by 14 bits, returning the result as + ;; two values. + (declare (type (unsigned-byte 32) x1 x0) + (optimize (speed 3) (safety 0))) + (values (ldb (byte 32 0) + (logior (ash x1 14) + (ash x0 (- 14 32)))) + (ldb (byte 32 0) + (ash x0 14)))) + (make-double (hi lo) + (kernel:make-double-float + (if (< hi #x80000000) + hi + (- hi #x100000000)) + lo))) + (let ((s0-1 0) + (s0-0 0) + (s1-1 0) + (s1-0 0)) + (declare (type (unsigned-byte 32) s0-1 s0-0 s1-1 s1-0)) + ;; Load the state to s0 and s1. s0-1 is the high 32-bit part and + ;; s0-0 is the low 32-bit part of the 64-bit value. Similarly + ;; for s1. + (multiple-value-bind (x1 x0) + (kernel:double-float-bits (aref state 0)) + (setf s0-1 (ldb (byte 32 0) x1) + s0-0 x0)) + (multiple-value-bind (x1 x0) + (kernel:double-float-bits (aref state 1)) + (setf s1-1 (ldb (byte 32 0) x1) + s1-0 x0)) + + ;; Compute the 64-bit random value: s0 + s1 + (multiple-value-prog1 + (multiple-value-bind (sum-0 c) + (bignum::%add-with-carry s0-0 s1-0 0) + (values (bignum::%add-with-carry s0-1 s1-1 c) + sum-0)) + ;; s1 ^= s0 + (setf s1-1 (logxor s1-1 s0-1) + s1-0 (logxor s1-0 s0-0)) + ;; s[0] = rotl(s0,55) ^ s1 ^ (s1 << 14) + (multiple-value-setq (s0-1 s0-0) + (rotl-55 s0-1 s0-0)) + (setf s0-1 (logxor s0-1 s1-1) + s0-0 (logxor s0-0 s1-0)) + (multiple-value-bind (s14-1 s14-0) + (shl-14 s1-1 s1-0) + (setf s0-1 (logxor s0-1 s14-1) + s0-0 (logxor s0-0 s14-0))) + + (multiple-value-bind (r1 r0) + (rotl-36 s1-1 s1-0) + (setf (aref state 0) (make-double s0-1 s0-0) + (aref state 1) (make-double r1 r0))))))) + +;;; Size of the chunks returned by random-chunk. +;;; +(defconstant random-chunk-length 32) + +;;; random-chunk -- Internal +;;; +;;; This function generaters a 32bit integer between 0 and #xffffffff +;;; inclusive. +;;; +(declaim (inline random-chunk)) + +(defun random-chunk (rng-state) + (declare (type random-state rng-state) + (optimize (speed 3) (safety 0))) + (let ((cached (random-state-cached-p rng-state))) + (cond (cached + (setf (random-state-cached-p rng-state) nil) + (random-state-rand rng-state)) + (t + (let ((s (random-state-state rng-state))) + (declare (type (simple-array double-float (2)) s)) + (multiple-value-bind (r1 r0) + (xoroshiro-gen s) + (setf (random-state-rand rng-state) r0) + (setf (random-state-cached-p rng-state) t) + r1)))))) + + +;;; %RANDOM-SINGLE-FLOAT, %RANDOM-DOUBLE-FLOAT -- Interface +;;; +;;; Handle the single or double float case of RANDOM. We generate a float +;;; between 0.0 and 1.0 by clobbering the significand of 1.0 with random bits, +;;; then subtracting 1.0. This hides the fact that we have a hidden bit. +;;; +(declaim (inline %random-single-float %random-double-float)) +(declaim (ftype (function ((single-float (0f0)) random-state) + (single-float 0f0)) + %random-single-float)) +;;; +(defun %random-single-float (arg state) + (declare (type (single-float (0f0)) arg) + (type random-state state)) + (* arg + (- (make-single-float + (dpb (ash (random-chunk state) + (- vm:single-float-digits random-chunk-length)) + vm:single-float-significand-byte + (single-float-bits 1.0))) + 1.0))) +;;; +(declaim (ftype (function ((double-float (0d0)) random-state) + (double-float 0d0)) + %random-double-float)) +;;; +;;; 53-bit version. +;;; +(defun %random-double-float (arg state) + (declare (type (double-float (0d0)) arg) + (type random-state state)) + ;; xoroshiro-gen produces 64-bit values. Should we use that + ;; directly to get the random bits instead of two calls to + ;; RANDOM-CHUNK? + (* arg + (- (lisp::make-double-float + (dpb (ash (random-chunk state) + (- vm:double-float-digits random-chunk-length + vm:word-bits)) + vm:double-float-significand-byte + (lisp::double-float-high-bits 1d0)) + (random-chunk state)) + 1d0))) + +#+double-double +(defun %random-double-double-float (arg state) + (declare (type (double-double-float (0w0)) arg) + (type random-state state)) + ;; Generate a 31-bit integer, scale it and sum them up + (let* ((r 0w0) + (scale (scale-float 1d0 -31)) + (mult scale)) + (declare (double-float mult) + (type double-double-float r) + (optimize (speed 3) (inhibit-warnings 3))) + (dotimes (k 4) + (setf r (+ r (* mult (ldb (byte 31 0) (random-chunk state))))) + (setf mult (* mult scale))) + (* arg r))) + +;;;; Random integers: + +;;; Amount we overlap chunks by when building a large integer to make up for +;;; the loss of randomness in the low bits. +;;; +(defconstant random-integer-overlap 3) + +;;; Extra bits of randomness that we generate before taking the value MOD the +;;; limit, to avoid loss of randomness near the limit. +;;; +(defconstant random-integer-extra-bits 10) + +;;; Largest fixnum we can compute from one chunk of bits. +;;; +(defconstant random-fixnum-max + (1- (ash 1 (- random-chunk-length random-integer-extra-bits)))) + + +;;; %RANDOM-INTEGER -- Internal +;;; +(defun %random-integer (arg state) + (declare (type (integer 1) arg) + (type random-state state)) + (let ((shift (- random-chunk-length random-integer-overlap))) + (do ((bits (random-chunk state) + (logxor (ash bits shift) (random-chunk state))) + (count (+ (integer-length arg) + (- random-integer-extra-bits shift)) + (- count shift))) + ((minusp count) + (rem bits arg)) + (declare (fixnum count))))) + +(defun random (arg &optional (state *random-state*)) + _N"Generate a uniformly distributed pseudo-random number between zero + and Arg. State, if supplied, is the random state to use." + (declare (inline %random-single-float %random-double-float)) + (cond + ((typep arg '(integer 1 #x100000000)) + ;; Let the compiler deftransform take care of this case. + (%random-integer arg state)) + ((and (typep arg 'single-float) (> arg 0.0F0)) + (%random-single-float arg state)) + ((and (typep arg 'double-float) (> arg 0.0D0)) + (%random-double-float arg state)) + #+double-double + ((and (typep arg 'double-double-float) (> arg 0.0w0)) + (%random-double-double-float arg state)) + ((and (integerp arg) (> arg 0)) + (%random-integer arg state)) + (t + (error 'simple-type-error + :expected-type '(or (integer 1) (float (0.0))) :datum arg + :format-control _"Argument is not a positive integer or a positive float: ~S") + :format-arguments (list arg))))) + +;; Jump function for the generator. See the jump function in +;; http://xoroshiro.di.unimi.it/xoroshiro128plus.c +(defun random-state-jump (&optional (rng-state *random-state*)) + _N"Jump the RNG-STATE. This is equivalent to 2^64 calls to the + xoroshiro128+ generator. It can be used to generate 2^64 + non-overlapping subsequences for parallel computations." + (declare (type random-state rng-state)) + (let ((state (random-state-state rng-state)) + (s0-0 0) + (s0-1 0) + (s1-0 0) + (s1-1 0)) + (declare (type (unsigned-byte 32) s0-0 s0-1 s1-0 s1-1) + (optimize (speed 3) (safety 0))) + ;; The constants are #xbeac0467eba5facb and #xd86b048b86aa9922, + ;; and we process these numbers starting from the LSB. We want ot + ;; process these in 32-bit chunks, so word-reverse the constants. + (dolist (jump '(#xeba5facb #xbeac0467 #x86aa9922 #xd86b048b)) + (declare (type (unsigned-byte 32) jump)) + (dotimes (b 32) + (declare (fixnum b)) + (when (logbitp b jump) + (multiple-value-bind (x1 x0) + (kernel:double-float-bits (aref state 0)) + (setf s0-1 (logxor s0-1 (ldb (byte 32 0) x1)) + s0-0 (logxor s0-0 x0))) + + (multiple-value-bind (x1 x0) + (kernel:double-float-bits (aref state 1)) + (setf s1-1 (logxor s1-1 (ldb (byte 32 0) x1)) + s1-0 (logxor s1-0 x0)))) + (xoroshiro-gen state))) + + (flet ((convert (x1 x0) + (declare (type (unsigned-byte 32) x1 x0)) + (kernel:make-double-float + (if (< x1 #x80000000) x1 (- x1 #x100000000)) + x0))) + (setf (aref state 0) (convert s0-1 s0-0)) + (setf (aref state 1) (convert s1-1 s1-0))) + rng-state)) ===================================== src/code/x86-vm.lisp ===================================== --- a/src/code/x86-vm.lisp +++ b/src/code/x86-vm.lisp @@ -413,6 +413,7 @@ ;;; transformed to a call to this routine allowing its use in byte ;;; compiled code. ;;; +#+random-mt19937 (defun random-mt19937 (state) (declare (type (simple-array (unsigned-byte 32) (627)) state)) (random-mt19937 state)) ===================================== src/compiler/float-tran.lisp ===================================== --- a/src/compiler/float-tran.lisp +++ b/src/compiler/float-tran.lisp @@ -236,7 +236,7 @@ (frob %random-single-float single-float) (frob %random-double-float double-float)) -#-(or new-random random-mt19937) +#-(or new-random random-mt19937 rand-xoroshiro) (deftransform random ((num &optional state) ((integer 1 #.random-fixnum-max) &optional *)) _N"use inline fixnum operations" @@ -259,7 +259,7 @@ '(values (truncate (%random-double-float (coerce num 'double-float) (or state *random-state*))))) -#+random-mt19937 +#+(or random-mt19937) (deftransform random ((num &optional state) ((integer 1 #.(expt 2 32)) &optional *)) _N"use inline (unsigned-byte 32) operations" ===================================== src/compiler/sparc/arith.lisp ===================================== --- a/src/compiler/sparc/arith.lisp +++ b/src/compiler/sparc/arith.lisp @@ -2588,3 +2588,60 @@ (unsigned-byte 32)) "recode as shifts and adds" (*-transformer y)) + +(in-package "VM") + +#+random-xoroshiro +(progn +(defknown xoroshiro-next ((simple-array double-float (2))) + (values (unsigned-byte 32) (unsigned-byte 32)) + (movable)) + +(define-vop (xoroshiro-next) + (:policy :fast-safe) + (:translate xoroshiro-next) + (:args (state :scs (descriptor-reg) :to (:result 3))) + (:arg-types simple-array-double-float) + (:results (r1 :scs (unsigned-reg)) + (r0 :scs (unsigned-reg))) + (:result-types unsigned-num unsigned-num) + ;; Must be sure to use %o registers for temps because we want to use + ;; 64-bit registers that will get preserved. + (:temporary (:sc unsigned-reg :offset nl5-offset) s0) + (:temporary (:sc unsigned-reg :offset nl4-offset) s1) + (:temporary (:sc unsigned-reg :offset nl3-offset) t0) + (:generator 10 + (let ((s0-offset (+ (* 0 double-float-bytes) + (- (* vm:vector-data-offset vm:word-bytes) + vm:other-pointer-type))) + (s1-offset (+ (* 1 double-float-bytes) + (- (* vm:vector-data-offset vm:word-bytes) + vm:other-pointer-type)))) + (inst ldx s0 state s0-offset) + (inst ldx s1 state s1-offset) + ;; result = s0 + s1, split into low 32-bits in r0 and high 32-bits + ;; in r1 + (inst add r0 s0 s1) + (inst srlx r1 r0 32) + + ;; s1 = s1 ^ s0 + (inst xor s1 s0) + + ;; s0 = rotl(s0,55) = s0 << 55 | s0 >> 9 + (inst sllx t0 s0 55) + (inst srlx s0 s0 9) + (inst or s0 t0) + + (inst xor s0 s1) ; s0 = s0 ^ s1 + (inst sllx t0 s1 14) ; t0 = s1 << 14 + (inst xor s0 t0) ; s0 = s0 ^ t0 + + (inst stx s0 state s0-offset) + + ;; s1 = rotl(s1, 36) = s1 << 36 | s1 >> 28, using t0 as temp + (inst sllx t0 s1 36) + (inst srlx s1 28) + (inst or s1 t0) + + (inst stx s1 state s1-offset)))) +) ===================================== src/compiler/x86/arith.lisp ===================================== --- a/src/compiler/x86/arith.lisp +++ b/src/compiler/x86/arith.lisp @@ -1833,3 +1833,78 @@ (vm::ash-right-unsigned num (- shift))))) (t (give-up))))) + +(in-package "VM") + +#+random-xoroshiro +(progn +(defknown xoroshiro-next ((simple-array double-float (2))) + (values (unsigned-byte 32) (unsigned-byte 32)) + (movable)) + +(define-vop (xoroshiro-next) + (:policy :fast-safe) + (:translate xoroshiro-next) + (:args (state :scs (descriptor-reg) :to (:result 3))) + (:arg-types simple-array-double-float) + (:results (r1 :scs (unsigned-reg)) + (r0 :scs (unsigned-reg))) + (:result-types unsigned-num unsigned-num) + (:temporary (:sc double-reg) s0) + (:temporary (:sc double-reg) s1) + (:temporary (:sc double-reg) t0) + (:generator 10 + ;; s0 = state[0] + (inst movsd s0 (make-ea :dword :base state + :disp (- (+ (* vm:vector-data-offset + vm:word-bytes) + (* 8 0)) + vm:other-pointer-type))) + ;; s1 = state[1] + (inst movsd s1 (make-ea :dword :base state + :disp (- (+ (* vm:vector-data-offset + vm:word-bytes) + (* 8 1)) + vm:other-pointer-type))) + ;; Compute result = s0 + s1 + (inst movapd t0 s0) + (inst paddq t0 s1) + ;; Save the 64-bit result as two 32-bit results + (inst movd r0 t0) + (inst psrlq t0 32) + (inst movd r1 t0) + + ;; s1 = s1 ^ s0 + (inst xorpd s1 s0) + + ;; s0 = rotl(s0,55) = s0 << 55 | s0 >> 9 + (inst movapd t0 s0) + (inst psllq s0 55) ; s0 = s0 << 55 + (inst psrlq t0 9) ; t0 = s0 >> 9 + (inst orpd s0 t0) ; s0 = rotl(s0, 55) + + (inst movapd t0 s1) + (inst xorpd s0 s1) ; s0 = s0 ^ s1 + (inst psllq t0 14) ; t0 = s1 << 14 + (inst xorpd s0 t0) ; s0 = s0 ^ t0 + (inst movsd (make-ea :dword :base state + :disp (- (+ (* vm:vector-data-offset + vm:word-bytes) + (* 8 0)) + vm:other-pointer-type)) + s0) + + ;; s1 = rotl(s1, 36) = s1 << 36 | s1 >> 28, using t0 as temp + (inst movapd t0 s1) + (inst psllq s1 36) + (inst psrlq t0 28) + (inst orpd s1 t0) + + (inst movsd (make-ea :dword :base state + :disp (- (+ (* vm:vector-data-offset + vm:word-bytes) + (* 8 1)) + vm:other-pointer-type)) + s1))) +) + \ No newline at end of file ===================================== src/compiler/x86/insts.lisp ===================================== --- a/src/compiler/x86/insts.lisp +++ b/src/compiler/x86/insts.lisp @@ -3195,7 +3195,11 @@ ;; dst[63:0] = dst[63:0] ;; dst[127:64] = src[63:0] (define-regular-sse-inst unpcklpd #x66 #x14 t) - (define-regular-sse-inst unpcklps nil #x14 t)) + (define-regular-sse-inst unpcklps nil #x14 t) + + ;; PADDQ 64-bit integer add + (define-regular-sse-inst paddq #x66 #xd4) + ) (define-instruction popcnt (segment dst src) (:printer ext-reg-reg/mem @@ -3539,4 +3543,3 @@ (packed-shift psllw #x71 #xf1 6) (packed-shift psrad #x72 #xe2 4) (packed-shift psraw #x71 #xe1 4)) - ===================================== src/general-info/release-21d.md ===================================== --- a/src/general-info/release-21d.md +++ b/src/general-info/release-21d.md @@ -21,6 +21,11 @@ public domain. * Feature enhancements * Update to ASDF 3.3.1, fixing issues introduced in 3.3.0 * Changes + * x86 and sparc have replaced the MT19937 RNG with xoroshiro128+ RNG. + * The required state for this generator is just 4 32-bit words instead of the 600+ for MT19937. + * The generator is also faster than MT19937 (approximately 28% faster on x86 and 18% on sparc). + * The new function `KERNEL:RANDOM-STATE-JUMP` modifies the given state to jump 2^64 samples ahead, allowing 2^64 non-overlapping sequences. + * ANSI compliance fixes: * Bug fixes: * Gitlab tickets: ===================================== src/i18n/locale/cmucl.pot ===================================== --- a/src/i18n/locale/cmucl.pot +++ b/src/i18n/locale/cmucl.pot @@ -33,7 +33,7 @@ msgstr "" #: src/code/intl.lisp src/compiler/globaldb.lisp src/code/defstruct.lisp #: src/code/remote.lisp src/code/wire.lisp src/code/internet.lisp #: src/code/loop.lisp src/code/run-program.lisp src/code/parse-time.lisp -#: src/code/profile.lisp src/code/ntrace.lisp src/code/rand-mt19937.lisp +#: src/code/profile.lisp src/code/ntrace.lisp src/code/rand-xoroshiro.lisp #: src/code/debug.lisp src/code/debug-int.lisp src/code/debug-info.lisp #: src/code/eval.lisp src/code/filesys.lisp src/code/pathname.lisp #: src/code/fd-stream.lisp src/code/extfmts.lisp src/code/serve-event.lisp @@ -12105,13 +12105,13 @@ msgstr "" msgid "Type \"yes\" for yes or \"no\" for no. " msgstr "" -#: src/code/rand-mt19937.lisp +#: src/code/rand-xoroshiro.lisp msgid "" "Generate an random state vector from the given SEED. The seed can be\n" -" either an integer or a vector of (unsigned-byte 32)" +" either an integer or a vector of (unsigned-byte 64)" msgstr "" -#: src/code/rand-mt19937.lisp +#: src/code/rand-xoroshiro.lisp msgid "" "Make a random state object. If STATE is not supplied, return a copy\n" " of the default random state. If STATE is a random state, then return a\n" @@ -12119,20 +12119,27 @@ msgid "" " the universal time or /dev/urandom if available." msgstr "" -#: src/code/rand-mt19937.lisp -msgid "Argument is not a RANDOM-STATE, T or NIL: ~S" +#: src/code/rand-xoroshiro.lisp +msgid "Argument is not a RANDOM-STATE, T, or NIL: ~S" msgstr "" -#: src/code/rand-mt19937.lisp +#: src/code/rand-xoroshiro.lisp msgid "" "Generate a uniformly distributed pseudo-random number between zero\n" " and Arg. State, if supplied, is the random state to use." msgstr "" -#: src/code/rand-mt19937.lisp +#: src/code/rand-xoroshiro.lisp msgid "Argument is not a positive integer or a positive float: ~S" msgstr "" +#: src/code/rand-xoroshiro.lisp +msgid "" +"Jump the RNG-STATE. This is equivalent to 2^64 calls to the\n" +" xoroshiro128+ generator. It can be used to generate 2^64\n" +" non-overlapping subsequences for parallel computations." +msgstr "" + #: src/code/ntrace.lisp msgid "" "This is bound to the returned values when evaluating :BREAK-AFTER and\n" @@ -18869,10 +18876,6 @@ msgid "use inline (unsigned-byte 32) operations" msgstr "" #: src/compiler/float-tran.lisp -msgid "Shouldn't happen" -msgstr "" - -#: src/compiler/float-tran.lisp msgid "Can't open-code float to rational comparison." msgstr "" ===================================== src/tools/worldbuild.lisp ===================================== --- a/src/tools/worldbuild.lisp +++ b/src/tools/worldbuild.lisp @@ -121,9 +121,13 @@ "target:code/scavhook" "target:code/save" - ,@(if (c:backend-featurep :random-mt19937) - '("target:code/rand-mt19937") - '("target:code/rand")) + ,@(cond ((c:backend-featurep :random-mt19937) + '("target:code/rand-mt19937")) + ((c:backend-featurep :random-xoroshiro) + '("target:code/rand-xoroshiro")) + (t + '("target:code/rand"))) + "target:code/rand-xoroshiro" "target:code/alieneval" "target:code/c-call" "target:code/sap" ===================================== src/tools/worldcom.lisp ===================================== --- a/src/tools/worldcom.lisp +++ b/src/tools/worldcom.lisp @@ -268,9 +268,12 @@ (comf "target:code/debug" :byte-compile t) (comf "target:code/query" :byte-compile *byte-compile*) -(if (c:backend-featurep :random-mt19937) - (comf "target:code/rand-mt19937") - (comf "target:code/rand")) +(cond ((c:backend-featurep :random-mt19937) + (comf "target:code/rand-mt19937")) + ((c:backend-featurep :random-xoroshiro) + (comf "target:code/rand-xoroshiro")) + (t + (comf "target:code/rand"))) (comf "target:code/ntrace" :byte-compile *byte-compile*) (comf "target:code/profile") (comf "target:code/sort") ===================================== src/tools/worldload.lisp ===================================== --- a/src/tools/worldload.lisp +++ b/src/tools/worldload.lisp @@ -96,8 +96,13 @@ (maybe-byte-load "code:time") (maybe-byte-load "code:tty-inspect") (maybe-byte-load "code:describe") -#+random-mt19937 (maybe-byte-load "code:rand-mt19937") -#-random-mt19937 (maybe-byte-load "code:rand") +#+random-mt19937 +(maybe-byte-load "code:rand-mt19937") +#+random-xoroshiro +(maybe-byte-load "code:rand-xoroshiro") +#-(or random-mt19937 random-xoroshiro) +(maybe-byte-load "code:rand") +(maybe-byte-load "code:rand-xoroshiro") (maybe-byte-load "target:pcl/walk") (maybe-byte-load "code:fwrappers") (maybe-byte-load "code:ntrace") ===================================== tests/rng.lisp ===================================== --- /dev/null +++ b/tests/rng.lisp @@ -0,0 +1,70 @@ +;; Tests for RNG + +(defpackage :rng-tests + (:use :cl :lisp-unit)) + +(in-package "RNG-TESTS") + +(defun 64-bit-rng-state (rng) + (let ((state (kernel::random-state-state rng))) + (flet ((convert (x) + (multiple-value-bind (hi lo) + (kernel:double-float-bits x) + (logior (ash (ldb (byte 32 0) hi) 32) + lo)))) + (values (convert (aref state 0)) (convert (aref state 1)))))) + +(defun 64-bit-value (rng) + (logior (ash (kernel::random-chunk rng) 32) + (kernel::random-chunk rng))) + +(defvar *test-state*) + +#+random-xoroshiro +(define-test rng.initial-state + (setf *test-state* + (kernel::make-random-object :state (kernel::init-random-state #x12345678) + :rand 0 + :cached-p nil)) + (multiple-value-bind (s0 s1) + (64-bit-rng-state *test-state*) + (assert-equal #x38f1dc39d1906b6f s0) + (assert-equal #xdfe4142236dd9517 s1) + (assert-equal 0 (kernel::random-state-rand *test-state*)) + (assert-equal nil (kernel::random-state-cached-p *test-state*)))) + + +#+random-xoroshiro +(define-test rng.values-test + (assert-equal (list #x38f1dc39d1906b6f #xdfe4142236dd9517) + (multiple-value-list (64-bit-rng-state *test-state*))) + (assert-equal 0 (kernel::random-state-rand *test-state*)) + (assert-equal nil (kernel::random-state-cached-p *test-state*)) + + (dolist (item '((#x18d5f05c086e0086 (#x228f4926843b364d #x74dfe78e715c81be)) + (#x976f30b4f597b80b (#x5b6bd4558bd96a68 #x567b7f35650aea8f)) + (#xb1e7538af0e454f7 (#x13e5253e242fac52 #xed380e70d10ab60e)) + (#x011d33aef53a6260 (#x9d0764952ca00d8a #x5251a5cfedd2b4ef)) + (#xef590a651a72c279 (#xba4ef2b425bda963 #x172b965cf56c15ac)) + (#xd17a89111b29bf0f (#x458277a5e5f0a21b #xd1bccfad6564e8d)) + (#x529e44a0bc46f0a8 (#x2becb68d5a7194c7 #x3a6ec964899bb5f3)) + (#x665b7ff1e40d4aba (#xededfd481d0a19fe #x3ea213411827fe9d)) + (#x2c9010893532189b (#xd7bb59bcd8fba26f #x52de763d34fee090)) + (#x2a99cffa0dfa82ff (#xf96e892c62d6ff2e #xc0542ff85652f81e)))) + (destructuring-bind (value state) + item + (assert-equal value (64-bit-value *test-state*)) + (assert-equal state (multiple-value-list (64-bit-rng-state *test-state*)))))) + +(define-test rng.jump + (setf *test-state* + (kernel::make-random-object :state (kernel::init-random-state #x12345678) + :rand 0 + :cached-p nil)) + (dolist (result '((#x291ddf8e6f6a7b67 #x1f9018a12f9e031f) + (#x88a7aa12158558d0 #xe264d785ab1472d9) + (#x207e16f73c51e7ba #x999c8a0a9a8d87c0) + (#x28f8959d3bcf5ff1 #x38091e563ab6eb98))) + (kernel:random-state-jump *test-state*) + (assert-equal result (multiple-value-list + (64-bit-rng-state *test-state*))))) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/compare/757fb170ee958123f0d44e7f… --- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/compare/757fb170ee958123f0d44e7f… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][rtoy-xoro-default] Update release notes
by Raymond Toy 29 Dec '17

29 Dec '17

Raymond Toy pushed to branch rtoy-xoro-default at cmucl / cmucl Commits: d8ef7876 by Raymond Toy at 2017-12-29T10:20:13-08:00 Update release notes - - - - - 1 changed file: - src/general-info/release-21d.md Changes: ===================================== src/general-info/release-21d.md ===================================== --- a/src/general-info/release-21d.md +++ b/src/general-info/release-21d.md @@ -21,6 +21,11 @@ public domain. * Feature enhancements * Update to ASDF 3.3.1, fixing issues introduced in 3.3.0 * Changes + * x86 and sparc have replaced the MT19937 RNG with xoroshiro128+ RNG. + * The required state for this generator is just 4 32-bit words instead of the 600+ for MT19937. + * The generator is also faster than MT19937 (approximately 28% faster on x86 and 18% on sparc). + * The new function `KERNEL:RANDOM-STATE-JUMP` modifies the given state to jump 2^64 samples ahead, allowing 2^64 non-overlapping sequences. + * ANSI compliance fixes: * Bug fixes: * Gitlab tickets: View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/d8ef787644b5a460ff7fb0b37… --- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/d8ef787644b5a460ff7fb0b37… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][rtoy-xoro-default] Fix typo in reader conditional.
by Raymond Toy 29 Dec '17

29 Dec '17

Raymond Toy pushed to branch rtoy-xoro-default at cmucl / cmucl Commits: e5bd7ef7 by Raymond Toy at 2017-12-29T08:57:34-08:00 Fix typo in reader conditional. Don't use the portable xoroshiro-gen on x86 and sparc! - - - - - 1 changed file: - src/code/rand-xoroshiro.lisp Changes: ===================================== src/code/rand-xoroshiro.lisp ===================================== --- a/src/code/rand-xoroshiro.lisp +++ b/src/code/rand-xoroshiro.lisp @@ -235,11 +235,11 @@ (optimize (speed 3) (safety 0))) (vm::xoroshiro-next state)) -#+(or x86 sparc) +#-(or x86 sparc) (defun xoroshiro-gen (state) (declare (type (simple-array double-float (2)) state) (optimize (speed 3) (safety 0))) - ;; Portable implemenation of the xoroshiro128+ generator. See + ;; Portable implementation of the xoroshiro128+ generator. See ;; http://xoroshiro.di.unimi.it/xoroshiro128plus.c for the ;; definitive definition. ;; View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/e5bd7ef7412200ea1ec453382… --- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/e5bd7ef7412200ea1ec453382… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][rtoy-xoro-default] 2 commits: Add comments.
by Raymond Toy 29 Dec '17

29 Dec '17

Raymond Toy pushed to branch rtoy-xoro-default at cmucl / cmucl Commits: 86599903 by Raymond Toy at 2017-12-28T19:53:42-08:00 Add comments. - - - - - 562752c0 by Raymond Toy at 2017-12-28T19:54:11-08:00 Regenerated from sources - - - - - 2 changed files: - src/code/rand-xoroshiro.lisp - src/i18n/locale/cmucl.pot Changes: ===================================== src/code/rand-xoroshiro.lisp ===================================== --- a/src/code/rand-xoroshiro.lisp +++ b/src/code/rand-xoroshiro.lisp @@ -1,6 +1,9 @@ ;;; -*- Mode: Lisp; Package: Kernel -*- ;;; ;;; ********************************************************************** +;;; This code was written as part of CMU Common Lisp and has been +;;; placed in the public domain, and is provided 'as is'. +;;; (ext:file-comment "$Header: src/code/rand-xoroshiro.lisp $") @@ -23,6 +26,12 @@ (sys:register-lisp-feature :random-xoroshiro) + +;;;; Random state hackery: + +;; Generate a random seed that can be used for seeding the generator. +;; If /dev/urandom is available, it is used to generate random data as +;; the seed. Otherwise, the current time is used as the seed. (defun generate-seed (&optional (nwords 1)) ;; On some systems (as reported by Ole Rohne on cmucl-imp), ;; /dev/urandom isn't what we think it is, so if it doesn't work, @@ -51,7 +60,7 @@ (flet ((splitmix64 () ;; See http://xoroshiro.di.unimi.it/splitmix64.c for the ;; definitive reference. The basic algorithm, where x is - ;; the 64-bit state of the generator,: + ;; the 64-bit state of the generator, is: ;; ;; uint64_t z = (x += 0x9e3779b97f4a7c15); ;; z = (z ^ (z >> 30)) * 0xbf58476d1ce4e5b9; @@ -85,10 +94,14 @@ (aref state 1) (make-double s1)) state)))) +;; Initialize from an array. The KEY is a 2-element array of unsigned +;; 64-bit integers. The state is set to the given 64-bit integer +;; values. (defun vec-init-xoro-state (key &optional (state (make-array 2 :element-type 'double-float))) (declare (type (array (unsigned-byte 64) (2)) key) (type (simple-array double-float (2)) state)) (flet ((make-double (x) + (declare (type (unsigned-byte 64) x)) (let ((hi (ldb (byte 32 32) x)) (lo (ldb (byte 32 0) x))) (kernel:make-double-float @@ -99,11 +112,11 @@ (setf (aref state 0) (make-double (aref key 0)) (aref state 1) (make-double (aref key 1))) state)) - - + +;; The default seed is the digits of Euler's constant, 0.5772.... (defun init-random-state (&optional (seed 5772156649015328606) state) - "Generate an random state vector from the given SEED. The seed can be - either an integer or a vector of (unsigned-byte 32)" + _N"Generate an random state vector from the given SEED. The seed can be + either an integer or a vector of (unsigned-byte 64)" (declare (type (or null integer (array (unsigned-byte 64) (*))) seed)) @@ -180,6 +193,10 @@ (make-random-object)) (defun make-random-state (&optional state) + _N"Make a random state object. If STATE is not supplied, return a copy + of the default random state. If STATE is a random state, then return a + copy of it. If STATE is T then return a random state generated from + the universal time or /dev/urandom if available." (flet ((copy-random-state (state) (let ((old-state (random-state-state state)) (new-state @@ -198,7 +215,7 @@ :rand 0 :cached-p nil)) (t - (error "Argument is not a RANDOM-STATE, T, or NIL: ~S" state))))) + (error _"Argument is not a RANDOM-STATE, T, or NIL: ~S" state))))) (defun rand-initializer () (init-random-state (generate-seed) @@ -384,7 +401,7 @@ (double-float 0d0)) %random-double-float)) ;;; -;;; 53bit version. +;;; 53-bit version. ;;; (defun %random-double-float (arg state) (declare (type (double-float (0d0)) arg) @@ -452,10 +469,9 @@ (declare (fixnum count))))) (defun random (arg &optional (state *random-state*)) - "Generate a uniformly distributed pseudo-random number between zero + _N"Generate a uniformly distributed pseudo-random number between zero and Arg. State, if supplied, is the random state to use." - (declare (inline %random-single-float %random-double-float - #+long-float %long-float)) + (declare (inline %random-single-float %random-double-float)) (cond ((typep arg '(integer 1 #x100000000)) ;; Let the compiler deftransform take care of this case. @@ -464,9 +480,6 @@ (%random-single-float arg state)) ((and (typep arg 'double-float) (> arg 0.0D0)) (%random-double-float arg state)) - #+long-float - ((and (typep arg 'long-float) (> arg 0.0L0)) - (%random-long-float arg state)) #+double-double ((and (typep arg 'double-double-float) (> arg 0.0w0)) (%random-double-double-float arg state)) @@ -475,13 +488,13 @@ (t (error 'simple-type-error :expected-type '(or (integer 1) (float (0.0))) :datum arg - :format-control (intl:gettext "Argument is not a positive integer or a positive float: ~S") + :format-control _"Argument is not a positive integer or a positive float: ~S") :format-arguments (list arg))))) ;; Jump function for the generator. See the jump function in ;; http://xoroshiro.di.unimi.it/xoroshiro128plus.c (defun random-state-jump (&optional (rng-state *random-state*)) - "Jump the RNG-STATE. This is equivalent to 2^64 calls to the + _N"Jump the RNG-STATE. This is equivalent to 2^64 calls to the xoroshiro128+ generator. It can be used to generate 2^64 non-overlapping subsequences for parallel computations." (declare (type random-state rng-state)) ===================================== src/i18n/locale/cmucl.pot ===================================== --- a/src/i18n/locale/cmucl.pot +++ b/src/i18n/locale/cmucl.pot @@ -33,7 +33,7 @@ msgstr "" #: src/code/intl.lisp src/compiler/globaldb.lisp src/code/defstruct.lisp #: src/code/remote.lisp src/code/wire.lisp src/code/internet.lisp #: src/code/loop.lisp src/code/run-program.lisp src/code/parse-time.lisp -#: src/code/profile.lisp src/code/ntrace.lisp src/code/rand-mt19937.lisp +#: src/code/profile.lisp src/code/ntrace.lisp src/code/rand-xoroshiro.lisp #: src/code/debug.lisp src/code/debug-int.lisp src/code/debug-info.lisp #: src/code/eval.lisp src/code/filesys.lisp src/code/pathname.lisp #: src/code/fd-stream.lisp src/code/extfmts.lisp src/code/serve-event.lisp @@ -12105,13 +12105,13 @@ msgstr "" msgid "Type \"yes\" for yes or \"no\" for no. " msgstr "" -#: src/code/rand-mt19937.lisp +#: src/code/rand-xoroshiro.lisp msgid "" "Generate an random state vector from the given SEED. The seed can be\n" -" either an integer or a vector of (unsigned-byte 32)" +" either an integer or a vector of (unsigned-byte 64)" msgstr "" -#: src/code/rand-mt19937.lisp +#: src/code/rand-xoroshiro.lisp msgid "" "Make a random state object. If STATE is not supplied, return a copy\n" " of the default random state. If STATE is a random state, then return a\n" @@ -12119,20 +12119,27 @@ msgid "" " the universal time or /dev/urandom if available." msgstr "" -#: src/code/rand-mt19937.lisp -msgid "Argument is not a RANDOM-STATE, T or NIL: ~S" +#: src/code/rand-xoroshiro.lisp +msgid "Argument is not a RANDOM-STATE, T, or NIL: ~S" msgstr "" -#: src/code/rand-mt19937.lisp +#: src/code/rand-xoroshiro.lisp msgid "" "Generate a uniformly distributed pseudo-random number between zero\n" " and Arg. State, if supplied, is the random state to use." msgstr "" -#: src/code/rand-mt19937.lisp +#: src/code/rand-xoroshiro.lisp msgid "Argument is not a positive integer or a positive float: ~S" msgstr "" +#: src/code/rand-xoroshiro.lisp +msgid "" +"Jump the RNG-STATE. This is equivalent to 2^64 calls to the\n" +" xoroshiro128+ generator. It can be used to generate 2^64\n" +" non-overlapping subsequences for parallel computations." +msgstr "" + #: src/code/ntrace.lisp msgid "" "This is bound to the returned values when evaluating :BREAK-AFTER and\n" @@ -18869,10 +18876,6 @@ msgid "use inline (unsigned-byte 32) operations" msgstr "" #: src/compiler/float-tran.lisp -msgid "Shouldn't happen" -msgstr "" - -#: src/compiler/float-tran.lisp msgid "Can't open-code float to rational comparison." msgstr "" View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/compare/58f107b1c475acf59797b016… --- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/compare/58f107b1c475acf59797b016… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][rtoy-xoro-default] Print random state in hex
by Raymond Toy 28 Dec '17

28 Dec '17

Raymond Toy pushed to branch rtoy-xoro-default at cmucl / cmucl Commits: 58f107b1 by Raymond Toy at 2017-12-28T12:26:31-08:00 Print random state in hex Add comment for %random-double-float to use xoroshiro-gen directly instead of random-chunk twice. A minor micro optimization. - - - - - 1 changed file: - src/code/rand-xoroshiro.lisp Changes: ===================================== src/code/rand-xoroshiro.lisp ===================================== --- a/src/code/rand-xoroshiro.lisp +++ b/src/code/rand-xoroshiro.lisp @@ -155,10 +155,12 @@ (double-float-bits x) (logior (ash (ldb (byte 32 0) hi) 32) lo)))) - (prin1 (make-array 2 :element-type '(unsigned-byte 64) + (write (make-array 2 :element-type '(unsigned-byte 64) :initial-contents (list (c (aref state 0)) (c (aref state 1)))) - stream))) + :stream stream + :base 16 + :radix t))) (write-char #\space stream) (pprint-newline :linear stream) @@ -387,6 +389,9 @@ (defun %random-double-float (arg state) (declare (type (double-float (0d0)) arg) (type random-state state)) + ;; xoroshiro-gen produces 64-bit values. Should we use that + ;; directly to get the random bits instead of two calls to + ;; RANDOM-CHUNK? (* arg (- (lisp::make-double-float (dpb (ash (random-chunk state) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/58f107b1c475acf59797b016f… --- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/58f107b1c475acf59797b016f… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][rtoy-xoro-default] Use the xoroshiro vop on sparc
by Raymond Toy 28 Dec '17

28 Dec '17

Raymond Toy pushed to branch rtoy-xoro-default at cmucl / cmucl Commits: 448e9970 by Raymond Toy at 2017-12-28T09:53:39-08:00 Use the xoroshiro vop on sparc The vop greatly speeds up the generator on sparc. The time to generate 10,000,000 single-floats (on a 1 GHz Ultrasparc 3i) is: mt19937: 1.32 sec xoroshiro: 1.03 sec So xoroshiro is 22% faster than mt19937. - - - - - 1 changed file: - src/code/rand-xoroshiro.lisp Changes: ===================================== src/code/rand-xoroshiro.lisp ===================================== --- a/src/code/rand-xoroshiro.lisp +++ b/src/code/rand-xoroshiro.lisp @@ -206,15 +206,17 @@ ;;;; Random entries: -#+x86 +;; Sparc and x86 have vops to implement xoroshiro-gen that are much +;; faster than the portable lisp version. Use them. +#+(or x86 sparc) (declaim (inline xoroshiro-gen)) -#+x86 +#+(or x86 sparc) (defun xoroshiro-gen (state) (declare (type (simple-array double-float (2)) state) (optimize (speed 3) (safety 0))) (vm::xoroshiro-next state)) -#-x86 +#+(or x86 sparc) (defun xoroshiro-gen (state) (declare (type (simple-array double-float (2)) state) (optimize (speed 3) (safety 0))) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/448e99705bdfbc1a9e77756e3… --- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/448e99705bdfbc1a9e77756e3… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

cmucl-cvs December 2017