movitz-cvs April 2005

movitz-cvs@common-lisp.net

1 participants
62 discussions

[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

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

13 Apr '05

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv5544 Modified Files: compiler.lisp Log Message: Fixed bug in make-result-and-returns-glue for case :boolean-cf=1 to :ebx, :ecx, etc. Date: Wed Apr 13 09:25:41 2005 Author: ffjeld Index: movitz/compiler.lisp diff -u movitz/compiler.lisp:1.135 movitz/compiler.lisp:1.136 --- movitz/compiler.lisp:1.135 Sun Feb 27 03:30:22 2005 +++ movitz/compiler.lisp Wed Apr 13 09:25:41 2005 @@ -8,7 +8,7 @@ ;;;; Created at: Wed Oct 25 12:30:49 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: compiler.lisp,v 1.135 2005/02/27 02:30:22 ffjeld Exp $ +;;;; $Id: compiler.lisp,v 1.136 2005/04/13 07:25:41 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -5084,7 +5084,7 @@ (:boolean-cf=1 (values (append code `((:sbbl :ecx :ecx) - (:movl (:edi (:ecx 4) ,(global-constant-offset 'null-cons)) + (:movl (:edi (:ecx 4) ,(global-constant-offset 'not-not-nil)) ,desired-result))) desired-result)) (#.+boolean-modes+

1 0

[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-serv3835 Modified Files: segments.lisp Log Message: Reworked %sgdt and %lgdt. Date: Wed Apr 13 08:57:02 2005 Author: ffjeld Index: movitz/losp/muerte/segments.lisp diff -u movitz/losp/muerte/segments.lisp:1.6 movitz/losp/muerte/segments.lisp:1.7 --- movitz/losp/muerte/segments.lisp:1.6 Wed Apr 13 08:43:12 2005 +++ movitz/losp/muerte/segments.lisp Wed Apr 13 08:57:01 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.6 2005/04/13 06:43:12 ffjeld Exp $ +;;;; $Id: segments.lisp,v 1.7 2005/04/13 06:57:01 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -55,39 +55,38 @@ Error if the GDT location is not zero modulo 4." (eval-when (:compile-toplevel) (assert (= 4 movitz:+movitz-fixnum-factor+))) - (with-inline-assembly (:returns :multiple-values) - (:pushl #.movitz:+scan-skip-word+) - (:pushl 2) - (:pushl 0) - (:pushl 0) - (:leal (:esp 2) :ecx) - (:sgdt (:ecx)) - (:popl :ecx) - (:shrl 16 :ecx) - (:leal ((:ecx #.movitz::+movitz-fixnum-factor+)) :ebx) - (:popl :ecx) - (:testb 3 :cl) - (:jnz '(:sub-program () - (:compile-form (:result-mode :ignore) - (error "The GDT base is not 4-aligned.")))) - (:movl :ecx :eax) - (:movl 2 :ecx) - (:stc))) + (without-interrupts + (with-inline-assembly (:returns :multiple-values) + (:std) + (:pushl 0) + (:pushl 0) + (:leal (:esp 2) :ecx) + (:sgdt (:ecx)) + (:popl :ebx) + (:shrl #.(cl:- 16 movitz::+movitz-fixnum-shift+) :ebx) + (:andl #.movitz:+movitz-fixnum-zmask+ :ebx) + (:popl :eax) + (:andl #.movitz:+movitz-fixnum-zmask+ :eax) + (:cld) + (:movl 2 :ecx) + (:stc)))) (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) (assert (= 4 movitz:+movitz-fixnum-factor+))) - (with-inline-assembly (:returns :nothing) - (:compile-two-forms (:eax :ebx) base-location limit) - (:pushl #.movitz:+scan-skip-word+) - (:pushl 2) - (:shll #.(cl:- 16 movitz:+movitz-fixnum-shift+) :ebx) - (:pushl :eax) - (:pushl :ebx) - (:leal (:esp 2) :ecx) - (:lgdt (:ecx)))) + (check-type base-location fixnum) + (check-type limit positive-fixnum) + (without-interrupts + (with-inline-assembly (:returns :eax) + (:compile-form (:result-mode :push) base-location) + (:compile-form (:result-mode :push) limit) + (:shll #.(cl:- 16 movitz:+movitz-fixnum-shift+) (:esp)) + (:leal (:esp 2) :ecx) + (:lgdt (:ecx)) + (:popl :eax) + (:popl :eax)))) ;;;

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

2004

movitz-cvs April 2005