August 2005 - movitz-cvs@common-lisp.net - mailman3.common-lisp.net

[movitz-cvs] CVS update: movitz/losp/los0.lisp
by ffjeld＠common-lisp.net 11 Aug '05

11 Aug '05

Update of /project/movitz/cvsroot/movitz/losp In directory common-lisp.net:/tmp/cvs-serv32699 Modified Files: los0.lisp Log Message: Some cleanup regarding the segment-descriptor-table. Date: Thu Aug 11 23:33:09 2005 Author: ffjeld Index: movitz/losp/los0.lisp diff -u movitz/losp/los0.lisp:1.46 movitz/losp/los0.lisp:1.47 --- movitz/losp/los0.lisp:1.46 Fri Jun 10 00:21:08 2005 +++ movitz/losp/los0.lisp Thu Aug 11 23:33:08 2005 @@ -9,7 +9,7 @@ ;;;; Created at: Fri Dec 1 18:08:32 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: los0.lisp,v 1.46 2005/06/09 22:21:08 ffjeld Exp $ +;;;; $Id: los0.lisp,v 1.47 2005/08/11 21:33:08 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -29,9 +29,10 @@ (require :lib/net/dhcp) (require :lib/repl) -;; (require :ll-testing) (require :lib/threading) +;; (require :lice-0.1/all) + (defpackage muerte.init (:nicknames #:los0) (:use #:common-lisp @@ -134,6 +135,7 @@ (format t "error: ~S ~S" c x)))) (error "This is an error. ~S" foo)))) + (defun fooo (v w) (tagbody (print (block blurgh @@ -1317,9 +1319,24 @@ (defvar *segment-descriptor-table*) +(defun format-segment-table (table &key (start 0) (end (truncate (length table) 2))) + (loop for i from start below end + as selector = (* i 8) + do (format t "~&~3X: base: #x~8,'0X, limit: #x~5,'0X, type-s-dpl-p: ~8,'0b, avl-x-db-g: ~4,'0b~%" + selector + (* 4 (segment-descriptor-base-location table selector)) + (segment-descriptor-limit table selector) + (segment-descriptor-type-s-dpl-p table selector) + (segment-descriptor-avl-x-db-g table selector))) + (values)) + +(defun memdump (start length) + (loop for addr upfrom start repeat length + collect (memref-int addr :type :unsigned-byte8))) (defun genesis () ;; (install-shallow-binding) + (setf *debugger-function* #'los0-debugger) (let ((extended-memsize 0)) ;; Find out how much extended memory we have (setf (io-port #x70 :unsigned-byte8) #x18) @@ -1330,15 +1347,14 @@ (idt-init) -;;; (setf *segment-descriptor-table* ; Ensure we have a GDT with 16 entries, in static-space. -;;; (muerte::install-global-segment-table -;;; (muerte::dump-global-segment-table :entries 16))) - + (setf *segment-descriptor-table* ; Ensure we have a GDT with 16 entries, in static-space. + (setf (global-segment-descriptor-table) + (muerte::dump-global-segment-table :entries 16))) + (install-los0-consing :kb-size 500) #+ignore (install-los0-consing :kb-size (max 50 (truncate (- extended-memsize 2048) 2)))) - (setf *debugger-function* #'los0-debugger) (clos-bootstrap) (setf *package* (find-package "INIT")) ;; (install-shallow-binding)

1 0

[movitz-cvs] CVS update: movitz/losp/ll-testing.lisp
by ffjeld＠common-lisp.net 11 Aug '05

11 Aug '05

Update of /project/movitz/cvsroot/movitz/losp In directory common-lisp.net:/tmp/cvs-serv32680 Modified Files: ll-testing.lisp Log Message: Some cleanup regarding the segment-descriptor-table. Date: Thu Aug 11 23:33:01 2005 Author: ffjeld Index: movitz/losp/ll-testing.lisp diff -u movitz/losp/ll-testing.lisp:1.10 movitz/losp/ll-testing.lisp:1.11 --- movitz/losp/ll-testing.lisp:1.10 Sat Jun 11 01:04:45 2005 +++ movitz/losp/ll-testing.lisp Thu Aug 11 23:33:01 2005 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Thu Apr 14 08:18:43 2005 ;;;; -;;;; $Id: ll-testing.lisp,v 1.10 2005/06/10 23:04:45 ffjeld Exp $ +;;;; $Id: ll-testing.lisp,v 1.11 2005/08/11 21:33:01 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -35,19 +35,6 @@ ;;; (memref gdt-base 0 :index i :type :unsigned-byte32 :physicalp t)))) ;;; table)))) - - - -(defun format-segment-table (table &key (start 0) (end (truncate (length table) 2))) - (loop for i from start below end - as selector = (* i 8) - do (format t "~&~3X: base: #x~8,'0X, limit: #x~5,'0X, type-s-dpl-p: ~8,'0b, avl-x-db-g: ~4,'0b~%" - selector - (* 4 (segment-descriptor-base-location table selector)) - (segment-descriptor-limit table selector) - (segment-descriptor-type-s-dpl-p table selector) - (segment-descriptor-avl-x-db-g table selector))) - (values)) (defmacro control-stack-fs (stack)

1 0

[movitz-cvs] CVS update: movitz/packages.lisp
by ffjeld＠common-lisp.net 11 Aug '05

11 Aug '05

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv32664 Modified Files: packages.lisp Log Message: Some cleanup regarding the segment-descriptor-table. Date: Thu Aug 11 23:32:55 2005 Author: ffjeld Index: movitz/packages.lisp diff -u movitz/packages.lisp:1.51 movitz/packages.lisp:1.52 --- movitz/packages.lisp:1.51 Sat Jun 11 01:05:38 2005 +++ movitz/packages.lisp Thu Aug 11 23:32:55 2005 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Sat Nov 15 21:39:55 2003 ;;;; -;;;; $Id: packages.lisp,v 1.51 2005/06/10 23:05:38 ffjeld Exp $ +;;;; $Id: packages.lisp,v 1.52 2005/08/11 21:32:55 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -1264,6 +1264,9 @@ #:segment-descriptor #:segment-descriptor-base-location #:segment-descriptor-limit + #:segment-descriptor-type-s-dpl-p + #:segment-descriptor-avl-x-db-g + #:global-segment-descriptor-table #:control-register-lo12 #:control-register-hi20 #:ensure-data-vector

1 0

[movitz-cvs] CVS update: movitz/losp/x86-pc/pci.lisp
by ffjeld＠common-lisp.net 11 Aug '05

11 Aug '05

Update of /project/movitz/cvsroot/movitz/losp/x86-pc In directory common-lisp.net:/tmp/cvs-serv31583 Modified Files: pci.lisp Log Message: Fix pci-far-call to accept a value for DS, making it work with the VMWare PCI BIOS. Date: Thu Aug 11 23:17:11 2005 Author: ffjeld Index: movitz/losp/x86-pc/pci.lisp diff -u movitz/losp/x86-pc/pci.lisp:1.8 movitz/losp/x86-pc/pci.lisp:1.9 --- movitz/losp/x86-pc/pci.lisp:1.8 Tue Nov 30 15:16:57 2004 +++ movitz/losp/x86-pc/pci.lisp Thu Aug 11 23:17:11 2005 @@ -1,6 +1,6 @@ ;;;;------------------------------------------------------------------ ;;;; -;;;; Copyright (C) 2003-2004, +;;;; Copyright (C) 2003-2005, ;;;; Department of Computer Science, University of Tromsoe, Norway. ;;;; ;;;; For distribution policy, see the accompanying file COPYING. @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Sun Dec 14 22:33:42 2003 ;;;; -;;;; $Id: pci.lisp,v 1.8 2004/11/30 14:16:57 ffjeld Exp $ +;;;; $Id: pci.lisp,v 1.9 2005/08/11 21:17:11 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -53,7 +53,8 @@ (defvar *bios32-base* nil) (defvar *pcibios-entry* nil) -(defun pci-far-call (address &key (cs 8) (eax 0) (ebx 0) (ecx 0) (edx 0) (esi 0) (edi 0)) +(defun pci-far-call (address &key (cs 8) (eax 0) (ebx 0) (ecx 0) (edx 0) (esi 0) (edi 0) + (ds (segment-register :gs))) "Make a 'far call' to cs:address with the provided values for eax and ebx. Returns the boolean status of CF, and the values of registers EAX, EBX, ECX, and EDX. The stack discipline is broken during this call, so we disable interrupts @@ -71,6 +72,7 @@ (:movl (:esp) :ebp) (:locally (:movl :esp (:edi (:edi-offset :atomically-continuation)))) (:pushl :edi) ; Save EDI so we can restore it later. + (:pushw :ds) ; Ditto for DS (:load-lexical (:lexical-binding cs) :untagged-fixnum-ecx) (:pushl :ecx) ; Code segment (:load-lexical (:lexical-binding address) :untagged-fixnum-ecx) @@ -85,15 +87,19 @@ (:pushl :ecx) ; push ESI (:load-lexical (:lexical-binding edi) :untagged-fixnum-ecx) (:pushl :ecx) ; push EDI + (:load-lexical (:lexical-binding ds) :untagged-fixnum-ecx) + (:movl :ecx :ebx) (:load-lexical (:lexical-binding ecx) :untagged-fixnum-ecx) + (:movw :bx :ds) (:popl :edi) (:popl :esi) (:popl :edx) (:popl :ebx) (:popl :eax) - (:call-segment (:esp)) + ((:ss-override) :call-segment (:esp)) (:leal (:esp 8) :esp) ; Skip cs:address - (:popl :edi) ; First of all, restore EDI! + (:popw :ds) ; First of all, restore DS.. + (:popl :edi) ; .. and EDI. (:locally (:movl :edi (:edi (:edi-offset scratch2)))) (:jnc 'cf=0) (:locally (:pushl (:edi (:edi-offset t-symbol))))

1 0