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

Modified Files:
	los0.lisp 
Log Message:
Various fiddling with testing functions etc.

Date: Tue Sep 21 15:11:08 2004
Author: ffjeld

Index: movitz/losp/los0.lisp
diff -u movitz/losp/los0.lisp:1.21 movitz/losp/los0.lisp:1.22
--- movitz/losp/los0.lisp:1.21	Wed Sep 15 12:22:57 2004
+++ movitz/losp/los0.lisp	Tue Sep 21 15:11:08 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.21 2004/09/15 10:22:57 ffjeld Exp $
+;;;; $Id: los0.lisp,v 1.22 2004/09/21 13:11:08 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -988,8 +988,9 @@
   (muerte::with-bochs-tracing ()
     (eval form)))
 
-(muerte.toplevel:define-toplevel-command :mapkey (code-char)
-  (let ((char (etypecase code-char
+(muerte.toplevel:define-toplevel-command :mapkey (code-char-form)
+  (let* ((code-char (eval code-char-form))
+	 (char (etypecase code-char
 		(character code-char)
 		(integer (code-char code-char)))))
     (format t "~&Hit the (single) key you want to map to ~S..." char)
@@ -1083,7 +1084,7 @@
 (defun test-clc (&optional timeout)
   (test-timer timeout)
   (loop
-    (clc::test-clc)))
+    (funcall (find-symbol (string :test-clc) :clc))))
 
 (defun test-timer (&optional timeout)
   (setf (exception-handler 32)
@@ -1128,7 +1129,7 @@
 		       (current-stack-frame))
       (setf *timer-stack* (muerte::copy-current-control-stack))
       (setf (pit8253-timer-mode 0) +pit8253-mode-single-timeout+
-	    (pit8253-timer-count 0) (or timeout (+ 10 (random 4000))))
+	    (pit8253-timer-count 0) (or timeout (+ 5 (random 2000))))
       (with-inline-assembly (:returns :nothing)
 	(:compile-form (:result-mode :ecx) muerte.x86-pc::*screen*)
 	(:shrl 2 :ecx)
@@ -1140,7 +1141,7 @@
     (:shrl 2 :ecx)
     ((:gs-override) :movw #x4646 (:ecx 158)))
   (setf (pit8253-timer-mode 0) +pit8253-mode-single-timeout+
-	(pit8253-timer-count 0) (or timeout (+ 10 (random 4000))))
+	(pit8253-timer-count 0) (or timeout (+ 10 (random 1000))))
   (setf (pic8259-irq-mask) #xfffe)
   (pic8259-end-of-interrupt 0)
   (with-inline-assembly (:returns :nothing) (:sti))
@@ -1163,14 +1164,20 @@
     ))
 
 (defun test-throwing (&optional (x #xffff))
-  (test-timer x)
+  (when x
+    (test-timer x))
   (loop
     (catch 'foo
-      (funcall (lambda ()
-		 (unless (logbitp 9 (eflags))
-		   (break "Someone switched off interrupts!"))
-		 (incf (memref-int muerte.x86-pc::*screen* 0 0 :unsigned-byte16 t))
-		 (throw 'foo nil))))))
+      (unwind-protect 
+	  (funcall (lambda ()
+		     (unwind-protect
+			 (progn
+;;;			   (unless (logbitp 9 (eflags))
+;;;			     (break "Someone switched off interrupts!"))
+			   (incf (memref-int muerte.x86-pc::*screen* 0 0 :unsigned-byte16 t))
+			   (throw 'foo 'inner-peace))
+		       (incf (memref-int muerte.x86-pc::*screen* 0 80 :unsigned-byte16 t)))))
+	(incf (memref-int muerte.x86-pc::*screen* 0 160 :unsigned-byte16 t))))))
 
 
 (defun genesis ()
@@ -1203,7 +1210,7 @@
       (setf *package* (find-package "INIT"))
       (clos-bootstrap)
       (when muerte::*multiboot-data*
-	(set-textmode +vga-state-90x60+))
+	(set-textmode +vga-state-90x30+))
       
       (cond
        ((not (cpu-featurep :tsc))