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

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

17 Apr '05

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv32518 Modified Files: packages.lisp Log Message: *** empty log message *** Date: Sun Apr 17 20:18:18 2005 Author: ffjeld Index: movitz/losp/muerte/packages.lisp diff -u movitz/losp/muerte/packages.lisp:1.7 movitz/losp/muerte/packages.lisp:1.8 --- movitz/losp/muerte/packages.lisp:1.7 Tue Mar 1 00:36:08 2005 +++ movitz/losp/muerte/packages.lisp Sun Apr 17 20:18:18 2005 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Thu Aug 30 15:19:43 2001 ;;;; -;;;; $Id: packages.lisp,v 1.7 2005/02/28 23:36:08 ffjeld Exp $ +;;;; $Id: packages.lisp,v 1.8 2005/04/17 18:18:18 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -49,6 +49,13 @@ (defun assert-package (name) (or (find-package name) (error "There is no package named ~S." (string name)))) + +(defun list-all-packages () + (let (pkgs) + (maphash (lambda (k v) + (pushnew v pkgs)) + (get-global-property :packages)) + pkgs)) (defun find-symbol-string (name start end key &optional (package *package*)) (check-type name string)

1 0

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

16 Apr '05

Update of /project/movitz/cvsroot/movitz/losp In directory common-lisp.net:/tmp/cvs-serv14058 Modified Files: ll-testing.lisp Log Message: *** empty log message *** Date: Sat Apr 16 18:20:39 2005 Author: ffjeld Index: movitz/losp/ll-testing.lisp diff -u movitz/losp/ll-testing.lisp:1.1 movitz/losp/ll-testing.lisp:1.2 --- movitz/losp/ll-testing.lisp:1.1 Fri Apr 15 09:03:09 2005 +++ movitz/losp/ll-testing.lisp Sat Apr 16 18:20:38 2005 @@ -10,10 +10,11 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Thu Apr 14 08:18:43 2005 ;;;; -;;;; $Id: ll-testing.lisp,v 1.1 2005/04/15 07:03:09 ffjeld Exp $ +;;;; $Id: ll-testing.lisp,v 1.2 2005/04/16 16:20:38 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ +(provide :ll-testing) (in-package muerte) (defun dump-global-segment-table (&key table entries nofill)

1 0

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

15 Apr '05

Update of /project/movitz/cvsroot/movitz/losp In directory common-lisp.net:/tmp/cvs-serv29064 Modified Files: los0.lisp Log Message: *** empty log message *** Date: Fri Apr 15 09:04:24 2005 Author: ffjeld Index: movitz/losp/los0.lisp diff -u movitz/losp/los0.lisp:1.37 movitz/losp/los0.lisp:1.38 --- movitz/losp/los0.lisp:1.37 Wed Mar 9 08:24:54 2005 +++ movitz/losp/los0.lisp Fri Apr 15 09:04:24 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.37 2005/03/09 07:24:54 ffjeld Exp $ +;;;; $Id: los0.lisp,v 1.38 2005/04/15 07:04:24 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -27,6 +27,8 @@ ;; (require :lib/net/ip6) (require :lib/net/ip4) (require :lib/repl) + +(require :ll-testing) (defpackage muerte.init (:nicknames #:los0)

1 0

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

15 Apr '05

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv29048 Modified Files: segments.lisp Log Message: Fixed bugs in %sgdt and %lgdt. Date: Fri Apr 15 09:04:10 2005 Author: ffjeld Index: movitz/losp/muerte/segments.lisp diff -u movitz/losp/muerte/segments.lisp:1.9 movitz/losp/muerte/segments.lisp:1.10 --- movitz/losp/muerte/segments.lisp:1.9 Thu Apr 14 08:42:29 2005 +++ movitz/losp/muerte/segments.lisp Fri Apr 15 09:04:10 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.9 2005/04/14 06:42:29 ffjeld Exp $ +;;;; $Id: segments.lisp,v 1.10 2005/04/15 07:04:10 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -64,9 +64,9 @@ (:sgdt (:ecx)) (:popl :ebx) (:shrl #.(cl:- 16 movitz::+movitz-fixnum-shift+) :ebx) - (:andl #.movitz:+movitz-fixnum-zmask+ :ebx) + (:andl -4 :ebx) (:popl :eax) - (:andl #.movitz:+movitz-fixnum-zmask+ :eax) + (:andl -4 :eax) (:cld) (:movl 2 :ecx) (:stc))))

1 0

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

15 Apr '05

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv29031 Modified Files: memref.lisp Log Message: Added :physicalp option for (memref :unsigned-byte32). Date: Fri Apr 15 09:03:47 2005 Author: ffjeld Index: movitz/losp/muerte/memref.lisp diff -u movitz/losp/muerte/memref.lisp:1.44 movitz/losp/muerte/memref.lisp:1.45 --- movitz/losp/muerte/memref.lisp:1.44 Wed Mar 9 08:19:53 2005 +++ movitz/losp/muerte/memref.lisp Fri Apr 15 09:03:47 2005 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Tue Mar 6 21:25:49 2001 ;;;; -;;;; $Id: memref.lisp,v 1.44 2005/03/09 07:19:53 ffjeld Exp $ +;;;; $Id: memref.lisp,v 1.45 2005/04/15 07:03:47 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -18,12 +18,14 @@ (in-package muerte) -(define-compiler-macro memref (&whole form object offset &key (index 0) (type :lisp) - (localp nil) (endian :host) +(define-compiler-macro memref (&whole form object offset + &key (index 0) (type :lisp) (localp nil) (endian :host) + (physicalp nil) &environment env) (if (or (not (movitz:movitz-constantp type env)) (not (movitz:movitz-constantp localp env)) - (not (movitz:movitz-constantp endian env))) + (not (movitz:movitz-constantp endian env)) + (not (movitz:movitz-constantp physicalp env))) form (labels ((sub-extract-constant-delta (form) "Try to extract at compile-time an integer offset from form." @@ -69,7 +71,10 @@ (warn "o: ~S, co: ~S, i: ~S, ci: ~S" offset constant-offset index constant-index) - (let ((type (movitz:movitz-eval type env))) + (let ((type (movitz:movitz-eval type env)) + (physicalp (movitz:movitz-eval physicalp env))) + (when (and physicalp (not (eq type :unsigned-byte32))) + (warn "(memref physicalp) unsupported for type ~S." type)) (case type (:unsigned-byte8 (cond @@ -310,29 +315,32 @@ (:movl (:eax :ecx ,(offset-by 4)) :ecx) (:andl 7 :ecx))))))) (:unsigned-byte32 - (let ((endian (movitz:movitz-eval endian env))) - (assert (member endian '(:host :little)))) - (assert (= 4 movitz::+movitz-fixnum-factor+)) - (cond - ((and (eq 0 offset) (eq 0 index)) - `(with-inline-assembly (:returns :untagged-fixnum-ecx - :type (unsigned-byte 32)) - (:compile-form (:result-mode :eax) ,object) - (:movl (:eax ,(offset-by 4)) :ecx))) - ((eq 0 offset) - `(with-inline-assembly (:returns :untagged-fixnum-ecx - :type (unsigned-byte 32)) - (:compile-two-forms (:eax :ecx) ,object ,index) - (:movl (:eax :ecx ,(offset-by 4)) :ecx))) - (t (let ((object-var (gensym "memref-object-"))) - `(let ((,object-var ,object)) - (with-inline-assembly (:returns :untagged-fixnum-ecx - :type (unsigned-byte 32)) - (:compile-two-forms (:ecx :ebx) ,offset ,index) - (:sarl ,movitz::+movitz-fixnum-shift+ :ecx) - (:load-lexical (:lexical-binding ,object-var) :eax) - (:addl :ebx :ecx) - (:movl (:eax :ecx ,(offset-by 4)) :ecx))))))) + (let ((endian (movitz:movitz-eval endian env)) + (prefixes (if (not physicalp) + () + movitz:*compiler-physical-segment-prefix*))) + (assert (member endian '(:host :little))) + (assert (= 4 movitz::+movitz-fixnum-factor+)) + (cond + ((and (eq 0 offset) (eq 0 index)) + `(with-inline-assembly (:returns :untagged-fixnum-ecx + :type (unsigned-byte 32)) + (:compile-form (:result-mode :eax) ,object) + (,prefixes :movl (:eax ,(offset-by 4)) :ecx))) + ((eq 0 offset) + `(with-inline-assembly (:returns :untagged-fixnum-ecx + :type (unsigned-byte 32)) + (:compile-two-forms (:eax :ecx) ,object ,index) + (,prefixes :movl (:eax :ecx ,(offset-by 4)) :ecx))) + (t (let ((object-var (gensym "memref-object-"))) + `(let ((,object-var ,object)) + (with-inline-assembly (:returns :untagged-fixnum-ecx + :type (unsigned-byte 32)) + (:compile-two-forms (:ecx :ebx) ,offset ,index) + (:sarl ,movitz::+movitz-fixnum-shift+ :ecx) + (:load-lexical (:lexical-binding ,object-var) :eax) + (:addl :ebx :ecx) + (,prefixes :movl (:eax :ecx ,(offset-by 4)) :ecx)))))))) (:lisp (let* ((localp (movitz:movitz-eval localp env)) (prefixes (if localp

1 0

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

15 Apr '05

Update of /project/movitz/cvsroot/movitz/losp In directory common-lisp.net:/tmp/cvs-serv28993 Added Files: ll-testing.lisp Log Message: *** empty log message *** Date: Fri Apr 15 09:03:09 2005 Author: ffjeld

1 0

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

15 Apr '05

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv28567 Modified Files: typep.lisp Log Message: Added a vector deftype, so that e.g. (vector (unsigned-byte 32)) should work. Date: Fri Apr 15 09:00:31 2005 Author: ffjeld Index: movitz/losp/muerte/typep.lisp diff -u movitz/losp/muerte/typep.lisp:1.42 movitz/losp/muerte/typep.lisp:1.43 --- movitz/losp/muerte/typep.lisp:1.42 Tue Mar 1 00:39:04 2005 +++ movitz/losp/muerte/typep.lisp Fri Apr 15 09:00:31 2005 @@ -9,7 +9,7 @@ ;;;; Created at: Fri Dec 8 11:07:53 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: typep.lisp,v 1.42 2005/02/28 23:39:04 ffjeld Exp $ +;;;; $Id: typep.lisp,v 1.43 2005/04/15 07:00:31 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -525,6 +525,9 @@ (and (typep x 'cons) (or (eq '* car) (typep (car x) car)) (or (eq '* cdr) (typep (cdr x) cdr)))) + +(deftype vector (&optional (element-type '*) (size '*)) + `(simple-array ,element-type (,size))) (define-simple-typep (atom atom) (x) (typep x 'atom))

1 0

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

14 Apr '05

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv7422 Modified Files: segments.lisp Log Message: Fixed bug in segment-descriptor-base. Date: Thu Apr 14 08:42:31 2005 Author: ffjeld Index: movitz/losp/muerte/segments.lisp diff -u movitz/losp/muerte/segments.lisp:1.8 movitz/losp/muerte/segments.lisp:1.9 --- movitz/losp/muerte/segments.lisp:1.8 Thu Apr 14 08:14:49 2005 +++ movitz/losp/muerte/segments.lisp Thu Apr 14 08:42:29 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.8 2005/04/14 06:14:49 ffjeld Exp $ +;;;; $Id: segments.lisp,v 1.9 2005/04/14 06:42:29 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -166,7 +166,7 @@ (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) + (ash (memref table (+ 4 offset) :type :unsigned-byte8) 16) (ash (memref table (+ 2 offset) :type :unsigned-byte16) 0))))

1 0

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

14 Apr '05

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv5762 Modified Files: segments.lisp Log Message: "segment-register-name" was a bad idea. Date: Thu Apr 14 08:14:49 2005 Author: ffjeld Index: movitz/losp/muerte/segments.lisp diff -u movitz/losp/muerte/segments.lisp:1.7 movitz/losp/muerte/segments.lisp:1.8 --- movitz/losp/muerte/segments.lisp:1.7 Wed Apr 13 08:57:01 2005 +++ movitz/losp/muerte/segments.lisp Thu Apr 14 08:14:49 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.7 2005/04/13 06:57:01 ffjeld Exp $ +;;;; $Id: segments.lisp,v 1.8 2005/04/14 06:14:49 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -18,7 +18,7 @@ (in-package muerte) -(defun segment-register-name (segment-register-name) +(defun segment-register (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) @@ -32,7 +32,7 @@ (:fs (sreg :fs)) (:gs (sreg :gs))))) -(defun (setf segment-register-name) (value segment-register-name) +(defun (setf segment-register) (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))

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/integers.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-serv5574 Modified Files: integers.lisp Log Message: Added compiler-macro for logbitp. Date: Wed Apr 13 09:26:29 2005 Author: ffjeld Index: movitz/losp/muerte/integers.lisp diff -u movitz/losp/muerte/integers.lisp:1.104 movitz/losp/muerte/integers.lisp:1.105 --- movitz/losp/muerte/integers.lisp:1.104 Thu Nov 25 19:05:48 2004 +++ movitz/losp/muerte/integers.lisp Wed Apr 13 09:26:29 2005 @@ -1,6 +1,6 @@ ;;;;------------------------------------------------------------------ ;;;; -;;;; Copyright (C) 2000-2004, +;;;; Copyright (C) 2000-2005, ;;;; Department of Computer Science, University of Tromso, Norway ;;;; ;;;; Filename: integers.lisp @@ -9,7 +9,7 @@ ;;;; Created at: Wed Nov 8 18:44:57 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: integers.lisp,v 1.104 2004/11/25 18:05:48 ffjeld Exp $ +;;;; $Id: integers.lisp,v 1.105 2005/04/13 07:26:29 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -1513,6 +1513,19 @@ (:shrl ,movitz::+movitz-fixnum-shift+ :ecx) (:btl :ecx (:ebx (:offset movitz-bignum bigit0)))))))) (do-it))) + +(define-compiler-macro logbitp (&whole form &environment env index integer) + (if (not (movitz:movitz-constantp index env)) + form + (let ((index (movitz:movitz-eval index env))) + (check-type index (integer 0 *)) + (typecase index + ((integer 0 31) + `(with-inline-assembly (:returns :boolean-cf=1) + (:compile-form (:result-mode :untagged-fixnum-ecx) ,integer) + (:btl ,index :ecx))) + (t form))))) + (defun logand (&rest integers) (numargs-case

1 0