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

Modified Files:
	los0.lisp 
Log Message:
Changed the signature of memref-int.

Date: Sun Nov 14 23:57:39 2004
Author: ffjeld

Index: movitz/losp/los0.lisp
diff -u movitz/losp/los0.lisp:1.26 movitz/losp/los0.lisp:1.27
--- movitz/losp/los0.lisp:1.26	Fri Nov 12 21:55:49 2004
+++ movitz/losp/los0.lisp	Sun Nov 14 23:57:39 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.26 2004/11/12 20:55:49 ffjeld Exp $
+;;;; $Id: los0.lisp,v 1.27 2004/11/14 22:57:39 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -351,9 +351,17 @@
 #+ignore
 (defun test-lexthrow (x)
   (apply (lambda (a b)
-	   (if (plusp a) 0 (return-from test-lexthrow (+ a b))))
+	   (unwind-protect
+	       (if (plusp a) 0 (return-from test-lexthrow (+ a b)))
+	     (warn "To serve and protect!")))
 	 x))
 
+#+ignore
+(defun test-lexgo (x)
+  (let ((*print-base* 2))
+    (return-from test-lexgo (print 123))))
+
+#+ignore
 (defun test-xgo (c x)
   (tagbody
    loop
@@ -1241,10 +1249,10 @@
 			 (progn
 ;;;			   (unless (logbitp 9 (eflags))
 ;;;			     (break "Someone switched off interrupts!"))
-			   (incf (memref-int muerte.x86-pc::*screen* 0 0 :unsigned-byte16 t))
+			   (incf (memref-int muerte.x86-pc::*screen* :type :unsigned-byte16))
 			   (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))))))
+		       (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)
@@ -1354,11 +1362,11 @@
 #+ignore
 (defun ztstring (physical-address)
   (let ((s (make-string (loop for i upfrom 0
-			    until (= 0 (memref-int physical-address 0 i :unsigned-byte8 t))
+			    until (= 0 (memref-int physical-address :index i :type :unsigned-byte8))
 			    finally (return i)))))
     (loop for i from 0 below (length s)
 	do (setf (char s i)
-	     (code-char (memref-int physical-address 0 i :unsigned-byte8 t))))
+	     (code-char (memref-int physical-address :index i :type :unsigned-byte8))))
     s))
 
 (defmacro do-default ((var &rest error-spec) &body init-forms)
@@ -1416,9 +1424,9 @@
 (defun general-protection-handler (vector dit-frame)
   (assert (= vector 13))
   (let ((eip (dit-frame-ref nil dit-frame :eip :unsigned-byte32)))
-    (assert (= #x26 (memref-int eip 0 0 :unsigned-byte8))) ; ES override prefix?
-    (let ((opcode (memref-int eip 1 0 :unsigned-byte8))
-	  (mod/rm (memref-int eip 2 0 :unsigned-byte8)))
+    (assert (= #x26 (memref-int eip :offset 0 :type :unsigned-byte8 :physicalp nil))) ; ES override prefix?
+    (let ((opcode (memref-int eip :offset 1 :type :unsigned-byte8 :physicalp nil))
+	  (mod/rm (memref-int eip :offset 2 :type :unsigned-byte8 :physicalp nil)))
       (if (not (= #x89 opcode))
 	  (interrupt-default-handler vector dit-frame)
 	(let ((value (ecase (ldb (byte 3 3) mod/rm)
@@ -1432,29 +1440,29 @@
 		(case (logand mod/rm #xc7)
 		  (#x40			; (:movl <value> (:eax <disp8>))
 		   (values (dit-frame-ref nil dit-frame :eax)
-			   (memref-int eip 3 0 :signed-byte8)))
+			   (memref-int eip :offset 3 :type :signed-byte8 :physicalp nil)))
 		  (#x43			; (:movl <value> (:ebx <disp8>))
 		   (values (dit-frame-ref nil dit-frame :ebx)
-			   (memref-int eip 3 0 :signed-byte8)))
+			   (memref-int eip :offset 3 :type :signed-byte8 :physicalp nil)))
 		  (#x44			; the disp8/SIB case
-		   (let ((sib (memref-int eip 3 0 :unsigned-byte8)))
+		   (let ((sib (memref-int eip :offset 3 :type :unsigned-byte8 :physicalp nil)))
 		     (case sib
 		       ((#x19 #x0b)
 			(values (dit-frame-ref nil dit-frame :ebx)
 				(+ (dit-frame-ref nil dit-frame :ecx :unsigned-byte8)
-				   (memref-int eip 4 0 :signed-byte8))))
+				   (memref-int eip :offset 4 :type :signed-byte8 :physicalp nil))))
 		       ((#x1a)
 			(values (dit-frame-ref nil dit-frame :ebx)
 				(+ (dit-frame-ref nil dit-frame :edx :unsigned-byte8)
-				   (memref-int eip 4 0 :signed-byte8))))))))
+				   (memref-int eip :offset 4 :type :signed-byte8 :physicalp nil))))))))
 	      (when (not object)
 		(setf (segment-register :es) (segment-register :ds))
 		(break "[~S] With value ~S, unknown movl at ~S: ~S ~S ~S ~S"
 		       dit-frame value eip
-		       (memref-int eip 1 0 :unsigned-byte8)
-		       (memref-int eip 2 0 :unsigned-byte8)
-		       (memref-int eip 3 0 :unsigned-byte8)
-		       (memref-int eip 4 0 :unsigned-byte8)))
+		       (memref-int eip :offset 1 :type :unsigned-byte8 :physicalp nil)
+		       (memref-int eip :offset 2 :type :unsigned-byte8 :physicalp nil)
+		       (memref-int eip :offset 3 :type :unsigned-byte8 :physicalp nil)
+		       (memref-int eip :offset 4 :type :unsigned-byte8 :physicalp nil)))
 	      (check-type object pointer)
 	      (check-type offset fixnum)
 	      (let ((write-barrier *write-barrier*)