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

[movitz-cvs] CVS update: movitz/losp/muerte/conditions.lisp
by Frode Vatvedt Fjeld 22 Jul '04

22 Jul '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv21084 Modified Files: conditions.lisp Log Message: minor edit. Date: Wed Jul 21 18:01:31 2004 Author: ffjeld Index: movitz/losp/muerte/conditions.lisp diff -u movitz/losp/muerte/conditions.lisp:1.9 movitz/losp/muerte/conditions.lisp:1.10 --- movitz/losp/muerte/conditions.lisp:1.9 Tue Jul 20 01:54:05 2004 +++ movitz/losp/muerte/conditions.lisp Wed Jul 21 18:01:31 2004 @@ -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.9 2004/07/20 08:54:05 ffjeld Exp $ +;;;; $Id: conditions.lisp,v 1.10 2004/07/22 01:01:31 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -105,7 +105,7 @@ :initarg :datum :reader type-error-datum)) (:report (lambda (c s) - (format s "The object ~S is not of type ~S." + (format s "The object `~S' is not of type ~S." (type-error-datum c) (type-error-expected-type c)))))

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/basic-macros.lisp
by Frode Vatvedt Fjeld 22 Jul '04

22 Jul '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv3544 Modified Files: basic-macros.lisp Log Message: Improved eql compiler-macro a bit. Date: Wed Jul 21 18:00:47 2004 Author: ffjeld Index: movitz/losp/muerte/basic-macros.lisp diff -u movitz/losp/muerte/basic-macros.lisp:1.31 movitz/losp/muerte/basic-macros.lisp:1.32 --- movitz/losp/muerte/basic-macros.lisp:1.31 Wed Jul 21 15:30:14 2004 +++ movitz/losp/muerte/basic-macros.lisp Wed Jul 21 18:00:47 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Wed Nov 8 18:44:57 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: basic-macros.lisp,v 1.31 2004/07/21 22:30:14 ffjeld Exp $ +;;;; $Id: basic-macros.lisp,v 1.32 2004/07/22 01:00:47 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -439,7 +439,7 @@ ((and (movitz:movitz-constantp x env) (not (typep (movitz:movitz-eval x env) '(and integer (not fixnum))))) - `(eq ',x ,y)) + `(eq ',(movitz:movitz-eval x env) ,y)) (t `(with-inline-assembly (:returns :boolean-zf=1) (:compile-two-forms (:eax :ebx) ,x ,y) (:call-global-pf fast-eql)))))

1 0

[movitz-cvs] CVS update: movitz/losp/x86-pc/ne2k.lisp
by Frode Vatvedt Fjeld 22 Jul '04

22 Jul '04

Update of /project/movitz/cvsroot/movitz/losp/x86-pc In directory common-lisp.net:/tmp/cvs-serv8162 Modified Files: ne2k.lisp Log Message: Don't use the old vector-u8 stuff. Date: Wed Jul 21 17:58:56 2004 Author: ffjeld Index: movitz/losp/x86-pc/ne2k.lisp diff -u movitz/losp/x86-pc/ne2k.lisp:1.9 movitz/losp/x86-pc/ne2k.lisp:1.10 --- movitz/losp/x86-pc/ne2k.lisp:1.9 Thu Feb 26 03:19:25 2004 +++ movitz/losp/x86-pc/ne2k.lisp Wed Jul 21 17:58:56 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Tue Sep 17 15:16:00 2002 ;;;; -;;;; $Id: ne2k.lisp,v 1.9 2004/02/26 11:19:25 ffjeld Exp $ +;;;; $Id: ne2k.lisp,v 1.10 2004/07/22 00:58:56 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -96,7 +96,7 @@ :io-base io-base :asic-io-base (+ io-base #x10)))) (reset-device ne2000) - (let ((mac (make-array 6 :element-type 'muerte::u8))) + (let ((mac (make-array 6 :element-type '(unsigned-byte 8)))) (with-dp8390 (dp8390 io-base) (with-dp8390-dma (dp8390 remote-read 12 0) (dotimes (i 6) @@ -113,7 +113,7 @@ (defun read-from-ne2k-ring (io-base asic-io packet start length ring-start ring-pointer ring-stop) "Read from a NE2000 ring buffer into packet, starting at start, length number of bytes." - (check-type packet vector-u8) + (check-type packet (simple-array (unsigned-byte 8) 1)) (let* ((ring-space (- ring-stop ring-pointer))) (if (<= length ring-space) (with-dp8390 (dp8390 io-base) @@ -133,7 +133,8 @@ (let ((read-pointer (next-packet device))) (when read-pointer (let ((asic-io (asic-io-base device)) - (packet (or packet (make-array +max-ethernet-frame-size+ :element-type 'muerte::u8))) + (packet (or packet (make-array +max-ethernet-frame-size+ + :element-type '(unsigned-byte 8)))) (ring-start (ring-start device)) (ring-stop (ring-stop device))) (with-dp8390 (dp8390 (io-base device)) @@ -206,7 +207,7 @@ t)) (defmethod transmit ((device ne2000) packet &key (start 0) (end (length packet))) - (check-type packet vector-u8) + (check-type packet (simple-array (unsigned-byte 8) 1)) (assert (and (evenp start))) (with-dp8390 (dp8390 (io-base device)) (loop while (logbitp ($command-bit transmit) @@ -229,7 +230,7 @@ #+ignore (defun spinning-receive (ne2000 - &optional (packet (make-array 1500 :element-type 'muerte::u8)) + &optional (packet (make-array 1500 :element-type '(unsigned-byte 8))) &key (start 0)) (multiple-value-bind (recovered-packet recovered-packet-length) (recover-when-ring-overflow ne2000 packet :start start)

1 0

[movitz-cvs] CVS update: movitz/losp/lib/net/arp.lisp
by Frode Vatvedt Fjeld 22 Jul '04

22 Jul '04

Update of /project/movitz/cvsroot/movitz/losp/lib/net In directory common-lisp.net:/tmp/cvs-serv6799 Modified Files: arp.lisp Log Message: Don't use the old vector-u8 stuff. Date: Wed Jul 21 17:58:50 2004 Author: ffjeld Index: movitz/losp/lib/net/arp.lisp diff -u movitz/losp/lib/net/arp.lisp:1.4 movitz/losp/lib/net/arp.lisp:1.5 --- movitz/losp/lib/net/arp.lisp:1.4 Thu Feb 26 03:28:08 2004 +++ movitz/losp/lib/net/arp.lisp Wed Jul 21 17:58:50 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Thu Mar 20 15:01:15 2003 ;;;; -;;;; $Id: arp.lisp,v 1.4 2004/02/26 11:28:08 ffjeld Exp $ +;;;; $Id: arp.lisp,v 1.5 2004/07/22 00:58:50 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -43,7 +43,8 @@ (if packet (setf (fill-pointer packet) (max +min-ethernet-frame-size+ (+ start 28))) - (setf packet (make-array +min-ethernet-frame-size+ :element-type 'muerte::u8))) + (setf packet (make-array +min-ethernet-frame-size+ + :element-type '(unsigned-byte 8)))) (setf (aref packet (+ start 0)) (ldb (byte 8 8) hard-type) (aref packet (+ start 1)) (ldb (byte 8 0) hard-type) (aref packet (+ start 2)) (ldb (byte 8 8) prot-type)

1 0

[movitz-cvs] CVS update: movitz/procfs-image.lisp
by Frode Vatvedt Fjeld 22 Jul '04

22 Jul '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv8768 Modified Files: procfs-image.lisp Log Message: Minor hacking on backtrace. Date: Wed Jul 21 17:28:06 2004 Author: ffjeld Index: movitz/procfs-image.lisp diff -u movitz/procfs-image.lisp:1.9 movitz/procfs-image.lisp:1.10 --- movitz/procfs-image.lisp:1.9 Thu Jul 8 11:53:33 2004 +++ movitz/procfs-image.lisp Wed Jul 21 17:28:06 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Fri Aug 24 11:39:37 2001 ;;;; -;;;; $Id: procfs-image.lisp,v 1.9 2004/07/08 18:53:33 ffjeld Exp $ +;;;; $Id: procfs-image.lisp,v 1.10 2004/07/22 00:28:06 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -169,7 +169,8 @@ (- 5 (position name '(nil :eflags :eip :error-code :exception :ebp nil :ecx :eax :edx :ebx :esi :edi)))) -(defun backtrace () + +(defun backtrace (&key reqs) (format t "~&Backtracing from EIP = #x~X: " (image-register32 *image* :eip)) ;; (search-image-funobj (image-register32 *image* :eip)) @@ -197,7 +198,11 @@ (write-string (symbol-name name)) (when (string= name 'toplevel-function) (loop-finish)) - (format t " (#x~X)" (stack-frame-return-address stack-frame)))) + (format t " (#x~X)" (stack-frame-return-address stack-frame)) + (when reqs + (format t " req1: ~S, req2: ~S" + (movitz-word (get-word stack-frame -2)) + (movitz-word (get-word stack-frame -3)))))) (t (write (movitz-print movitz-name))))) do (format t "~& => ")) (values))

1 0

[movitz-cvs] CVS update: movitz/storage-types.lisp
by Frode Vatvedt Fjeld 22 Jul '04

22 Jul '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv5347 Modified Files: storage-types.lisp Log Message: Changed the signature and workings of make-movitz-vector somewhat: Now the element-type argument is an actual (host) type-specifier. The idea is that movitz-read of an array will result in a movitz array with the corresponding element-type. Date: Wed Jul 21 17:27:22 2004 Author: ffjeld Index: movitz/storage-types.lisp diff -u movitz/storage-types.lisp:1.29 movitz/storage-types.lisp:1.30 --- movitz/storage-types.lisp:1.29 Wed Jul 21 07:15:13 2004 +++ movitz/storage-types.lisp Wed Jul 21 17:27:22 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Sun Oct 22 00:22:43 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: storage-types.lisp,v 1.29 2004/07/21 14:15:13 ffjeld Exp $ +;;;; $Id: storage-types.lisp,v 1.30 2004/07/22 00:27:22 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -441,18 +441,30 @@ 8))) (defun movitz-vector-upgrade-type (type) - (case type - (movitz-unboxed-integer-u8 - (values :u8 0)) - (movitz-unboxed-integer-u32 - (values :u32 0)) - (movitz-character - (values :character #\null)) - (movitz-code - (values :code 0)) - (t (values :any-t nil)))) + (cond + ((eq type 'code) + (values :code 0)) + ((subtypep type '(unsigned-byte 8)) + (values :u8 0)) + ((subtypep type '(unsigned-byte 16)) + (values :u16 0)) + ((subtypep type '(unsigned-byte 32)) + (values :u32 0)) + ((subtypep type 'character) + (values :character #\null)) + (t (values :any-t nil))) + #+ignore (case type + (movitz-unboxed-integer-u8 + (values :u8 0)) + (movitz-unboxed-integer-u32 + (values :u32 0)) + (movitz-character + (values :character #\null)) + (movitz-code + (values :code 0)) + (t (values :any-t nil)))) -(defun make-movitz-vector (size &key (element-type 'movitz-object) +(defun make-movitz-vector (size &key (element-type t) (initial-contents nil) (initial-element *movitz-nil* initial-element-p) (alignment 8) @@ -462,13 +474,13 @@ (assert (or (null initial-contents) (= size (length initial-contents))) (size initial-contents) "The initial-contents must be the same length as SIZE.") - (assert (subtypep element-type 'movitz-object) () - "ELEMENT-TYPE must be a subtype of MOVITZ-OBJECT.") - (assert (or initial-contents - (not initial-element-p) - (typep initial-element element-type)) () - "INITIAL-ELEMENT's type ~A is not of ELEMENT-TYPE ~A." - (type-of initial-element) element-type) +;;; (assert (subtypep element-type 'movitz-object) () +;;; "ELEMENT-TYPE must be a subtype of MOVITZ-OBJECT.") +;;; (assert (or initial-contents +;;; (not initial-element-p) +;;; (typep initial-element element-type)) () +;;; "INITIAL-ELEMENT's type ~A is not of ELEMENT-TYPE ~A." +;;; (type-of initial-element) element-type) (assert (and (>= (log alignment 2) 3) (zerop (rem (log alignment 2) 1))) (alignment) @@ -489,14 +501,17 @@ (make-instance 'movitz-basic-vector :element-type et :num-elements size - :symbolic-data initial-contents ;; sv + :symbolic-data (case et + (:any-t + (map 'vector #'movitz-read initial-contents)) + (t initial-contents)) :fill-pointer (if (integerp fill-pointer) fill-pointer size)))) (defun make-movitz-string (string) (make-movitz-vector (length string) - :element-type 'movitz-character + :element-type 'character :initial-contents (map 'list #'identity string))) ;; (map 'list #'make-movitz-character string))) @@ -1177,8 +1192,8 @@ bytes))))) (let ((l32 (merge-bytes byte-list 8 32))) (movitz-intern (make-movitz-vector (length l32) - :element-type 'movitz-unboxed-integer-u32 - :initial-contents l32))))) + :element-type '(unsigned-byte 32) + :initial-contents l32))))) ;;; std-instance

1 0

[movitz-cvs] CVS update: movitz/image.lisp
by Frode Vatvedt Fjeld 22 Jul '04

22 Jul '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv4299 Modified Files: image.lisp Log Message: Changed the signature and workings of make-movitz-vector somewhat: Now the element-type argument is an actual (host) type-specifier. The idea is that movitz-read of an array will result in a movitz array with the corresponding element-type. Date: Wed Jul 21 17:27:17 2004 Author: ffjeld Index: movitz/image.lisp diff -u movitz/image.lisp:1.48 movitz/image.lisp:1.49 --- movitz/image.lisp:1.48 Wed Jul 21 05:32:26 2004 +++ movitz/image.lisp Wed Jul 21 17:27:17 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Sun Oct 22 00:22:43 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: image.lisp,v 1.48 2004/07/21 12:32:26 ffjeld Exp $ +;;;; $Id: image.lisp,v 1.49 2004/07/22 00:27:17 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -1438,7 +1438,8 @@ (setf (gethash expr (image-string-constants *image*)) (make-movitz-string expr)))) (vector (make-movitz-vector (length expr) - :initial-contents (map 'vector #'movitz-read expr))) + :element-type (array-element-type expr) + :initial-contents expr)) (cons (or (gethash expr (image-cons-constants *image*)) (setf (gethash expr (image-cons-constants *image*))

1 0

[movitz-cvs] CVS update: movitz/compiler.lisp
by Frode Vatvedt Fjeld 22 Jul '04

22 Jul '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv2848 Modified Files: compiler.lisp Log Message: Changed the signature and workings of make-movitz-vector somewhat: Now the element-type argument is an actual (host) type-specifier. The idea is that movitz-read of an array will result in a movitz array with the corresponding element-type. Date: Wed Jul 21 17:27:11 2004 Author: ffjeld Index: movitz/compiler.lisp diff -u movitz/compiler.lisp:1.81 movitz/compiler.lisp:1.82 --- movitz/compiler.lisp:1.81 Wed Jul 21 15:26:55 2004 +++ movitz/compiler.lisp Wed Jul 21 17:27:11 2004 @@ -8,7 +8,7 @@ ;;;; Created at: Wed Oct 25 12:30:49 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: compiler.lisp,v 1.81 2004/07/21 22:26:55 ffjeld Exp $ +;;;; $Id: compiler.lisp,v 1.82 2004/07/22 00:27:11 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -108,7 +108,7 @@ (case label (:nil-value (image-nil-word *image*))))))) (make-movitz-vector (length code-vector) - :element-type 'movitz-code + :element-type 'code :initial-contents code-vector))) (defun register-function-code-size (funobj) @@ -873,7 +873,7 @@ (setf (movitz-funobj-code-vector funobj) (make-movitz-vector (length code-vector) :fill-pointer code-length - :element-type 'movitz-code + :element-type 'code :initial-contents code-vector )))) funobj)

1 0

[movitz-cvs] CVS update: movitz/losp/tmp/packet.lisp
by Frode Vatvedt Fjeld 21 Jul '04

21 Jul '04

Update of /project/movitz/cvsroot/movitz/losp/tmp In directory common-lisp.net:/tmp/cvs-serv22560 Modified Files: packet.lisp Log Message: Don't entirely skip the reader-macro stuff for the movitz side. Date: Wed Jul 21 15:37:07 2004 Author: ffjeld Index: movitz/losp/tmp/packet.lisp diff -u movitz/losp/tmp/packet.lisp:1.2 movitz/losp/tmp/packet.lisp:1.3 --- movitz/losp/tmp/packet.lisp:1.2 Wed Jul 21 05:33:54 2004 +++ movitz/losp/tmp/packet.lisp Wed Jul 21 15:37:06 2004 @@ -270,7 +270,7 @@ ;;; ;;; The read syntax is `#e"ff:00:1:2:3:4'. ;;; -(eval-when (:compile-toplevel #-movitz :load-toplevel #-movitz :execute) +(eval-when (:compile-toplevel :load-toplevel :execute) (defstruct (ethernet-address (:conc-name #:ethernet-address.) (:print-function print-ethernet-address)) "48-bit Ethernet MAC address." @@ -291,7 +291,8 @@ (setf (elt vec i) octet)))) (unless *read-suppress* (make-ethernet-address :octets vec))))) - + + #-movitz (set-dispatch-macro-character #\# #\e 'read-ethernet-address) (defun print-ethernet-address (address stream depth) @@ -397,7 +398,7 @@ ;;; ;;; IP addresses also have a special read-syntax: `(a)10.0.0.1'. ;;; -(eval-when (:compile-toplevel #-movitz :load-toplevel #-movitz :execute) +(eval-when (:compile-toplevel :load-toplevel :execute) (defstruct (ipv4-address (:conc-name #:ipv4-address.) (:print-function print-ipv4-address)) (octets 0 :type (array octet (4)))) @@ -416,6 +417,7 @@ (unless *read-suppress* (make-ipv4-address :octets vec))))) + #-movitz (set-macro-character #\@ 'read-ipv4-address t) (defun print-ipv4-address (address stream depth)

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/typep.lisp
by Frode Vatvedt Fjeld 21 Jul '04

21 Jul '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv29824 Modified Files: typep.lisp Log Message: Made typep compiler-macro slighty smarter about (array ...) type-specifiers. Date: Wed Jul 21 15:36:00 2004 Author: ffjeld Index: movitz/losp/muerte/typep.lisp diff -u movitz/losp/muerte/typep.lisp:1.30 movitz/losp/muerte/typep.lisp:1.31 --- movitz/losp/muerte/typep.lisp:1.30 Wed Jul 21 07:16:57 2004 +++ movitz/losp/muerte/typep.lisp Wed Jul 21 15:36:00 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Fri Dec 8 11:07:53 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: typep.lisp,v 1.30 2004/07/21 14:16:57 ffjeld Exp $ +;;;; $Id: typep.lisp,v 1.31 2004/07/21 22:36:00 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -276,6 +276,8 @@ (if (not (eql dim 1)) form (cond + ((eq et '*) + (make-other-typep :basic-vector)) ((movitz:movitz-subtypep et '(unsigned-byte 8)) (make-basic-vector-typep :u8)) ((movitz:movitz-subtypep et '(unsigned-byte 32)) @@ -560,6 +562,8 @@ (define-simple-typep (hash-table hash-table-p)) (define-simple-typep (package packagep)) + +;;; (define-typep and (x &rest types) (declare (dynamic-extent types))

1 0