From 7411acc8ffb18e842b3e0a41069bae13d14357d7 Mon Sep 17 00:00:00 2001 From: pw <pw> Date: Sat, 26 Sep 1998 18:24:42 +0000 Subject: [PATCH] SLEEP was broken for real arguments greater than one, sleeping for approximately twice as long as requested. --- code/lispinit.lisp | 11 +++++------ code/multi-proc.lisp | 7 ++++--- 2 files changed, 9 insertions(+), 9 deletions(-) diff --git a/code/lispinit.lisp b/code/lispinit.lisp index 1746b7907..fb876d696 100644 --- a/code/lispinit.lisp +++ b/code/lispinit.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/lispinit.lisp,v 1.56 1998/04/10 11:42:42 pw Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/lispinit.lisp,v 1.57 1998/09/26 18:24:42 pw Exp $") ;;; ;;; ********************************************************************** ;;; @@ -453,13 +453,12 @@ Must be a non-negative, non-complex number." n)) (multiple-value-bind (sec usec) - (if (integerp n) - (values n 0) - (values (truncate n) - (truncate (* n 1000000)))) + (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)) nil) - ;;;; SCRUB-CONTROL-STACK diff --git a/code/multi-proc.lisp b/code/multi-proc.lisp index 9cd4c5d10..d5a7c8d7e 100644 --- a/code/multi-proc.lisp +++ b/code/multi-proc.lisp @@ -1,10 +1,11 @@ +;;; -*- Mode: Lisp; Package: Multiprocessing -*- ;;; ;;; ********************************************************************** ;;; This code was written by Douglas T. Crosher and has been placed in ;;; the Public domain, and is provided 'as is'. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/multi-proc.lisp,v 1.30 1998/08/14 07:15:09 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/multi-proc.lisp,v 1.31 1998/09/26 18:24:42 pw Exp $") ;;; ;;; ********************************************************************** ;;; @@ -1518,8 +1519,8 @@ (multiple-value-bind (sec usec) (if (integerp n) (values n 0) - (values (truncate n) - (truncate (* n 1000000)))) + (multiple-value-bind (sec frac)(truncate n) + (values sec (truncate frac 1e-6)))) (unix:unix-select 0 0 0 0 sec usec)) nil) (t -- GitLab