movitz-cvs

movitz-cvs@common-lisp.net

2595 discussions

[movitz-cvs] CVS movitz/losp/muerte
by ffjeld 18 Apr '08

18 Apr '08

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory clnet:/tmp/cvs-serv32636 Modified Files: arrays.lisp Log Message: Stupid hack to make ansi-tests load. Will return nil for non-vector arrays. --- /project/movitz/cvsroot/movitz/losp/muerte/arrays.lisp 2008/04/02 20:49:37 1.66 +++ /project/movitz/cvsroot/movitz/losp/muerte/arrays.lisp 2008/04/18 09:55:13 1.67 @@ -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.66 2008/04/02 20:49:37 ffjeld Exp $ +;;;; $Id: arrays.lisp,v 1.67 2008/04/18 09:55:13 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -1169,8 +1169,8 @@ dimensions) ((and (consp dimensions) (null (cdr dimensions))) (car dimensions)) - (t - (error "Multi-dimensional arrays not supported."))))) + (t (warn "Array of rank ~D not supported." (length dimensions)) + (return-from make-array nil))))) ; XXX (cond (displaced-to (make-indirect-vector displaced-to displaced-index-offset fill-pointer size))

1 0

[movitz-cvs] CVS movitz/losp
by ffjeld 17 Apr '08

17 Apr '08

Update of /project/movitz/cvsroot/movitz/losp In directory clnet:/tmp/cvs-serv15613 Modified Files: los0-gc.lisp Log Message: Break if GC doesn't free anything. It usually means we're dead. --- /project/movitz/cvsroot/movitz/losp/los0-gc.lisp 2007/04/09 17:30:09 1.62 +++ /project/movitz/cvsroot/movitz/losp/los0-gc.lisp 2008/04/17 19:37:01 1.63 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Sat Feb 21 17:48:32 2004 ;;;; -;;;; $Id: los0-gc.lisp,v 1.62 2007/04/09 17:30:09 ffjeld Exp $ +;;;; $Id: los0-gc.lisp,v 1.63 2008/04/17 19:37:01 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -429,8 +429,6 @@ new))))) ((not (object-in-space-p oldspace x)) x) - #+ignore ((when (typep x 'run-time-context) - (warn "Scavenging ~S" x))) (t (or (and (eq (object-tag x) (ldb (byte 3 0) (memref (object-location x) 0 :type :unsigned-byte8))) @@ -438,6 +436,8 @@ (and (object-in-space-p newspace forwarded-x) forwarded-x))) (let ((forward-x (shallow-copy x))) + (when (typep x 'run-time-context) + (break "Evac RTC ~Z -> ~Z" x forward-x)) (when (and *gc-consistency-check* (typep x 'muerte::pointer)) (let ((a *x*)) @@ -533,6 +533,8 @@ (unless *gc-quiet* (let ((old-size (truncate (- (space-fresh-pointer oldspace) 2) 2)) (new-size (truncate (- (space-fresh-pointer newspace) 2) 2))) + (when (= old-size new-size) + (break "No memory freed by GC.")) (format t "Old space: ~/muerte:pprint-clumps/, new space: ~ ~/muerte:pprint-clumps/, freed: ~/muerte:pprint-clumps/.~%" old-size new-size (- old-size new-size))))

1 0

[movitz-cvs] CVS movitz/losp/muerte
by ffjeld 17 Apr '08

17 Apr '08

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory clnet:/tmp/cvs-serv15213 Modified Files: strings.lisp Log Message: Add string< and friends. --- /project/movitz/cvsroot/movitz/losp/muerte/strings.lisp 2005/06/12 20:01:49 1.3 +++ /project/movitz/cvsroot/movitz/losp/muerte/strings.lisp 2008/04/17 19:36:09 1.4 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Fri Oct 19 17:05:25 2001 ;;;; -;;;; $Id: strings.lisp,v 1.3 2005/06/12 20:01:49 ffjeld Exp $ +;;;; $Id: strings.lisp,v 1.4 2008/04/17 19:36:09 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -99,5 +99,97 @@ (t (setf between-words-p (not (char-alpha-p c))) (char-downcase c)))))))) - - +(defun string%<= (string1 string2 result= start1 end1 start2 end2) + (let ((mismatch (mismatch string1 string2 + :start1 start1 + :end1 end1 + :start2 start2 + :end2 end2 + :test #'char=))) + (cond + ((not mismatch) + (when result= + (or end1 (length string1)))) + ((>= mismatch (or end1 (length string1))) + mismatch) + ((>= mismatch (or end2 (length string2))) + nil) + (t (when (char< (char string1 mismatch) + (char string2 mismatch)) + mismatch))))) + +(defun string< (string1 string2 &key (start1 0) end1 (start2 0) end2) + "=> mismatch-index" + (let ((mismatch (mismatch string1 string2 + :start1 start1 + :end1 end1 + :start2 start2 + :end2 end2 + :test #'char=))) + (cond + ((not mismatch) + nil) + ((>= mismatch (or end1 (length string1))) + mismatch) + ((>= mismatch (or end2 (length string2))) + nil) + (t (when (char< (char string1 mismatch) + (char string2 mismatch)) + mismatch))))) + +(defun string<= (string1 string2 &key (start1 0) end1 (start2 0) end2) + "=> mismatch-index" + (let ((mismatch (mismatch string1 string2 + :start1 start1 + :end1 end1 + :start2 start2 + :end2 end2 + :test #'char=))) + (cond + ((not mismatch) + (or end1 (length string1))) + ((>= mismatch (or end1 (length string1))) + mismatch) + ((>= mismatch (or end2 (length string2))) + nil) + (t (when (char<= (char string1 mismatch) + (char string2 mismatch)) + mismatch))))) + +(defun string> (string1 string2 result= start1 end1 start2 end2) + "=> mismatch-index" + (let ((mismatch (mismatch string1 string2 + :start1 start1 + :end1 end1 + :start2 start2 + :end2 end2 + :test #'char=))) + (cond + ((not mismatch) + nil) + ((>= mismatch (or end1 (length string1))) + mismatch) + ((>= mismatch (or end2 (length string2))) + nil) + (t (when (char> (char string1 mismatch) + (char string2 mismatch)) + mismatch))))) + +(defun string>= (string1 string2 result= start1 end1 start2 end2) + "=> mismatch-index" + (let ((mismatch (mismatch string1 string2 + :start1 start1 + :end1 end1 + :start2 start2 + :end2 end2 + :test #'char=))) + (cond + ((not mismatch) + (or end1 (length string1))) + ((>= mismatch (or end1 (length string1))) + mismatch) + ((>= mismatch (or end2 (length string2))) + nil) + (t (when (char>= (char string1 mismatch) + (char string2 mismatch)) + mismatch)))))

1 0

[movitz-cvs] CVS movitz/losp/muerte
by ffjeld 17 Apr '08

17 Apr '08

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory clnet:/tmp/cvs-serv15052 Modified Files: scavenge.lisp Log Message: Tweak map-header-vals. --- /project/movitz/cvsroot/movitz/losp/muerte/scavenge.lisp 2007/04/07 20:50:38 1.61 +++ /project/movitz/cvsroot/movitz/losp/muerte/scavenge.lisp 2008/04/17 19:35:49 1.62 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Mon Mar 29 14:54:08 2004 ;;;; -;;;; $Id: scavenge.lisp,v 1.61 2007/04/07 20:50:38 ffjeld Exp $ +;;;; $Id: scavenge.lisp,v 1.62 2008/04/17 19:35:49 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -56,11 +56,17 @@ (byte 8 8) (movitz:tag primary)))) `(= ,code ,x))) - (record-scan (x) + (record-scan (&optional (tag :other)) (declare (ignorable x)) - #+ignore `(setf *scan-last* ,x))) + `(let ((x (%word-offset scan ,(movitz:tag tag)))) + #+ignore (when (and (los0::object-in-space-p (%run-time-context-slot nil 'nursery-space) x) + (not (typep x 'vector)) + (not (typep x 'function))) + (format t "~&Scan: ~S: ~Z ~A~%" scan x (type-of x))) + ;; `(format t "~&Scan: ~S: ~Z" scan x) + (setf *scan-last* x)))) (do ((verbose *map-header-vals-verbose*) - #+ignore (*scan-last* nil) ; Last scanned object, for debugging. + #+ignore (*scan-last* nil) ; Last scanned object, for debugging. (scan start-location (1+ scan))) ((>= scan end-location)) (declare (fixnum scan)) @@ -74,41 +80,53 @@ (= tag #.(movitz:tag :even-fixnum)) (= tag #.(movitz:tag :odd-fixnum)) (scavenge-typep x :character)))) - ((or (and (= 0 x2) (= 2 x)) - (and (= #xffff x2) (= #xfffe x)) - (and (= #x7fff x2) (= #xffff x)))) + ((or (and (= 0 x2) + (= 2 x)) + (and (= #xffff x2) + (= #xfffe x)) + (and (= #x7fff x2) + (= #xffff x)))) ((scavenge-typep x :illegal) (error "Illegal word #x~4,'0X at #x~X." x scan)) ((scavenge-typep x :bignum) (assert (evenp scan) () "Scanned bignum-header #x~4,'0X at odd location #x~X." x scan) ;; Just skip the bigits + (record-scan :other) (let* ((bigits (memref scan 0 :index 1 :type :unsigned-byte14)) (delta (logior bigits 1))) - (record-scan (%word-offset scan #.(movitz:tag :other))) (incf scan delta))) ((scavenge-typep x :defstruct) (assert (evenp scan) () "Scanned struct-header #x~4,'0X at odd location #x~X." x scan) - (record-scan (%word-offset scan #.(movitz:tag :other)))) + (record-scan :other)) ((scavenge-typep x :run-time-context) (assert (evenp scan) () "Scanned run-time-context-header #x~4,'0X at odd location #x~X." (memref scan 0 :type :unsigned-byte32) scan) - (incf scan) - (let ((non-lispvals #.(cl:truncate (cl:+ -4 (bt:slot-offset 'movitz::movitz-run-time-context - 'movitz::pointer-start) - (movitz::image-nil-word movitz:*image*)) - 4)) - (end (+ scan #.(movitz::movitz-type-word-size 'movitz::movitz-run-time-context)))) - (incf scan non-lispvals) - (map-lisp-vals function scan (1+ end)) - (setf scan end))) + (record-scan :other) + (let ((rtc (%word-offset scan #.(movitz:tag :other)))) + (incf scan) + (let ((non-lispvals #.(cl:truncate (cl:+ -4 (bt:slot-offset 'movitz::movitz-run-time-context + 'movitz::pointer-start) + (movitz::image-nil-word movitz:*image*)) + 4)) + (end (+ scan #.(movitz::movitz-type-word-size 'movitz::movitz-run-time-context)))) + (incf scan non-lispvals) + (check-type rtc run-time-context) + (let ((old-stack (%run-time-context-slot rtc 'stack-vector))) + ;; (warn "old-stack: ~Z" old-stack) + (map-lisp-vals function scan (1+ end)) + (let ((new-stack (%run-time-context-slot rtc 'stack-vector))) + ;; (warn "new-stack: ~Z" new-stack) + (when (not (eq old-stack new-stack)) + (error "Stack-vector for ~S moved from ~Z to ~Z." rtc old-stack new-stack)))) + (setf scan end)))) ((scavenge-typep x :funobj) (assert (evenp scan) () "Scanned funobj-header #x~4,'0X at odd location #x~X." (memref scan 0 :type :unsigned-byte32) scan) - (record-scan (%word-offset scan #.(movitz:tag :other))) + (record-scan :other) ;; Process code-vector pointers specially.. (let* ((old-code-vector (memref (incf scan) 0 :type :code-vector)) (new-code-vector (if (eq 0 old-code-vector) @@ -170,34 +188,37 @@ (scavenge-wide-typep x :basic-vector #.(bt:enum-value 'movitz:movitz-vector-element-type :code))) (let ((len (memref scan 4))) - (record-scan (%word-offset scan #.(movitz:tag :other))) + (record-scan :other) (incf scan (1+ (* 2 (truncate (+ 7 len) 8)))))) ((scavenge-wide-typep x :basic-vector #.(bt:enum-value 'movitz:movitz-vector-element-type :u16)) (let ((len (memref scan 0 :index 1))) - (record-scan (%word-offset scan #.(movitz:tag :other))) + (record-scan :other) (incf scan (1+ (* 2 (truncate (+ 3 len) 4)))))) - ((scavenge-wide-typep x :basic-vector #.(bt:enum-value 'movitz:movitz-vector-element-type :u32)) + ((or (scavenge-wide-typep x :basic-vector + #.(bt:enum-value 'movitz:movitz-vector-element-type :u32)) + (scavenge-wide-typep x :basic-vector + #.(bt:enum-value 'movitz:movitz-vector-element-type :stack))) (let ((len (memref scan 4))) - (record-scan (%word-offset scan #.(movitz:tag :other))) + (record-scan :other) (incf scan (1+ (logand (1+ len) -2))))) ((scavenge-wide-typep x :basic-vector #.(bt:enum-value 'movitz:movitz-vector-element-type :bit)) (let ((len (memref scan 4))) - (record-scan (%word-offset scan #.(movitz:tag :other))) + (record-scan :other) (incf scan (1+ (* 2 (truncate (+ 63 len) 64)))))) ((or (scavenge-wide-typep x :basic-vector #.(bt:enum-value 'movitz:movitz-vector-element-type - :any-t)) + :any-t)) (scavenge-wide-typep x :basic-vector #.(bt:enum-value 'movitz:movitz-vector-element-type - :indirects))) - (record-scan (%word-offset scan #.(movitz:tag :other)))) + :indirects))) + (record-scan :other)) (t (error "Scanned unknown basic-vector-header #x~4,'0X at location #x~X." x scan)))) ((and (eq x 3) (eq x2 0)) - (record-scan scan) + ;; (record-scan scan) (incf scan) (let ((delta (memref scan 0))) (check-type delta positive-fixnum) - ;; (warn "at ~S skipping ~S to ~S." scan delta (+ scan delta)) + (format t "at ~S skipping ~S to ~S." scan delta (+ scan delta)) (incf scan delta))) (t ;; (typep x 'pointer) (let* ((old (memref scan 0)) @@ -439,5 +460,3 @@ (* location-offset 4) lowbits)))) new-code-vector))) - -

1 0

[movitz-cvs] CVS movitz/losp/muerte
by ffjeld 17 Apr '08

17 Apr '08

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory clnet:/tmp/cvs-serv14977 Modified Files: ratios.lisp Log Message: More float "emulation". --- /project/movitz/cvsroot/movitz/losp/muerte/ratios.lisp 2007/04/08 13:44:44 1.10 +++ /project/movitz/cvsroot/movitz/losp/muerte/ratios.lisp 2008/04/17 19:35:20 1.11 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Tue Jul 20 00:39:59 2004 ;;;; -;;;; $Id: ratios.lisp,v 1.10 2007/04/08 13:44:44 ffjeld Exp $ +;;;; $Id: ratios.lisp,v 1.11 2008/04/17 19:35:20 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -76,10 +76,17 @@ (integer 1) (ratio (%ratio-denominator x)))) -(defconstant least-positive-short-float 1/1000) -(defconstant least-positive-single-float 1/1000) -(defconstant least-positive-double-float 1/1000) -(defconstant least-positive-long-float 1/1000) +;;; "Floats" + +(defconstant most-negative-short-float most-negative-fixnum) +(defconstant most-negative-single-float most-negative-fixnum) +(defconstant most-negative-long-float most-negative-fixnum) +(defconstant most-negative-double-float most-negative-fixnum) + +(defconstant least-positive-short-float 1/100000) +(defconstant least-positive-single-float 1/100000) +(defconstant least-positive-double-float 1/100000) +(defconstant least-positive-long-float 1/100000) ;;; @@ -87,6 +94,40 @@ (defvar long-float-epsilon 1/10000) +(defun float (x &optional proto) + (declare (ignore proto)) + (check-type x float) + x) + +(defun float-radix (x) + (if (integerp x) + 2 + (denominator x))) + +(defun integer-decode-float (x) + (if (integerp x) + (if (minusp x) + (values x 0 -1) + (values x 0 1)) + (let ((n (numerator x))) + (if (minusp x) + (values n -1 -1) + (values n -1 1))))) + +(defun decode-float (x) + (multiple-value-bind (n sign) + (let ((n (numerator x))) + (if (minusp n) + (values (- n) -1) + (values n 1))) + (let* ((r (float-radix x)) + (d (denominator x)) + (e (if (= 1 d) 0 -1))) + (do () ((< n 1) + (values n e sign)) + (setf n (/ n r)) + (incf e))))) + (defun cos (x) "http://mathworld.wolfram.com/Cosine.html" (do* ((rad (mod x 44/7))

1 0

[movitz-cvs] CVS movitz/losp/muerte
by ffjeld 17 Apr '08

17 Apr '08

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory clnet:/tmp/cvs-serv14911 Modified Files: more-macros.lisp Log Message: Remove bogous loop macro placeholder. --- /project/movitz/cvsroot/movitz/losp/muerte/more-macros.lisp 2008/04/15 23:06:47 1.43 +++ /project/movitz/cvsroot/movitz/losp/muerte/more-macros.lisp 2008/04/17 19:35:05 1.44 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Fri Jun 7 15:05:57 2002 ;;;; -;;;; $Id: more-macros.lisp,v 1.43 2008/04/15 23:06:47 ffjeld Exp $ +;;;; $Id: more-macros.lisp,v 1.44 2008/04/17 19:35:05 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -575,6 +575,3 @@ (*read-suppress* nil) #+ignore (*readtable* nil)) ,@body)) - -(defmacro/run-time loop (&rest clauses) - (error "Loop not implemented."))

1 0

[movitz-cvs] CVS movitz/losp/muerte
by ffjeld 17 Apr '08

17 Apr '08

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory clnet:/tmp/cvs-serv14769 Modified Files: integers.lisp Log Message: Remove superfluous logandc1 and logandc2. --- /project/movitz/cvsroot/movitz/losp/muerte/integers.lisp 2008/04/13 08:21:40 1.125 +++ /project/movitz/cvsroot/movitz/losp/muerte/integers.lisp 2008/04/17 19:34:39 1.126 @@ -9,7 +9,7 @@ ;;;; Created at: Wed Nov 8 18:44:57 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: integers.lisp,v 1.125 2008/04/13 08:21:40 ffjeld Exp $ +;;;; $Id: integers.lisp,v 1.126 2008/04/17 19:34:39 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -2300,14 +2300,6 @@ (declare (ignore integer-1)) integer-2) -(defun logandc1 (integer-1 integer-2) - (logand (lognot integer-1) - integer-2)) - -(defun logandc2 (integer-1 integer-2) - (logand integer-1 - (lognot integer-2))) - (defun boole-c1 (integer-1 integer-2) (declare (ignore integer-2)) (lognot integer-1))

1 0

[movitz-cvs] CVS movitz/losp/muerte
by ffjeld 17 Apr '08

17 Apr '08

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory clnet:/tmp/cvs-serv14683 Modified Files: hash-tables.lisp Log Message: Fix the utterly broken remhash. --- /project/movitz/cvsroot/movitz/losp/muerte/hash-tables.lisp 2007/02/06 20:03:57 1.13 +++ /project/movitz/cvsroot/movitz/losp/muerte/hash-tables.lisp 2008/04/17 19:34:08 1.14 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Mon Feb 19 19:09:05 2001 ;;;; -;;;; $Id: hash-tables.lisp,v 1.13 2007/02/06 20:03:57 ffjeld Exp $ +;;;; $Id: hash-tables.lisp,v 1.14 2008/04/17 19:34:08 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -246,8 +246,9 @@ ((>= i bucket-length) nil) (declare ((index 2) i index2)) (let ((x (svref bucket index2))) - (when (or (eq x '--no-hash-key--) - (funcall (hash-table-test hash-table) x key)) + (when (eq x '--no-hash-key--) + (return nil)) + (when (funcall (hash-table-test hash-table) x key) (setf (svref bucket index2) '--no-hash-key--) (decf (hash-table-count hash-table)) ;; Now we must rehash any entries that might have been @@ -257,10 +258,11 @@ ((= i index2)) (declare ((index 2) i)) (let ((k (svref bucket i))) - (when (eq x '--no-hash-key--) + (when (eq k '--no-hash-key--) (return)) (let ((v (svref bucket (1+ i)))) (setf (svref bucket i) '--no-hash-key--) ; remove + (decf (hash-table-count hash-table)) (setf (gethash k hash-table) v)))) ; insert (hopefully this is safe..) (return t))))) @@ -282,5 +284,5 @@ (get-next-entry) (if (not entry-p) (return nil) - (map key value))))))) + (map key value)))))))

1 0

[movitz-cvs] CVS movitz/losp/muerte
by ffjeld 17 Apr '08

17 Apr '08

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory clnet:/tmp/cvs-serv14612 Modified Files: eval.lisp Log Message: Prefer assert over unless .. error. --- /project/movitz/cvsroot/movitz/losp/muerte/eval.lisp 2008/04/13 20:12:37 1.30 +++ /project/movitz/cvsroot/movitz/losp/muerte/eval.lisp 2008/04/17 19:33:48 1.31 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Fri Oct 19 21:15:12 2001 ;;;; -;;;; $Id: eval.lisp,v 1.30 2008/04/13 20:12:37 ffjeld Exp $ +;;;; $Id: eval.lisp,v 1.31 2008/04/17 19:33:48 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -487,7 +487,7 @@ (declare (ignore)) (let* ((tag (cadr form)) (b (cdr (op-env-binding env tag +eval-binding-type-go-tag+)))) - (unless b (error "Go-tag ~S is not visible." tag)) + (assert b () "Go-tag ~S is not visible." tag) (throw (cdr b) (values tag)))) (defun eval-set-variable (variable-name value env)

1 0

[movitz-cvs] CVS movitz/losp/muerte
by ffjeld 17 Apr '08

17 Apr '08

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory clnet:/tmp/cvs-serv14536 Modified Files: environment.lisp Log Message: Fresh-lines in trace output. --- /project/movitz/cvsroot/movitz/losp/muerte/environment.lisp 2006/04/07 21:53:47 1.15 +++ /project/movitz/cvsroot/movitz/losp/muerte/environment.lisp 2008/04/17 19:33:27 1.16 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Sat Oct 20 00:41:57 2001 ;;;; -;;;; $Id: environment.lisp,v 1.15 2006/04/07 21:53:47 ffjeld Exp $ +;;;; $Id: environment.lisp,v 1.16 2008/04/17 19:33:27 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -86,7 +86,7 @@ (fresh-line *trace-output*) (dotimes (i *trace-level*) (write-string " " *trace-output*)) - (format *trace-output* "~D: (~S~{ ~S~})~%" + (format *trace-output* "~&~D: (~S~{ ~S~})~%" *trace-level* function-name args)) (multiple-value-call (lambda (&rest results) @@ -95,7 +95,7 @@ (fresh-line *trace-output*) (dotimes (i (min *trace-level* 10)) (write-string " " *trace-output*)) - (format *trace-output* "~D: =>~{ ~W~^,~}.~%" + (format *trace-output* "~&~D: =>~{ ~W~^,~}.~%" *trace-level* results) (values-list results))) (let ((*trace-level* (1+ *trace-level*))

1 0

← Newer
1
...
7
8
9
10
11
12
13
...
260
Older →

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