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

Modified Files:
	los0.lisp 
Log Message:
Added the pci.lisp file.

Date: Fri Apr 23 11:04:07 2004
Author: ffjeld

Index: movitz/losp/los0.lisp
diff -u movitz/losp/los0.lisp:1.12 movitz/losp/los0.lisp:1.13
--- movitz/losp/los0.lisp:1.12	Fri Apr 23 09:00:08 2004
+++ movitz/losp/los0.lisp	Fri Apr 23 11:04:07 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.12 2004/04/23 13:00:08 ffjeld Exp $
+;;;; $Id: los0.lisp,v 1.13 2004/04/23 15:04:07 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -627,43 +627,38 @@
 
 ;;;;;;;;;;;;;;; CL
 
-(defun install-internal-time ()
+(defun install-internal-time (&optional (minimum-frequency 100))
   "Figure out this CPU's internal-time-unit. Warning: This process takes about 1.5 seconds."
-  (if (not (cpu-featurep :tsc))
-      (warn "This CPU has no time-stamp-counter. Timer-related functions will not work.")
-    (let ((s0 (loop with x = (rtc-register :second)
-		  for s0 = (rtc-register :second)
-		  while (= x s0)
-		  finally (return s0))))
-      (multiple-value-bind (c0-lo c0-hi)
+  (let ((s0 (loop with x = (rtc-register :second)
+		for s0 = (rtc-register :second)
+		while (= x s0)
+		finally (return s0))))
+    (multiple-value-bind (c0-lo c0-hi)
+	(read-time-stamp-counter)
+      (loop while (= s0 (rtc-register :second)))
+      (multiple-value-bind (c1-lo c1-hi)
 	  (read-time-stamp-counter)
-	(loop while (= s0 (rtc-register :second)))
-	(multiple-value-bind (c1-lo c1-hi)
-	    (read-time-stamp-counter)
-	  (let ((res (+ (ash (- c1-hi c0-hi) 12)
-			(ash (- c1-lo c0-lo) -17))))
-	    (cond
-	     ((> res 100)
+	(let ((res (+ (ash (ldb (byte 22 0) (- c1-hi c0-hi)) 7)
+		      (ash (- c1-lo c0-lo) -22))))
+	  (cond
+	   ((> res minimum-frequency)
+	    (setf (symbol-function 'get-internal-run-time)
+	      (lambda ()
+		(multiple-value-bind (lo hi)
+		    (read-time-stamp-counter)
+		  (+ (ash lo -22)
+		     (ash (ldb (byte 22 0) hi) 7)))))
+	    (setf internal-time-units-per-second res))
+	   (t ;; This is for really slow machines, like bochs..
+	    (let ((res (+ (ash (- c1-hi c0-hi) 13)
+			  (ash (- c1-lo c0-lo) -16))))
 	      (setf (symbol-function 'get-internal-run-time)
 		(lambda ()
 		  (multiple-value-bind (lo hi)
 		      (read-time-stamp-counter)
-		    (+ (ash lo -17) 
-		       (ash (ldb (byte 10 0) hi) 12)))))
-	      (setf internal-time-units-per-second res))
-	     (t ;; This is for really slow machines, like bochs..
-	      (let ((res (+ (ash (- c1-hi c0-hi) 15)
-			    (ash (- c1-lo c0-lo) -14))))
-		(setf (symbol-function 'get-internal-run-time)
-		  (lambda ()
-		    (multiple-value-bind (lo hi)
-			(read-time-stamp-counter)
-		      (+ (ash lo -14) 
-			 (ash (ldb (byte 10 0) hi) 15)))))
-		(setf internal-time-units-per-second res)))))))
-      (warn "Internal-time will wrap in ~D days."
-	    (truncate most-positive-fixnum
-		      (* internal-time-units-per-second 60 60 24))))))
+		    (+ (ash (ldb (byte 16 0) hi) 13) 
+		       (ash lo -16)))))
+	      (setf internal-time-units-per-second res)))))))))
 
 
 ;;;(defun get-internal-run-time ()
@@ -865,9 +860,7 @@
     (incf extended-memsize (io-port #x71 :unsigned-byte8))
     (format t "Extended memory: ~D KB" extended-memsize))
 
-;;;  (loop for i from  #x40600 below #x80000
-;;;      do (setf (memref i 0 0 :unsigned-byte32) #xababe13))
-
+  (idt-init)
   (install-los0-consing)
   
   (let ((*repl-readline-context* (make-readline-context :history-size 16))
@@ -875,17 +868,22 @@
 	#+ignore (*error-no-condition-for-debugger* t)
 	(*debugger-function* #'los0-debugger)
 	(*package* nil))
-    (with-simple-restart (continue "Abort LOS0 boot-up initialization.")
+    (with-simple-restart (abort "Skip Los0 boot-up initialization.")
       (setf *cpu-features*
 	(find-cpu-features))
       (format t "~&CPU features:~:[ none~;~{ ~A~#[~; and~:;,~]~}~].~%"
 	      *cpu-features* *cpu-features*)
-      (install-internal-time)
-      (funcall #'idt-init)
       ;; (muerte:asm :int 49)
 
       (setf *package* (find-package "INIT"))
       (clos-bootstrap)
+      (cond
+       ((not (cpu-featurep :tsc))
+	(warn "This CPU has no time-stamp-counter. Timer-related functions will not work."))
+       (t (install-internal-time)
+	  (warn "Internal-time will wrap in ~D days."
+		(truncate most-positive-fixnum
+			  (* internal-time-units-per-second 60 60 24)))))
       ;; (muerte.toplevel:invoke-toplevel-command :mapkey #\newline)
       #+ignore (let ((s (make-instance 'muerte.x86-pc:vga-text-console)))
 		 (setf *standard-output* s