movitz-cvs

Download

movitz-cvs@common-lisp.net

April 2005

1 participants
62 discussions

[movitz-cvs] CVS update: movitz/losp/muerte/segments.lisp
by ffjeld＠common-lisp.net 13 Apr '05

13 Apr '05

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv2998 Modified Files: segments.lisp Log Message: Added segment-descriptor-xxx accessors. Date: Wed Apr 13 08:43:14 2005 Author: ffjeld Index: movitz/losp/muerte/segments.lisp diff -u movitz/losp/muerte/segments.lisp:1.5 movitz/losp/muerte/segments.lisp:1.6 --- movitz/losp/muerte/segments.lisp:1.5 Fri Apr 8 08:17:28 2005 +++ movitz/losp/muerte/segments.lisp Wed Apr 13 08:43:12 2005 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Thu May 8 14:25:06 2003 ;;;; -;;;; $Id: segments.lisp,v 1.5 2005/04/08 06:17:28 ffjeld Exp $ +;;;; $Id: segments.lisp,v 1.6 2005/04/13 06:43:12 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -50,7 +50,7 @@ (:gs (set-sreg :gs)))) value) -(defun sgdt () +(defun %sgdt () "Return the location of the GDT, and the limit. Error if the GDT location is not zero modulo 4." (eval-when (:compile-toplevel) @@ -74,7 +74,7 @@ (:movl 2 :ecx) (:stc))) -(defun lgdt (base-location limit) +(defun %lgdt (base-location limit) "Set the GDT according to base-location and limit. This is the setter corresponding to the sgdt getter." (eval-when (:compile-toplevel) @@ -162,4 +162,67 @@ (:cr4 (set-creg :cr4))) value)) - +(defun segment-descriptor-base (table index) + (check-type table (and vector (not simple-vector))) + (let ((offset (+ (* index 8) (movitz-type-slot-offset 'movitz-basic-vector 'data)))) + (logior (ash (memref table (+ 7 offset) :type :unsigned-byte8) + 24) + (ash (memref table (+ 4 offset) :type :unsigned-byte16) + 16) + (ash (memref table (+ 2 offset) :type :unsigned-byte16) + 0)))) + +(defun (setf segment-descriptor-base) (base table index) + (check-type table (and vector (not simple-vector))) + (let ((offset (+ (* index 8) (movitz-type-slot-offset 'movitz-basic-vector 'data)))) + (setf (memref table (+ 7 offset) :type :unsigned-byte8) + (ldb (byte 8 24) base)) + (setf (memref table (+ 4 offset) :type :unsigned-byte8) + (ldb (byte 8 16) base)) + (setf (memref table (+ 2 offset) :type :unsigned-byte16) + (ldb (byte 16 0) base)) + base)) + +(defun segment-descriptor-limit (table index) + (check-type table (and vector (not simple-vector))) + (let ((offset (+ (* index 8) (movitz-type-slot-offset 'movitz-basic-vector 'data)))) + (dpb (memref table (+ 6 offset) :type :unsigned-byte8) + (byte 4 16) + (memref table (+ 0 offset) :type :unsigned-byte16)))) + +(defun (setf segment-descriptor-limit) (limit table index) + (check-type table (and vector (not simple-vector))) + (let ((offset (+ (* index 8) (movitz-type-slot-offset 'movitz-basic-vector 'data)))) + (setf (memref table (+ 6 offset) :type :unsigned-byte8) + (ldb (byte 4 16) limit)) + (setf (memref table (+ 0 offset) :type :unsigned-byte8) + (ldb (byte 16 0) limit)) + limit)) + +(defun segment-descriptor-type-s-dpl-p (table index) + "Access bits 40-47 of the segment descriptor." + (check-type table (and vector (not simple-vector))) + (memref table (+ 5 (* index 8) (movitz-type-slot-offset 'movitz-basic-vector 'data)) + :type :unsigned-byte8)) + +(defun (setf segment-descriptor-type-s-dpl-p) (bits table index) + "Access bits 40-47 of the segment descriptor." + (check-type table (and vector (not simple-vector))) + (setf (memref table (+ 5 (* index 8) (movitz-type-slot-offset 'movitz-basic-vector 'data)) + :type :unsigned-byte8) + bits)) + +(defun segment-descriptor-avl-x-db-g (table index) + "Access bits 52-55 of the segment descriptor." + (check-type table (and vector (not simple-vector))) + (ldb (byte 4 4) + (memref table (+ 5 (* index 8) (movitz-type-slot-offset 'movitz-basic-vector 'data)) + :type :unsigned-byte8))) + +(defun (setf segment-descriptor-avl-x-db-g) (bits table index) + "Access bits 52-55 of the segment descriptor." + (check-type table (and vector (not simple-vector))) + (setf (ldb (byte 4 4) + (memref table (+ 5 (* index 8) (movitz-type-slot-offset 'movitz-basic-vector 'data)) + :type :unsigned-byte8)) + bits))

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/segments.lisp
by ffjeld＠common-lisp.net 08 Apr '05

08 Apr '05

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv3249 Modified Files: segments.lisp Log Message: *** empty log message *** Date: Fri Apr 8 08:17:29 2005 Author: ffjeld Index: movitz/losp/muerte/segments.lisp diff -u movitz/losp/muerte/segments.lisp:1.4 movitz/losp/muerte/segments.lisp:1.5 --- movitz/losp/muerte/segments.lisp:1.4 Thu Oct 21 22:51:13 2004 +++ movitz/losp/muerte/segments.lisp Fri Apr 8 08:17:28 2005 @@ -1,6 +1,6 @@ ;;;;------------------------------------------------------------------ ;;;; -;;;; Copyright (C) 2001, 2003-2004, +;;;; Copyright (C) 2001, 2003-2005, ;;;; Department of Computer Science, University of Tromso, Norway. ;;;; ;;;; For distribution policy, see the accompanying file COPYING. @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Thu May 8 14:25:06 2003 ;;;; -;;;; $Id: segments.lisp,v 1.4 2004/10/21 20:51:13 ffjeld Exp $ +;;;; $Id: segments.lisp,v 1.5 2005/04/08 06:17:28 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -18,13 +18,13 @@ (in-package muerte) -(defun segment-register (segment-register) +(defun segment-register-name (segment-register-name) "Return the value of an x86 segment register, such as :cs or :ds." (macrolet ((sreg (reg) `(with-inline-assembly (:returns :untagged-fixnum-ecx) (:xorl :ecx :ecx) (:movw ,reg :cx)))) - (ecase segment-register + (ecase segment-register-name (:ss (sreg :ss)) (:cs (sreg :cs)) (:ds (sreg :ds)) @@ -32,7 +32,7 @@ (:fs (sreg :fs)) (:gs (sreg :gs))))) -(defun (setf segment-register) (value segment-register) +(defun (setf segment-register-name) (value segment-register-name) "This function indiscriminately sets a segment register, which is a great way to crash the machine. So know what you're doing." (check-type value (unsigned-byte 16)) @@ -41,7 +41,7 @@ (:compile-form (:result-mode :ecx) value) (:shrl #.movitz::+movitz-fixnum-shift+ :ecx) (:movw :cx ,reg)))) - (ecase segment-register + (ecase segment-register-name (:ss (set-sreg :ss)) (:cs (set-sreg :cs)) (:ds (set-sreg :ds))

1 0