[movitz-cvs] CVS update: movitz/losp/los0.lisp

[Frode Vatvedt Fjeld]

Update of /project/movitz/cvsroot/movitz/losp
In directory common-lisp.net:/tmp/cvs-serv22689

Modified Files:
	los0.lisp 
Log Message:
Minor edits. Added a rather bad implementation of random.

Date: Mon Jul 12 19:39:13 2004
Author: ffjeld

Index: movitz/losp/los0.lisp
diff -u movitz/losp/los0.lisp:1.18 movitz/losp/los0.lisp:1.19
--- movitz/losp/los0.lisp:1.18	Mon Jul 12 01:41:23 2004
+++ movitz/losp/los0.lisp	Mon Jul 12 19:39:13 2004
@@ -9,7 +9,7 @@
 ;;;; Created at:    Fri Dec  1 18:08:32 2000
 ;;;; Distribution:  See the accompanying file COPYING.
 ;;;;                
-;;;; $Id: los0.lisp,v 1.18 2004/07/12 08:41:23 ffjeld Exp $
+;;;; $Id: los0.lisp,v 1.19 2004/07/13 02:39:13 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -114,9 +114,6 @@
 ;;;    (:leal (:edi -4) :eax)
 ;;;    (:rorb :cl :al)))
 
-(defun foo (x)
-  (foo x x))
-
 
 #+ignore
 (defun test-block (x)
@@ -299,13 +296,6 @@
 	    (- (object-location bar) (object-location result))))
     (values foo result bar)))
 
-(defun foo (number &rest more-numbers)
-  (declare (dynamic-extent more-numbers))
-  (do ((p more-numbers (cdr p)))
-      ((not (cdr p)) number)
-    (unless (< (car p) (cadr p))
-      (return nil))))
-
 (defun modx (x)
   (lambda ()
     (print x)))
@@ -693,12 +683,6 @@
 (defun test-nano-sleep (x)
   (time (nano-sleep x)))
 
-(defun mvtest ()
-  (multiple-value-call #'list (round 5 2))
-  (list (memref-int #x1000000 0 0 :unsigned-byte8)
-	(memref-int #x1000004 0 0 :unsigned-byte8)))
-
-
 ;;;;;
 
 ;;;;;;;;;;;;;;; CL
@@ -974,6 +958,20 @@
     (loop
       (with-simple-restart (abort "Abort to command level ~D." (1+ *repl-level*))
 	(read-eval-print)))))
+
+(defun random (limit)
+  (etypecase limit
+    (fixnum
+     (rem (read-time-stamp-counter) limit))
+    (muerte::positive-bignum
+     (let ((x (muerte::copy-bignum limit)))
+       (dotimes (i (1- (muerte::%bignum-bigits x)))
+	 (setf (memref x 2 i :unsigned-byte32)
+	   (muerte::read-time-stamp-counter)))
+       (setf x (muerte::%bignum-canonicalize x))
+       (loop while (>= x limit)
+	   do (setf x (truncate x 2)))
+       x))))
 
 (defun genesis ()
   #+ignore