movitz-cvs

movitz-cvs@common-lisp.net

2595 discussions

[movitz-cvs] CVS update: movitz/losp/muerte/arrays.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-serv23193 Modified Files: arrays.lisp Log Message: Improved array-element-type, make-array, and array typep. Date: Wed Jul 21 18:09:44 2004 Author: ffjeld Index: movitz/losp/muerte/arrays.lisp diff -u movitz/losp/muerte/arrays.lisp:1.39 movitz/losp/muerte/arrays.lisp:1.40 --- movitz/losp/muerte/arrays.lisp:1.39 Wed Jul 21 15:33:55 2004 +++ movitz/losp/muerte/arrays.lisp Wed Jul 21 18:09:44 2004 @@ -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.39 2004/07/21 22:33:55 ffjeld Exp $ +;;;; $Id: arrays.lisp,v 1.40 2004/07/22 01:09:44 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -60,7 +60,7 @@ (#.(bt:enum-value 'movitz::movitz-vector-element-type :character) 'character) (#.(bt:enum-value 'movitz::movitz-vector-element-type :u8) - 'muerte::u8) + '(unsigned-byte 8)) (#.(bt:enum-value 'movitz::movitz-vector-element-type :u16) '(unsigned-byte 16)) (#.(bt:enum-value 'movitz::movitz-vector-element-type :u32) @@ -737,19 +737,20 @@ (car dimensions)) (t (error "Multi-dimensional arrays not supported."))))) - (cond - ;; These should be replaced by subtypep sometime. - ((eq element-type 'character) - (make-basic-vector%character size fill-pointer initial-element initial-contents)) - ((member element-type '(bit (unsigned-byte 1)) :test #'equal) - (make-basic-vector%bit size fill-pointer initial-element initial-contents)) - ((member element-type '(u8 (unsigned-byte 8)) :test #'equal) - (make-basic-vector%u8 size fill-pointer initial-element initial-contents)) - ((member element-type '(u32 (unsigned-byte 32)) :test #'equal) - (make-basic-vector%u32 size fill-pointer initial-element initial-contents)) - ((eq element-type 'code) - (make-basic-vector%code size fill-pointer initial-element initial-contents)) - (t (make-basic-vector%t size fill-pointer initial-element initial-contents))))) + (let ((upgraded-element-type (upgraded-array-element-type element-type))) + (cond + ;; These should be replaced by subtypep sometime. + ((eq upgraded-element-type 'character) + (make-basic-vector%character size fill-pointer initial-element initial-contents)) + ((eq upgraded-element-type 'bit) + (make-basic-vector%bit size fill-pointer initial-element initial-contents)) + ((member upgraded-element-type '(u8 (unsigned-byte 8)) :test #'equal) + (make-basic-vector%u8 size fill-pointer initial-element initial-contents)) + ((member upgraded-element-type '(u32 (unsigned-byte 32)) :test #'equal) + (make-basic-vector%u32 size fill-pointer initial-element initial-contents)) + ((eq upgraded-element-type 'code) + (make-basic-vector%code size fill-pointer initial-element initial-contents)) + (t (make-basic-vector%t size fill-pointer initial-element initial-contents)))))) (defun vector (&rest objects) "=> vector" @@ -829,8 +830,14 @@ (and (integerp dimension-spec) (= dimension-spec (array-dimensions x))) (and (listp dimension-spec) - (do ((d 0 (1+ d)) + (do ((array-rank (array-dimensions x)) + (d 0 (1+ d)) (q dimension-spec)) - ((null q) t) - (unless (= (pop q) (array-dimension x d)) - (return nil))))))) + ((null q) (= d array-rank)) + (let ((dim (pop q))) + (cond + ((>= d array-rank) + (return nil)) + ((eq dim '*)) + ((= dim (array-dimension x d))) + (t (return nil)))))))))

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/inspect.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-serv2452 Modified Files: inspect.lisp Log Message: Try to avoid object-equalp going into infinite recursion. Date: Wed Jul 21 18:08:18 2004 Author: ffjeld Index: movitz/losp/muerte/inspect.lisp diff -u movitz/losp/muerte/inspect.lisp:1.29 movitz/losp/muerte/inspect.lisp:1.30 --- movitz/losp/muerte/inspect.lisp:1.29 Wed Jul 21 04:49:48 2004 +++ movitz/losp/muerte/inspect.lisp Wed Jul 21 18:08:18 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Fri Oct 24 09:50:41 2003 ;;;; -;;;; $Id: inspect.lisp,v 1.29 2004/07/21 11:49:48 ffjeld Exp $ +;;;; $Id: inspect.lisp,v 1.30 2004/07/22 01:08:18 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -229,12 +229,12 @@ (dotimes (i (funobj-num-constants x) t) (unless (test funobj-constant-ref i))))) (symbol - (and (test memref -7 0 :lisp) - (test memref -7 1 :lisp) - (test memref -7 2 :lisp) - (test memref -7 3 :lisp) - (test memref -7 4 :lisp) - (test memref -7 5 :lisp))) + (and ;; (test memref -7 0 :lisp) ; value + (test memref -7 1 :lisp) ; function-value + ;; (test memref -7 2 :lisp) ; plist + (test memref -7 3 :lisp) ; name + ;; (test memref -7 4 :lisp) ; package + (test memref -7 5 :lisp))) ; flags (vector (and (typep y 'vector) (test array-element-type)

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/equalp.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-serv30383 Modified Files: equalp.lisp Log Message: Minor edit. Date: Wed Jul 21 18:07:38 2004 Author: ffjeld Index: movitz/losp/muerte/equalp.lisp diff -u movitz/losp/muerte/equalp.lisp:1.5 movitz/losp/muerte/equalp.lisp:1.6 --- movitz/losp/muerte/equalp.lisp:1.5 Tue Jun 8 18:16:52 2004 +++ movitz/losp/muerte/equalp.lisp Wed Jul 21 18:07:38 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Tue Mar 13 17:09:08 2001 ;;;; -;;;; $Id: equalp.lisp,v 1.5 2004/06/09 01:16:52 ffjeld Exp $ +;;;; $Id: equalp.lisp,v 1.6 2004/07/22 01:07:38 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -22,7 +22,7 @@ (in-package muerte) (defun eql (x y) - (eql x y)) + (compiler-macro-call eql x y)) (defun equal (x y) (typecase x

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/interrupt.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-serv3521 Modified Files: interrupt.lisp Log Message: Use :int 61 for failing on typep list. Date: Wed Jul 21 18:02:22 2004 Author: ffjeld Index: movitz/losp/muerte/interrupt.lisp diff -u movitz/losp/muerte/interrupt.lisp:1.17 movitz/losp/muerte/interrupt.lisp:1.18 --- movitz/losp/muerte/interrupt.lisp:1.17 Wed Jul 21 07:16:15 2004 +++ movitz/losp/muerte/interrupt.lisp Wed Jul 21 18:02:22 2004 @@ -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.17 2004/07/21 14:16:15 ffjeld Exp $ +;;;; $Id: interrupt.lisp,v 1.18 2004/07/22 01:02:22 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -274,12 +274,13 @@ $eip (interrupt-frame-ref :error-code :unsigned-byte32 0 interrupt-frame) $eax $ebx $ecx)) - ((61) + ((60) ;; EAX failed type in EDX. May be restarted by returning with a new value in EAX. (with-simple-restart (continue "Retry with a different value.") (error 'type-error :datum (dereference $eax) :expected-type (dereference $edx))) (format *query-io* "Enter a new value: ") (setf (dereference $eax) (read *query-io*))) + (61 (error 'type-error :datum (dereference $eax) :expected-type 'list)) (62 (error "Trying to save too many values: ~@Z." $ecx)) (63 (error "Primitive assertion error. EIP=~@Z, ESI=~@Z." $eip $esi)) (64 (error 'type-error :datum (dereference $eax) :expected-type 'integer))

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/cons.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-serv2748 Modified Files: cons.lisp Log Message: Use :int 61 for failing on typep list. Date: Wed Jul 21 18:02:15 2004 Author: ffjeld Index: movitz/losp/muerte/cons.lisp diff -u movitz/losp/muerte/cons.lisp:1.5 movitz/losp/muerte/cons.lisp:1.6 --- movitz/losp/muerte/cons.lisp:1.5 Thu Jul 15 14:06:51 2004 +++ movitz/losp/muerte/cons.lisp Wed Jul 21 18:02:15 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Fri Dec 8 15:25:45 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: cons.lisp,v 1.5 2004/07/15 21:06:51 ffjeld Exp $ +;;;; $Id: cons.lisp,v 1.6 2004/07/22 01:02:15 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -23,7 +23,7 @@ (with-inline-assembly (:returns :eax) (:leal (:eax -1) :ecx) (:testb 3 :cl) - (:jnz '(:sub-program () (:int 66))) + (:jnz '(:sub-program () (:int 61))) (:movl (:eax -1) :ebx) (:movl (:eax 3) :eax) (:ret))) @@ -33,7 +33,7 @@ (with-inline-assembly (:returns :eax) (:leal (:eax -1) :ecx) (:testb 3 :cl) - (:jnz '(:sub-program () (:int 66))) + (:jnz '(:sub-program () (:int 61))) (:movl (:eax -1) :eax) (:ret))) @@ -43,7 +43,9 @@ (with-inline-assembly (:returns :eax) (:leal (:ebx -1) :ecx) (:testb 3 :cl) - (:jnz '(:sub-program () (:int 66))) + (:jnz '(:sub-program () + (:movl :ebx :eax) + (:int 66))) (:movl (:ebx -1) :eax) (:ret))) @@ -52,7 +54,7 @@ (with-inline-assembly (:returns :eax) (:leal (:eax -1) :ecx) (:testb 3 :cl) - (:jnz '(:sub-program () (:int 66))) + (:jnz '(:sub-program () (:int 61))) (:movl (:eax 3) :eax) (:ret))) @@ -61,11 +63,11 @@ (with-inline-assembly (:returns :eax) (:leal (:eax -1) :ecx) (:testb 3 :cl) - (:jnz '(:sub-program () (:int 66))) + (:jnz '(:sub-program () (:int 61))) (:movl (:eax 3) :eax) (:leal (:eax -1) :ecx) (:testb 3 :cl) - (:jnz '(:sub-program () (:int 66))) + (:jnz '(:sub-program () (:int 61))) (:movl (:eax 3) :eax) (:ret))) @@ -74,15 +76,15 @@ (with-inline-assembly (:returns :eax) (:leal (:eax -1) :ecx) (:testb 3 :cl) - (:jnz '(:sub-program (not-cons) (:int 66))) + (:jnz '(:sub-program (not-cons) (:int 61))) (:movl (:eax 3) :eax) (:leal (:eax -1) :ecx) (:testb 3 :cl) - (:jnz '(:sub-program (not-cons) (:int 66))) + (:jnz '(:sub-program (not-cons) (:int 61))) (:movl (:eax 3) :eax) (:leal (:eax -1) :ecx) (:testb 3 :cl) - (:jnz '(:sub-program (not-cons) (:int 66))) + (:jnz '(:sub-program (not-cons) (:int 61))) (:movl (:eax 3) :eax) (:ret))) @@ -92,7 +94,9 @@ (with-inline-assembly (:returns :eax) (:leal (:ebx -1) :ecx) (:testb 3 :cl) - (:jnz '(:sub-program () (:int 66))) + (:jnz '(:sub-program () + (:movl :ebx :eax) + (:int 61))) (:movl (:ebx 3) :eax) (:ret))) @@ -104,7 +108,7 @@ (:prefetch-nta (:eax)) (:leal (:eax -1) :ecx) (:testb 3 :cl) - (:jnz '(:sub-program () (:int 66))) + (:jnz '(:sub-program () (:int 61))) (:movl (:eax -1) :ebx) (:movl (:eax 3) :eax) (:ret))) @@ -115,7 +119,7 @@ (:prefetch-nta (:eax)) (:leal (:eax -1) :ecx) (:testb 3 :cl) - (:jnz '(:sub-program () (:int 66))) + (:jnz '(:sub-program () (:int 61))) (:movl (:eax -1) :eax) (:ret))) @@ -126,7 +130,9 @@ (:prefetch-nta (:ebx)) (:leal (:ebx -1) :ecx) (:testb 3 :cl) - (:jnz '(:sub-program () (:int 66))) + (:jnz '(:sub-program () + (:movl :ebx :eax) + (:int 61))) (:movl (:ebx -1) :eax) (:ret))) @@ -136,7 +142,7 @@ (:prefetch-nta (:eax)) (:leal (:eax -1) :ecx) (:testb 3 :cl) - (:jnz '(:sub-program () (:int 66))) + (:jnz '(:sub-program () (:int 61))) (:movl (:eax 3) :eax) (:prefetch-nta (:eax)) (:ret))) @@ -148,7 +154,9 @@ (:prefetch-nta (:ebx)) (:leal (:ebx -1) :ecx) (:testb 3 :cl) - (:jnz '(:sub-program () (:int 66))) + (:jnz '(:sub-program () + (:movl :ebx :eax) + (:int 61))) (:movl (:ebx 3) :eax) (:prefetch-nta (:eax)) (:ret))) @@ -159,7 +167,9 @@ (:compile-form (:result-mode :eax) value) (:leal (:ebx -1) :ecx) (:testb 7 :cl) - (:jnz '(:sub-program () (:int 66))) + (:jnz '(:sub-program () + (:movl :ebx :eax) + (:int 61))) (:movl :eax (:ebx -1)))) (defun (setf cdr) (value cell) @@ -168,7 +178,9 @@ (:compile-form (:result-mode :eax) value) (:leal (:ebx -1) :ecx) (:testb 7 :cl) - (:jnz '(:sub-program () (:int 66))) + (:jnz '(:sub-program () + (:movl :ebx :eax) + (:int 61))) (:movl :eax (:ebx 3))))

1 0

[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

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

2004

movitz-cvs