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

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

14 Aug '05

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv22106 Modified Files: arrays.lisp Log Message: Fixed array-dimensions, added array-rank. Date: Sun Aug 14 13:35:52 2005 Author: ffjeld Index: movitz/losp/muerte/arrays.lisp diff -u movitz/losp/muerte/arrays.lisp:1.53 movitz/losp/muerte/arrays.lisp:1.54 --- movitz/losp/muerte/arrays.lisp:1.53 Sat Jun 11 02:01:56 2005 +++ movitz/losp/muerte/arrays.lisp Sun Aug 14 13:35:52 2005 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Sun Feb 11 23:14:04 2001 ;;;; -;;;; $Id: arrays.lisp,v 1.53 2005/06/11 00:01:56 ffjeld Exp $ +;;;; $Id: arrays.lisp,v 1.54 2005/08/14 11:35:52 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -134,8 +134,17 @@ (memref array (movitz-type-slot-offset 'movitz-basic-vector 'num-elements))))) (defun array-dimensions (array) + (let (r) + (dotimes (d (array-rank array)) + (push (array-dimension array d) r)) + (nreverse r))) + +(defun array-rank (array) (etypecase array - (vector 1))) + (indirect-vector + 1) + ((simple-array * 1) + 1))) (defun shrink-vector (vector new-size) (check-type vector vector)

1 0

[movitz-cvs] CVS update: ia-x86/operands.lisp
by ffjeld＠common-lisp.net 13 Aug '05

13 Aug '05

Update of /project/movitz/cvsroot/ia-x86 In directory common-lisp.net:/tmp/cvs-serv28778 Modified Files: operands.lisp Log Message: Don't sign-extend already sign-extended displacement. Date: Sat Aug 13 22:31:51 2005 Author: ffjeld Index: ia-x86/operands.lisp diff -u ia-x86/operands.lisp:1.5 ia-x86/operands.lisp:1.6 --- ia-x86/operands.lisp:1.5 Thu Sep 2 11:01:44 2004 +++ ia-x86/operands.lisp Sat Aug 13 22:31:51 2005 @@ -1,6 +1,6 @@ ;;;;------------------------------------------------------------------ ;;;; -;;;; Copyright (C) 20012000, 2002-2004, +;;;; Copyright (C) 20012000, 2002-2005, ;;;; Department of Computer Science, University of Tromso, Norway ;;;; ;;;; Filename: operands.lisp @@ -9,7 +9,7 @@ ;;;; Created at: Wed Feb 16 14:02:57 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: operands.lisp,v 1.5 2004/09/02 09:01:44 ffjeld Exp $ +;;;; $Id: operands.lisp,v 1.6 2005/08/13 20:31:51 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -945,7 +945,7 @@ operand (setf register (decode-set (find-register-decode-set 'r/m32-01) r/m) - offset (realpart (sign-extend-complex displacement))))) + offset (realpart displacement)))) (values operand)) (defmethod operand-encode ((operand operand-indirect-register) @@ -1687,7 +1687,7 @@ (with-slots (offset) operand (setf offset - (realpart (sign-extend-complex (slot-value instr-symbolic 'displacement))))) + (realpart (slot-value instr-symbolic 'displacement)))) (values operand)) (defmethod operand-encode ((operand operand-rel-pointer)

1 0

[movitz-cvs] CVS update: ia-x86/codec.lisp
by ffjeld＠common-lisp.net 13 Aug '05

13 Aug '05

Update of /project/movitz/cvsroot/ia-x86 In directory common-lisp.net:/tmp/cvs-serv27770 Modified Files: codec.lisp Log Message: Sign-extend the displacement part of an instruction when decoding it. Date: Sat Aug 13 22:24:05 2005 Author: ffjeld Index: ia-x86/codec.lisp diff -u ia-x86/codec.lisp:1.6 ia-x86/codec.lisp:1.7 --- ia-x86/codec.lisp:1.6 Thu Sep 2 11:01:19 2004 +++ ia-x86/codec.lisp Sat Aug 13 22:24:04 2005 @@ -1,6 +1,6 @@ ;;;;------------------------------------------------------------------ ;;;; -;;;; Copyright (C) 2000, 2001, 2002, 2004, +;;;; Copyright (C) 2000, 2001, 2002, 2004-2005, ;;;; Department of Computer Science, University of Tromso, Norway ;;;; ;;;; Filename: codec.lisp @@ -9,7 +9,7 @@ ;;;; Created at: Thu May 4 15:16:45 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: codec.lisp,v 1.6 2004/09/02 09:01:19 ffjeld Exp $ +;;;; $Id: codec.lisp,v 1.7 2005/08/13 20:24:04 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -701,11 +701,12 @@ (incf byte-pos (template-instr-immediate-numo template)) ;; displacement (setf (instr-symbolic-displacement is) - (complex (change-endian (ldb (byte (* 8 (template-instr-displacement-numo template)) - (* 8 byte-pos)) - datum) - (template-instr-displacement-numo template)) - (template-instr-displacement-numo template))) + (sign-extend-complex + (complex (change-endian (ldb (byte (* 8 (template-instr-displacement-numo template)) + (* 8 byte-pos)) + datum) + (template-instr-displacement-numo template)) + (template-instr-displacement-numo template)))) (incf byte-pos (template-instr-displacement-numo template)) ;; SIB (when (template-instr-sib-p template)

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/io-port.lisp
by ffjeld＠common-lisp.net 12 Aug '05

12 Aug '05

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv7409 Modified Files: io-port.lisp Log Message: Added (setf (io-port :unsigned-byte32)). Date: Sat Aug 13 00:55:43 2005 Author: ffjeld Index: movitz/losp/muerte/io-port.lisp diff -u movitz/losp/muerte/io-port.lisp:1.15 movitz/losp/muerte/io-port.lisp:1.16 --- movitz/losp/muerte/io-port.lisp:1.15 Sat Aug 13 00:50:22 2005 +++ movitz/losp/muerte/io-port.lisp Sat Aug 13 00:55:43 2005 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Wed Mar 21 22:14:08 2001 ;;;; -;;;; $Id: io-port.lisp,v 1.15 2005/08/12 22:50:22 ffjeld Exp $ +;;;; $Id: io-port.lisp,v 1.16 2005/08/12 22:55:43 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -169,6 +169,19 @@ (:movl :edi :eax) (:cld)) ,value-var)) + (:unsigned-byte32 + `(let ((,value-var ,value) + (,port-var ,port)) + (with-inline-assembly (:returns :untagged-fixnum-ecx) + (:load-lexical (:lexical-binding ,port-var) :edx) + (:load-lexical (:lexical-binding ,value-var) :untagged-fixnum-ecx) + (:std) + (:shrl ,movitz::+movitz-fixnum-shift+ :edx) + (:movl :ecx :eax) + (:outl :eax :dx) + (:movl :edi :edx) + (:movl :edi :eax) + (:cld)))) (:character `(let ((,value-var ,value) (,port-var ,port)) @@ -190,7 +203,9 @@ (:unsigned-byte8 (setf (io-port port :unsigned-byte8) value)) (:unsigned-byte16 - (setf (io-port port :unsigned-byte8) value)) + (setf (io-port port :unsigned-byte16) value)) + (:unsigned-byte32 + (setf (io-port port :unsigned-byte32) value)) (:character (setf (io-port port :character) value))))

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/io-port.lisp
by ffjeld＠common-lisp.net 12 Aug '05

12 Aug '05

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv7371 Modified Files: io-port.lisp Log Message: Added (io-port :unsigned-byte32). Date: Sat Aug 13 00:50:23 2005 Author: ffjeld Index: movitz/losp/muerte/io-port.lisp diff -u movitz/losp/muerte/io-port.lisp:1.14 movitz/losp/muerte/io-port.lisp:1.15 --- movitz/losp/muerte/io-port.lisp:1.14 Sat Aug 13 00:44:10 2005 +++ movitz/losp/muerte/io-port.lisp Sat Aug 13 00:50:22 2005 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Wed Mar 21 22:14:08 2001 ;;;; -;;;; $Id: io-port.lisp,v 1.14 2005/08/12 22:44:10 ffjeld Exp $ +;;;; $Id: io-port.lisp,v 1.15 2005/08/12 22:50:22 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -46,6 +46,16 @@ (:shll ,movitz:+movitz-fixnum-shift+ :eax) (:movl :edi :edx) (:cld))) + (:unsigned-byte32 + `(with-inline-assembly (:returns :untagged-fixnum-ecx) + (:compile-form (:result-mode :edx) ,port) + (:std) + (:shrl ,movitz::+movitz-fixnum-shift+ :edx) + (:inl :dx :eax) + (:movl :eax :ecx) + (:movl :edi :eax) + (:movl :edi :edx) + (:cld))) (:character `(with-inline-assembly (:returns :eax) (:compile-form (:result-mode :edx) ,port) @@ -64,6 +74,8 @@ (io-port port :unsigned-byte8)) (:unsigned-byte16 (io-port port :unsigned-byte16)) + (:unsigned-byte32 + (io-port port :unsigned-byte32)) (:character (io-port port :character))))

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/io-port.lisp
by ffjeld＠common-lisp.net 12 Aug '05

12 Aug '05

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv6387 Modified Files: io-port.lisp Log Message: Changed with-io-register-syntax to accept optional type argument. Date: Sat Aug 13 00:44:10 2005 Author: ffjeld Index: movitz/losp/muerte/io-port.lisp diff -u movitz/losp/muerte/io-port.lisp:1.13 movitz/losp/muerte/io-port.lisp:1.14 --- movitz/losp/muerte/io-port.lisp:1.13 Wed Mar 2 18:15:43 2005 +++ movitz/losp/muerte/io-port.lisp Sat Aug 13 00:44:10 2005 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Wed Mar 21 22:14:08 2001 ;;;; -;;;; $Id: io-port.lisp,v 1.13 2005/03/02 17:15:43 ffjeld Exp $ +;;;; $Id: io-port.lisp,v 1.14 2005/08/12 22:44:10 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -206,7 +206,8 @@ `(let ((,io-var ,io-base-form)) ;; (check-type ,io-var (unsigned-byte 16)) (symbol-macrolet ((,name ,io-var)) - (macrolet ((,name (offset) `(io-register8 ,',io-var ,offset))) + (macrolet ((,name (offset &optional (type :unsigned-byte8)) + `(io-port (+ ,',io-var ,offset) ,type))) ,@body))))) (define-compiler-macro io-register8x2 (io-base offset-hi offset-lo)

1 0

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

12 Aug '05

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv1749 Modified Files: integers.lisp Log Message: Fixed logand to deal with e.g. (logand #x-10 #x1234567345). Date: Fri Aug 12 23:37:43 2005 Author: ffjeld Index: movitz/losp/muerte/integers.lisp diff -u movitz/losp/muerte/integers.lisp:1.106 movitz/losp/muerte/integers.lisp:1.107 --- movitz/losp/muerte/integers.lisp:1.106 Tue May 24 08:33:24 2005 +++ movitz/losp/muerte/integers.lisp Fri Aug 12 23:37:42 2005 @@ -9,7 +9,7 @@ ;;;; Created at: Wed Nov 8 18:44:57 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: integers.lisp,v 1.106 2005/05/24 06:33:24 ffjeld Exp $ +;;;; $Id: integers.lisp,v 1.107 2005/08/12 21:37:42 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -1559,6 +1559,16 @@ (:compile-form (:result-mode :eax) x) (:leal ((:ecx ,movitz:+movitz-fixnum-factor+)) :ecx) (:andl :ecx :eax))) + ((fixnum positive-bignum) + (let ((result (copy-bignum y))) + (with-inline-assembly (:returns :eax) + (:compile-two-forms (:eax :untagged-fixnum-ecx) result x) + (:andl :ecx (:eax (:offset movitz-bignum bigit0)))))) + ((positive-bignum fixnum) + (let ((result (copy-bignum x))) + (with-inline-assembly (:returns :eax) + (:compile-two-forms (:eax :untagged-fixnum-ecx) result y) + (:andl :ecx (:eax (:offset movitz-bignum bigit0)))))) ((positive-bignum positive-bignum) (if (< (%bignum-bigits y) (%bignum-bigits x)) (logand y x)

1 0

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

12 Aug '05

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv29100 Modified Files: interrupt.lisp Log Message: A hack to get a hopefully good segment selector in DS for the interrupt handler. Date: Fri Aug 12 22:28:30 2005 Author: ffjeld Index: movitz/losp/muerte/interrupt.lisp diff -u movitz/losp/muerte/interrupt.lisp:1.46 movitz/losp/muerte/interrupt.lisp:1.47 --- movitz/losp/muerte/interrupt.lisp:1.46 Tue May 24 08:33:28 2005 +++ movitz/losp/muerte/interrupt.lisp Fri Aug 12 22:28:30 2005 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Wed Apr 7 01:50:03 2004 ;;;; -;;;; $Id: interrupt.lisp,v 1.46 2005/05/24 06:33:28 ffjeld Exp $ +;;;; $Id: interrupt.lisp,v 1.47 2005/08/12 20:28:30 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -116,6 +116,8 @@ (:pushl :ecx) (:movcr :cr2 :ecx) (:locally (:pushl :ecx)) + (:movw #x20 :cx) + (:movw :cx :ds) ,@(loop for reg in (sort (copy-list '(:eax :ebx :edx :esi)) #'> :key #'dit-frame-index)

1 0

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

12 Aug '05

Update of /project/movitz/cvsroot/movitz/losp/x86-pc In directory common-lisp.net:/tmp/cvs-serv4705 Modified Files: pci.lisp Log Message: tweak. Date: Fri Aug 12 08:34:37 2005 Author: ffjeld Index: movitz/losp/x86-pc/pci.lisp diff -u movitz/losp/x86-pc/pci.lisp:1.9 movitz/losp/x86-pc/pci.lisp:1.10 --- movitz/losp/x86-pc/pci.lisp:1.9 Thu Aug 11 23:17:11 2005 +++ movitz/losp/x86-pc/pci.lisp Fri Aug 12 08:34:35 2005 @@ -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.9 2005/08/11 21:17:11 ffjeld Exp $ +;;;; $Id: pci.lisp,v 1.10 2005/08/12 06:34:35 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -53,8 +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) - (ds (segment-register :gs))) +(defun pci-far-call (address &key (eax 0) (ebx 0) (ecx 0) (edx 0) (esi 0) (edi 0) + (cs 8) (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

1 0

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

11 Aug '05

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv32720 Modified Files: conditions.lisp Log Message: If there's no debugger when one is needed (during signaling), print a backtrace. Date: Thu Aug 11 23:34:27 2005 Author: ffjeld Index: movitz/losp/muerte/conditions.lisp diff -u movitz/losp/muerte/conditions.lisp:1.16 movitz/losp/muerte/conditions.lisp:1.17 --- movitz/losp/muerte/conditions.lisp:1.16 Mon May 30 00:03:04 2005 +++ movitz/losp/muerte/conditions.lisp Thu Aug 11 23:34:26 2005 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Wed Nov 20 15:47:04 2002 ;;;; -;;;; $Id: conditions.lisp,v 1.16 2005/05/29 22:03:04 ffjeld Exp $ +;;;; $Id: conditions.lisp,v 1.17 2005/08/11 21:34:26 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -280,6 +280,8 @@ (setf *debugger-function* #'muerte.init::my-debugger)) (cond ((not *debugger-function*) + (let ((*never-use-print-object* t)) + (backtrace :spartan t)) (format t "~&No debugger in *debugger-function*. Trying to continue or abort.") (invoke-restart (or (find-restart 'continue) (find-restart 'abort)

1 0