- cmucl-cvs - mailman3.common-lisp.net

[Git][cmucl/cmucl][master] Apply cmucl style
by Raymond Toy 02 Dec '16

02 Dec '16

Raymond Toy pushed to branch master at cmucl / cmucl Commits: 7e4f7eb9 by Raymond Toy at 2016-12-01T19:39:08-08:00 Apply cmucl style ieee754_rem_pio2 was not formatted according to cmucl style. Just re-indent. No other changes. - - - - - 1 changed file: - src/lisp/os-common.c Changes: ===================================== src/lisp/os-common.c ===================================== --- a/src/lisp/os-common.c +++ b/src/lisp/os-common.c @@ -551,18 +551,19 @@ os_guard_control_stack(int zone, int guard) /* Simple interface to __ieee754_rem_pio2 */ -int ieee754_rem_pio2(double x, double *y0, double *y1) +int +ieee754_rem_pio2(double x, double *y0, double *y1) { - extern int __ieee754_rem_pio2(double x, double *y); + extern int __ieee754_rem_pio2(double x, double *y); - double y[2]; - int n; + double y[2]; + int n; - n = __ieee754_rem_pio2(x, y); - *y0 = y[0]; - *y1 = y[1]; + n = __ieee754_rem_pio2(x, y); + *y0 = y[0]; + *y1 = y[1]; - return n; + return n; } /* View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/7e4f7eb9c7b602de22f3244fb…

1 0

[Git][cmucl/cmucl][master] 9 commits: Fix #26: Use nanosleep to sleep
by Raymond Toy 02 Dec '16

02 Dec '16

Raymond Toy pushed to branch master at cmucl / cmucl Commits: e5777ecb by Raymond Toy at 2016-11-28T20:29:33-08:00 Fix #26: Use nanosleep to sleep lisp/os-common.c: o Implement os_sleep(double) to sleep for the given number of seconds. Uses nanosleep on all platforms to sleep, taking care to sleep more if nanosleep was interrupted. code/lispinit.lisp: code/multi-proc.lisp: o Use the new os_sleep function to sleep for the requested amount of time. - - - - - 05585b8d by Raymond Toy at 2016-11-28T21:05:02-08:00 Minor cosmetic tweaks o Include math.h before netdb.h (from Carl) o Use ceil instead of trunc and add comment on why. o Conform to cmucl style. - - - - - 9e99edb8 by Raymond Toy at 2016-11-28T21:14:27-08:00 Add test for issue 26 Basically used the repro case from the issue. - - - - - f09db6e5 by Raymond Toy at 2016-11-28T22:14:26-08:00 Solaris needs -lrt library to get nanosleep. - - - - - 1aae3ef9 by Raymond Toy at 2016-11-29T19:01:54-08:00 Verify the process ran and exited successfully - - - - - 260c0e45 by Raymond Toy at 2016-11-29T19:03:17-08:00 Adjust comment - - - - - fb864a9b by Raymond Toy at 2016-11-30T19:53:44-08:00 Fix merge conflicts with master - - - - - 8743d581 by Raymond Toy at 2016-11-30T19:53:57-08:00 Fix merge conflicts - - - - - 5f7c4fea by Raymond Toy at 2016-12-02T03:37:16+00:00 Merge branch 'rtoy-issue-26' into 'master' Fix #26: Use nanosleep to sleep without being interrupted First, use nanosleep to sleep instead of using select. Then handle the case of nanosleep being interrupted wherein we keep calling nanosleep with the remaining time until the desired time has elapsed. See merge request !17 - - - - - 5 changed files: - src/code/lispinit.lisp - src/code/multi-proc.lisp - src/lisp/Config.sparc_common - src/lisp/os-common.c - tests/issues.lisp Changes: ===================================== src/code/lispinit.lisp ===================================== --- a/src/code/lispinit.lisp +++ b/src/code/lispinit.lisp @@ -515,12 +515,9 @@ :format-arguments (list n) :datum n :expected-type '(real 0))) - (multiple-value-bind (sec usec) - (if (integerp n) - (values n 0) - (multiple-value-bind (sec frac) (truncate n) - (values sec (truncate frac 1e-6)))) - (unix:unix-select 0 0 0 0 sec usec)) + (alien:alien-funcall + (alien:extern-alien "os_sleep" (function c-call:void double-float)) + (float n 1d0)) nil) ;;;; SCRUB-CONTROL-STACK ===================================== src/code/multi-proc.lisp ===================================== --- a/src/code/multi-proc.lisp +++ b/src/code/multi-proc.lisp @@ -1643,12 +1643,9 @@ ;; Can't call process-wait if the scheduling is inhibited. *inhibit-scheduling*) ;; The initial-process may block. - (multiple-value-bind (sec usec) - (if (integerp n) - (values n 0) - (multiple-value-bind (sec frac)(truncate n) - (values sec (truncate frac 1e-6)))) - (unix:unix-select 0 0 0 0 sec usec)) + (alien:alien-funcall + (alien:extern-alien "os_sleep" (function c-call:void double-float)) + (float n 1d0)) nil) (t (process-wait-with-timeout "Sleep" n (constantly nil))))) ===================================== src/lisp/Config.sparc_common ===================================== --- a/src/lisp/Config.sparc_common +++ b/src/lisp/Config.sparc_common @@ -48,5 +48,5 @@ ARCH_SRC = sparc-arch.c DEPEND=$(CC) OS_SRC = solaris-os.c os-common.c elf.c -OS_LIBS= -lsocket -lnsl -ldl +OS_LIBS= -lsocket -lnsl -ldl -lrt EXEC_FINAL_OBJ = exec-final.o ===================================== src/lisp/os-common.c ===================================== --- a/src/lisp/os-common.c +++ b/src/lisp/os-common.c @@ -6,9 +6,11 @@ */ #include <errno.h> +#include <math.h> #include <netdb.h> #include <stdio.h> #include <string.h> +#include <time.h> #include "os.h" #include "internals.h" @@ -562,3 +564,27 @@ int ieee754_rem_pio2(double x, double *y0, double *y1) return n; } + +/* + * sleep for the given number of seconds, even if we're interrupted. + */ +void +os_sleep(double seconds) +{ + struct timespec requested; + struct timespec remaining; + double integral; + double fractional; + + fractional = modf(seconds, &integral); + requested.tv_sec = (time_t) integral; + /* + * Round up---better to sleep slightly too long than to sleep for + * too short a time. + */ + requested.tv_nsec = (long) ceil(fractional * 1e9); + + while (nanosleep(&requested, &remaining) == -1 && errno == EINTR) { + requested = remaining; + } +} ===================================== tests/issues.lisp ===================================== --- a/tests/issues.lisp +++ b/tests/issues.lisp @@ -352,3 +352,18 @@ (:tag :issues) (loop for k from 1 to 24 do (assert-equal 0 (encode-universal-time 0 0 (- 24 k) 31 12 1899 k)))) + +(define-test issue.26 + (:tag :issues) + (let ((start-time (get-universal-time))) + (let ((p (ext:run-program "/usr/bin/env" '("sleep" "1") :wait nil))) + (sleep 5) + ;; For this test to be valid, the process must have finished + ;; with a successful exit. + (assert-true (eq (ext:process-status p) :exited)) + (assert-true (zerop (ext:process-exit-code p))) + + ;; We expect to have slept for at least 5 sec, but since + ;; get-universal-time only has an accuracy of 1 sec, just verify + ;; more than 3 sec have elapsed. + (assert-true (>= (- (get-universal-time) start-time) 3))))) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/compare/0e172b4b2d6dc5a6dd016c08…

1 0

[Git][cmucl/cmucl][rtoy-issue-26] 3 commits: Fix #36: encode-universal-time errors on valid time
by Raymond Toy 01 Dec '16

01 Dec '16

Raymond Toy pushed to branch rtoy-issue-26 at cmucl / cmucl Commits: 0e172b4b by Raymond Toy at 2016-11-10T19:13:53-08:00 Fix #36: encode-universal-time errors on valid time Allow 1899 as a year, but also add a check that the resulting time is a non-negative integer. Add a test for this too in issues.lisp. - - - - - fb864a9b by Raymond Toy at 2016-11-30T19:53:44-08:00 Fix merge conflicts with master - - - - - 8743d581 by Raymond Toy at 2016-11-30T19:53:57-08:00 Fix merge conflicts - - - - - 2 changed files: - src/code/time.lisp - tests/issues.lisp Changes: ===================================== src/code/time.lisp ===================================== --- a/src/code/time.lisp +++ b/src/code/time.lisp @@ -223,8 +223,11 @@ (type (mod 24) hour) (type (integer 1 31) date) (type (integer 1 12) month) - (type (or (integer 0 99) (integer 1900)) year) - (type (or null rational) time-zone)) + ;; 1899 to account for time zones that are equivalent to 1900. + (type (or (integer 0 99) (integer 1899)) year) + (type (or null rational) time-zone) + ;; Result must be non-negative integer! + (values (integer 0))) (let* ((year (if (< year 100) (pick-obvious-year year) year)) ===================================== tests/issues.lisp ===================================== --- a/tests/issues.lisp +++ b/tests/issues.lisp @@ -348,6 +348,11 @@ '(".dir" "dir") :test #'string-equal))))) +(define-test issue.36 + (:tag :issues) + (loop for k from 1 to 24 do + (assert-equal 0 (encode-universal-time 0 0 (- 24 k) 31 12 1899 k)))) + (define-test issue.26 (:tag :issues) (let ((start-time (get-universal-time))) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/compare/260c0e45be8064450a13608a…

1 0

[Git][cmucl/cmucl][rtoy-issue-26] Adjust comment
by Raymond Toy 30 Nov '16

30 Nov '16

Raymond Toy pushed to branch rtoy-issue-26 at cmucl / cmucl Commits: 260c0e45 by Raymond Toy at 2016-11-29T19:03:17-08:00 Adjust comment - - - - - 1 changed file: - src/lisp/os-common.c Changes: ===================================== src/lisp/os-common.c ===================================== --- a/src/lisp/os-common.c +++ b/src/lisp/os-common.c @@ -579,8 +579,8 @@ os_sleep(double seconds) fractional = modf(seconds, &integral); requested.tv_sec = (time_t) integral; /* - * Round up just in case; it's probably better to sleep slightly - * too long than to sleep for too short a time. + * Round up---better to sleep slightly too long than to sleep for + * too short a time. */ requested.tv_nsec = (long) ceil(fractional * 1e9); View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/260c0e45be8064450a13608a9…

1 0

[Git][cmucl/cmucl][rtoy-issue-26] Verify the process ran and exited successfully
by Raymond Toy 30 Nov '16

30 Nov '16

Raymond Toy pushed to branch rtoy-issue-26 at cmucl / cmucl Commits: 1aae3ef9 by Raymond Toy at 2016-11-29T19:01:54-08:00 Verify the process ran and exited successfully - - - - - 1 changed file: - tests/issues.lisp Changes: ===================================== tests/issues.lisp ===================================== --- a/tests/issues.lisp +++ b/tests/issues.lisp @@ -352,8 +352,12 @@ (:tag :issues) (let ((start-time (get-universal-time))) (let ((p (ext:run-program "/usr/bin/env" '("sleep" "1") :wait nil))) - (declare (ignore p)) (sleep 5) + ;; For this test to be valid, the process must have finished + ;; with a successful exit. + (assert-true (eq (ext:process-status p) :exited)) + (assert-true (zerop (ext:process-exit-code p))) + ;; We expect to have slept for at least 5 sec, but since ;; get-universal-time only has an accuracy of 1 sec, just verify ;; more than 3 sec have elapsed. View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/1aae3ef96a2f49ef5743031d7…

1 0

[Git][cmucl/cmucl][rtoy-issue-26] Solaris needs -lrt library to get nanosleep.
by Raymond Toy 29 Nov '16

29 Nov '16

Raymond Toy pushed to branch rtoy-issue-26 at cmucl / cmucl Commits: f09db6e5 by Raymond Toy at 2016-11-28T22:14:26-08:00 Solaris needs -lrt library to get nanosleep. - - - - - 1 changed file: - src/lisp/Config.sparc_common Changes: ===================================== src/lisp/Config.sparc_common ===================================== --- a/src/lisp/Config.sparc_common +++ b/src/lisp/Config.sparc_common @@ -48,5 +48,5 @@ ARCH_SRC = sparc-arch.c DEPEND=$(CC) OS_SRC = solaris-os.c os-common.c elf.c -OS_LIBS= -lsocket -lnsl -ldl +OS_LIBS= -lsocket -lnsl -ldl -lrt EXEC_FINAL_OBJ = exec-final.o View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/f09db6e5b14f08de83894da68…

1 0

[Git][cmucl/cmucl][rtoy-issue-26] 2 commits: Minor cosmetic tweaks
by Raymond Toy 29 Nov '16

29 Nov '16

Raymond Toy pushed to branch rtoy-issue-26 at cmucl / cmucl Commits: 05585b8d by Raymond Toy at 2016-11-28T21:05:02-08:00 Minor cosmetic tweaks o Include math.h before netdb.h (from Carl) o Use ceil instead of trunc and add comment on why. o Conform to cmucl style. - - - - - 9e99edb8 by Raymond Toy at 2016-11-28T21:14:27-08:00 Add test for issue 26 Basically used the repro case from the issue. - - - - - 2 changed files: - src/lisp/os-common.c - tests/issues.lisp Changes: ===================================== src/lisp/os-common.c ===================================== --- a/src/lisp/os-common.c +++ b/src/lisp/os-common.c @@ -6,11 +6,11 @@ */ #include <errno.h> +#include <math.h> #include <netdb.h> #include <stdio.h> #include <string.h> #include <time.h> -#include <math.h> #include "os.h" #include "internals.h" @@ -568,7 +568,8 @@ int ieee754_rem_pio2(double x, double *y0, double *y1) /* * sleep for the given number of seconds, even if we're interrupted. */ -void os_sleep(double seconds) +void +os_sleep(double seconds) { struct timespec requested; struct timespec remaining; @@ -577,7 +578,12 @@ void os_sleep(double seconds) fractional = modf(seconds, &integral); requested.tv_sec = (time_t) integral; - requested.tv_nsec = (long) trunc(fractional * 1e9); + /* + * Round up just in case; it's probably better to sleep slightly + * too long than to sleep for too short a time. + */ + requested.tv_nsec = (long) ceil(fractional * 1e9); + while (nanosleep(&requested, &remaining) == -1 && errno == EINTR) { requested = remaining; } ===================================== tests/issues.lisp ===================================== --- a/tests/issues.lisp +++ b/tests/issues.lisp @@ -347,3 +347,14 @@ (assert (null (set-difference directories '(".dir" "dir") :test #'string-equal))))) + +(define-test issue.26 + (:tag :issues) + (let ((start-time (get-universal-time))) + (let ((p (ext:run-program "/usr/bin/env" '("sleep" "1") :wait nil))) + (declare (ignore p)) + (sleep 5) + ;; We expect to have slept for at least 5 sec, but since + ;; get-universal-time only has an accuracy of 1 sec, just verify + ;; more than 3 sec have elapsed. + (assert-true (>= (- (get-universal-time) start-time) 3))))) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/compare/e5777ecb2f2581f6788f7136…

1 0

[Git][cmucl/cmucl] Pushed new branch rtoy-issue-26
by Raymond Toy 29 Nov '16

29 Nov '16

Raymond Toy pushed new branch rtoy-issue-26 at cmucl / cmucl

1 0

[Git][cmucl/cmucl] Pushed new branch rtoy-tex2page
by Raymond Toy 14 Nov '16

14 Nov '16

Raymond Toy pushed new branch rtoy-tex2page at cmucl / cmucl

1 0

[Git][cmucl/cmucl][master] Fix #36: encode-universal-time errors on valid time
by Raymond Toy 11 Nov '16

11 Nov '16

Raymond Toy pushed to branch master at cmucl / cmucl Commits: 0e172b4b by Raymond Toy at 2016-11-10T19:13:53-08:00 Fix #36: encode-universal-time errors on valid time Allow 1899 as a year, but also add a check that the resulting time is a non-negative integer. Add a test for this too in issues.lisp. - - - - - 2 changed files: - src/code/time.lisp - tests/issues.lisp Changes: ===================================== src/code/time.lisp ===================================== --- a/src/code/time.lisp +++ b/src/code/time.lisp @@ -223,8 +223,11 @@ (type (mod 24) hour) (type (integer 1 31) date) (type (integer 1 12) month) - (type (or (integer 0 99) (integer 1900)) year) - (type (or null rational) time-zone)) + ;; 1899 to account for time zones that are equivalent to 1900. + (type (or (integer 0 99) (integer 1899)) year) + (type (or null rational) time-zone) + ;; Result must be non-negative integer! + (values (integer 0))) (let* ((year (if (< year 100) (pick-obvious-year year) year)) ===================================== tests/issues.lisp ===================================== --- a/tests/issues.lisp +++ b/tests/issues.lisp @@ -347,3 +347,8 @@ (assert (null (set-difference directories '(".dir" "dir") :test #'string-equal))))) + +(define-test issue.36 + (:tag :issues) + (loop for k from 1 to 24 do + (assert-equal 0 (encode-universal-time 0 0 (- 24 k) 31 12 1899 k)))) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/0e172b4b2d6dc5a6dd016c080…

1 0