[movitz-cvs] CVS update: movitz/losp/los0.lisp
Frode Vatvedt Fjeld
ffjeld at common-lisp.net
Tue Jul 13 02:39:13 UTC 2004
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
More information about the Movitz-cvs
mailing list