[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-serv18534

Modified Files:
	los0.lisp 
Log Message:
Have install-internal-time set up a stupd sleep function.

Date: Tue Nov 23 20:03:16 2004
Author: ffjeld

Index: movitz/losp/los0.lisp
diff -u movitz/losp/los0.lisp:1.30 movitz/losp/los0.lisp:1.31
--- movitz/losp/los0.lisp:1.30	Thu Nov 18 18:58:50 2004
+++ movitz/losp/los0.lisp	Tue Nov 23 20:03:15 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.30 2004/11/18 17:58:50 ffjeld Exp $
+;;;; $Id: los0.lisp,v 1.31 2004/11/23 19:03:15 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -46,9 +46,6 @@
 
 (in-package muerte.init)
 
-(defun xx (a b)
-  (eql b #x123456789))
-
 (defun test0 ()
   (ash 1 -1000000000000))
 
@@ -72,7 +69,7 @@
   (loop for x below 2 count (not (not (typep x t)))))
 
 (defun test4 ()
-  (let ((a 1)) (if (not (/= a 0)) a 0)))
+  (let ((aa 1)) (if (not (/= aa 0)) aa 0)))
 
 
 (defun test-floppy ()
@@ -244,13 +241,6 @@
   (break "xfuncall:~{ ~S~^,~}" args)
   (values))
 
-(defun xx ()
-  (format t "wefewf")
-  (with-inline-assembly (:returns :untagged-fixnum-ecx)
-    (:sbbl :edx :edx)
-    (:andl :edx :ecx)
-    (:leal (:edx :ecx 1) :ecx)))
-
 (defun xfoo (f) 
   (do-check-esp
       (multiple-value-bind (a b c d)
@@ -545,8 +535,11 @@
    (print 'hello-cleanup)))
 
 (defun test-cons (x)
-  (let ((c (cons x x)))
-    (cdr c)))
+  (let ((cc (cons x x)))
+    (cdr cc)))
+
+(defun xx (x)
+  (eql nil x))
 
 (defun test-fixed (x y z)
   (warn "x: ~W, y: ~W, z: ~W" x y z))
@@ -732,7 +725,7 @@
 (defclass pie2 (food)
   ((filling :accessor pie-filling 
 	    :initarg :filling
-	    :initform nil)))
+	    )))
 
 (defmethod cook ((p (eql 'pie)))
   (warn "Won't really cook a symbolic pie!")
@@ -796,7 +789,7 @@
 
 (defun init-nano-sleep ()
   (setf *cpu-frequency-mhz*
-    (truncate (assess-cpu-frequency) 100)))
+    (truncate (assess-cpu-frequency) 976)))
 
 (defun nano-sleep (nano-seconds)
   (let* ((t0 (read-time-stamp-counter))
@@ -844,7 +837,16 @@
 		      (read-time-stamp-counter)
 		    (+ (ash (ldb (byte 16 0) hi) 13) 
 		       (ash lo -16)))))
-	      (setf internal-time-units-per-second res)))))))))
+	      (setf internal-time-units-per-second res))))))))
+  (setf (symbol-function 'sleep)
+    (lambda (seconds)
+      ;; A stupid busy-waiting sleeper.
+      (check-type seconds (real 0 *))
+      (let ((start-time (get-internal-run-time)))
+	(loop with start-time = (get-internal-run-time)
+	    with end-time = (+ start-time (* seconds internal-time-units-per-second))
+	    while (< (get-internal-run-time) end-time)))))
+  (values))
 
 
 ;;;(defun get-internal-run-time ()
@@ -1260,13 +1262,15 @@
 		       (incf (memref-int muerte.x86-pc::*screen* :index 80 :type :unsigned-byte16)))))
 	(incf (memref-int muerte.x86-pc::*screen* :index 160 :type :unsigned-byte16))))))
 
-(defun mumbojumbo ()
-  (with-inline-assembly (:returns :multiple-values)
-    (:leave)
-    (:movl (:ebp -4) :esi)
-    (:break)
-    (:ret)))
-
+(defun mumbojumbo (x)
+  (with-inline-assembly (:returns :eax)
+    (:compile-form (:result-mode :untagged-fixnum-ecx) x)
+    (:movl 0 :eax)
+    (:cmpl -1 :ecx)
+    (:jno 'no-overflow)
+    (:movl 4 :eax)
+   no-overflow))
+    
 (defun genesis ()
   ;; (install-shallow-binding)
   (let ((extended-memsize 0))
@@ -1591,7 +1595,7 @@
 (define-primitive-function dynamic-variable-lookup-shallow (symbol)
   "Load the dynamic value of SYMBOL into EAX."
   (with-inline-assembly (:returns :multiple-values)
-    (:movl (:eax (:offset movitz-symbol value)) :eax)
+    (:movl (:ebx (:offset movitz-symbol value)) :eax)
     (:ret)))
 
 (define-primitive-function dynamic-variable-store-shallow (symbol value)