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

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

20 Jul '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv1564 Modified Files: inspect.lisp Log Message: Added operators objects-equal (a tool for GC debugging), and %object-lispval and %lispval-object. Date: Tue Jul 20 05:37:59 2004 Author: ffjeld Index: movitz/losp/muerte/inspect.lisp diff -u movitz/losp/muerte/inspect.lisp:1.25 movitz/losp/muerte/inspect.lisp:1.26 --- movitz/losp/muerte/inspect.lisp:1.25 Sat Jul 17 12:32:16 2004 +++ movitz/losp/muerte/inspect.lisp Tue Jul 20 05:37:59 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.25 2004/07/17 19:32:16 ffjeld Exp $ +;;;; $Id: inspect.lisp,v 1.26 2004/07/20 12:37:59 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -204,6 +204,84 @@ (copy-funobj old)) (structure-object (copy-structure old)))) + +(defvar *objects-equalp-last-x*) +(defvar *objects-equalp-last-y*) + +(defun objects-equalp (x y) + (setf *objects-equalp-last-x* x + *objects-equalp-last-y* y) + (or (eql x y) + (if (not (and (typep x 'pointer) + (typep y 'pointer))) + nil + (macrolet ((test (accessor &rest args) + `(objects-equalp (,accessor x ,@args) + (,accessor y ,@args)))) + (typecase x + (bignum + (= x y)) + (function + (and (test funobj-code-vector) + (test funobj-code-vector%1op) + (test funobj-code-vector%2op) + (test funobj-code-vector%3op) + (test funobj-lambda-list) + (test funobj-name) + (test funobj-num-constants) + (test funobj-num-jumpers) + (dotimes (i (funobj-num-constants x) t) + (unless (test funobj-constant-ref i))))) + (vector + (and (typep y 'vector) + (test array-element-type) + (every #'objects-equalp x y))) + (cons + (and (typep y 'cons) + (test car) + (test cdr))) + (structure-object + (and (typep y 'structure-object) + (test structure-object-name) + (test structure-object-length) + (dotimes (i (structure-object-length x) t) + (unless (test structure-ref i) + (return nil))))) + (std-instance + (and (typep y 'std-instance) + (test std-instance-class) + (test std-instance-slots)))))))) + +(define-compiler-macro %lispval-object (integer &environment env) + "Return the object that is wrapped in the 32-bit integer lispval." + (if (movitz:movitz-constantp integer env) + (let ((word (movitz:movitz-eval integer env))) + (check-type word (unsigned-byte 32)) + `(with-inline-assembly (:returns :register) + (:movl ,word (:result-register)))) + `(with-inline-assembly (:returns :register) + (:compile-form (:result-mode :eax) ,integer) + (:call-global-pf unbox-u32) + (:movl :ecx (:result-register))))) + +(defun %lispval-object (integer) + "Return the object that is wrapped in the 32-bit integer lispval." + (compiler-macro-call %lispval-object integer)) + +(define-compiler-macro %object-lispval (object &environment env) + "Return the integer lispval that corresponds to object. +Obviously, this correspondence is not guaranteed to hold e.g. across GC." + (if (movitz:movitz-constantp object env) + (movitz:movitz-intern (movitz:movitz-read (movitz:movitz-eval object env)) 'word) + `(with-inline-assembly (:returns :eax) + (:compile-form (:result-mode :eax) ,object) + (:movl :eax :ecx) + (:call-local-pf box-u32-ecx)))) + +(defun %object-lispval (object) + "Return the integer lispval that corresponds to object. +Obviously, this correspondence is not guaranteed to hold e.g. across GC." + (compiler-macro-call %object-lispval object)) (defun location-in-object-p (object location) "Is location inside object?"

1 0

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

20 Jul '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv27264 Modified Files: scavenge.lisp Log Message: Operator %lispval-object supersedes fixnum-words. Date: Tue Jul 20 05:37:05 2004 Author: ffjeld Index: movitz/losp/muerte/scavenge.lisp diff -u movitz/losp/muerte/scavenge.lisp:1.21 movitz/losp/muerte/scavenge.lisp:1.22 --- movitz/losp/muerte/scavenge.lisp:1.21 Tue Jul 20 01:54:52 2004 +++ movitz/losp/muerte/scavenge.lisp Tue Jul 20 05:37:04 2004 @@ -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.21 2004/07/20 08:54:52 ffjeld Exp $ +;;;; $Id: scavenge.lisp,v 1.22 2004/07/20 12:37:04 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -124,7 +124,7 @@ (error "Scanned unknown basic-vector #x~Z at address #x~X." x scan)) ((scavenge-typep x :old-vector) (error "Scanned old-vector #x~Z at address #x~X." x scan)) - ((eq x (fixnum-word 3)) + ((eq x (%lispval-object 3)) (incf scan) (let ((delta (memref scan 0 0 :lisp))) (check-type delta positive-fixnum)

1 0

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

20 Jul '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv12513 Modified Files: compiler.lisp Log Message: Fixed a bug in make-load-lexical wrt. loading a variable for :untagged-fixnum-ecx. Date: Tue Jul 20 04:39:21 2004 Author: ffjeld Index: movitz/compiler.lisp diff -u movitz/compiler.lisp:1.78 movitz/compiler.lisp:1.79 --- movitz/compiler.lisp:1.78 Tue Jul 20 02:08:38 2004 +++ movitz/compiler.lisp Tue Jul 20 04:39:21 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.78 2004/07/20 09:08:38 ffjeld Exp $ +;;;; $Id: compiler.lisp,v 1.79 2004/07/20 11:39:21 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -3209,68 +3209,69 @@ (warn "The variable ~S is used even if it was declared ignored." (binding-name binding))) (let ((protect-registers (cons :edx protect-registers))) - (flet ((chose-tmp-register (&optional preferred) - (or tmp-register - (unless (member preferred protect-registers) - preferred) - (first (set-difference '(:eax :ebx :edx) - protect-registers)) - (error "Unable to chose a temporary register."))) - (install-for-single-value (lexb lexb-location result-mode indirect-p) - (cond - ((and (eq result-mode :untagged-fixnum-ecx) - (integerp lexb-location)) - (assert (not indirect-p)) - `((:movl ,(make-indirect-reference :ebp (stack-frame-offset lexb-location)) - :ecx) - (:sarl ,+movitz-fixnum-shift+ :ecx))) - ((integerp lexb-location) - (append `((:movl ,(make-indirect-reference :ebp (stack-frame-offset lexb-location)) - ,(single-value-register result-mode))) - (when indirect-p - `((:movl (-1 ,(single-value-register result-mode)) - ,(single-value-register result-mode)))))) - (t (ecase (operator lexb-location) - (:push - (assert (member result-mode '(:eax :ebx :ecx :edx))) - (assert (not indirect-p)) - `((:popl ,result-mode))) - (:eax - (assert (not indirect-p)) - (ecase result-mode - ((:ebx :ecx :edx :esi) `((:movl :eax ,result-mode))) - ((:eax :single-value) nil) - (:untagged-fixnum-ecx - `((:movl :eax :ecx) - (:sarl ,movitz:+movitz-fixnum-shift+ :ecx))))) - ((:ebx :ecx :edx) - (assert (not indirect-p)) - (unless (eq result-mode lexb-location) + (labels ((chose-tmp-register (&optional preferred) + (or tmp-register + (unless (member preferred protect-registers) + preferred) + (first (set-difference '(:eax :ebx :edx) + protect-registers)) + (error "Unable to chose a temporary register."))) + (install-for-single-value (lexb lexb-location result-mode indirect-p) + (cond + ((and (eq result-mode :untagged-fixnum-ecx) + (integerp lexb-location)) + (assert (not indirect-p)) + (assert (not (member :eax protect-registers))) + (append (install-for-single-value lexb lexb-location :eax nil) + `((,*compiler-global-segment-prefix* + :call (:edi ,(global-constant-offset 'unbox-u32)))))) + ((integerp lexb-location) + (append `((:movl ,(make-indirect-reference :ebp (stack-frame-offset lexb-location)) + ,(single-value-register result-mode))) + (when indirect-p + `((:movl (-1 ,(single-value-register result-mode)) + ,(single-value-register result-mode)))))) + (t (ecase (operator lexb-location) + (:push + (assert (member result-mode '(:eax :ebx :ecx :edx))) + (assert (not indirect-p)) + `((:popl ,result-mode))) + (:eax + (assert (not indirect-p)) (ecase result-mode - ((:eax :single-value) `((:movl ,lexb-location :eax))) - ((:ebx :ecx :edx :esi) `((:movl ,lexb-location ,result-mode))) + ((:ebx :ecx :edx :esi) `((:movl :eax ,result-mode))) + ((:eax :single-value) nil) (:untagged-fixnum-ecx - `((:movl ,lexb-location :ecx) - (:sarl ,movitz:+movitz-fixnum-shift+ :ecx)))))) - (:argument-stack - (assert (<= 2 (function-argument-argnum lexb)) () - "lexical :argument-stack argnum can't be ~A." (function-argument-argnum lexb)) - (cond - ((eq result-mode :untagged-fixnum-ecx) + `((:movl :eax :ecx) + (:sarl ,movitz:+movitz-fixnum-shift+ :ecx))))) + ((:ebx :ecx :edx) (assert (not indirect-p)) - `((:movl (:ebp ,(argument-stack-offset lexb)) :ecx) - (:sarl ,+movitz-fixnum-shift+ :ecx))) - (t (append `((:movl (:ebp ,(argument-stack-offset lexb)) - ,(single-value-register result-mode))) - (when indirect-p - `((:movl (-1 ,(single-value-register result-mode)) - ,(single-value-register result-mode)))))))) - (:untagged-fixnum-ecx - (ecase result-mode - ((:eax :ebx :ecx :edx) - `((:leal ((:ecx ,+movitz-fixnum-factor+)) ,result-mode))) - (:untagged-fixnum-ecx - nil)))))))) + (unless (eq result-mode lexb-location) + (ecase result-mode + ((:eax :single-value) `((:movl ,lexb-location :eax))) + ((:ebx :ecx :edx :esi) `((:movl ,lexb-location ,result-mode))) + (:untagged-fixnum-ecx + `((:movl ,lexb-location :ecx) + (:sarl ,movitz:+movitz-fixnum-shift+ :ecx)))))) + (:argument-stack + (assert (<= 2 (function-argument-argnum lexb)) () + "lexical :argument-stack argnum can't be ~A." (function-argument-argnum lexb)) + (cond + ((eq result-mode :untagged-fixnum-ecx) + (assert (not indirect-p)) + `((:movl (:ebp ,(argument-stack-offset lexb)) :ecx) + (:sarl ,+movitz-fixnum-shift+ :ecx))) + (t (append `((:movl (:ebp ,(argument-stack-offset lexb)) + ,(single-value-register result-mode))) + (when indirect-p + `((:movl (-1 ,(single-value-register result-mode)) + ,(single-value-register result-mode)))))))) + (:untagged-fixnum-ecx + (ecase result-mode + ((:eax :ebx :ecx :edx) + `((:leal ((:ecx ,+movitz-fixnum-factor+)) ,result-mode))) + (:untagged-fixnum-ecx + nil)))))))) (etypecase binding (forwarding-binding (assert (not (binding-lended-p binding)) (binding)

1 0

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

20 Jul '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv11617 Modified Files: integers.lisp Log Message: Don't give the same name to two different jumper-sets... sigh. Date: Tue Jul 20 02:19:00 2004 Author: ffjeld Index: movitz/losp/muerte/integers.lisp diff -u movitz/losp/muerte/integers.lisp:1.79 movitz/losp/muerte/integers.lisp:1.80 --- movitz/losp/muerte/integers.lisp:1.79 Tue Jul 20 01:54:14 2004 +++ movitz/losp/muerte/integers.lisp Tue Jul 20 02:19:00 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Wed Nov 8 18:44:57 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: integers.lisp,v 1.79 2004/07/20 08:54:14 ffjeld Exp $ +;;;; $Id: integers.lisp,v 1.80 2004/07/20 09:19:00 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -510,6 +510,7 @@ (+ y x)) ((negative-fixnum positive-bignum) (with-inline-assembly (:returns :eax :labels (retry-not-size1 + retry-jumper not-size1 copy-bignum-loop add-bignum-loop @@ -577,12 +578,14 @@ (+ y x) ;; Assume x is smallest. (with-inline-assembly (:returns :eax :labels (retry-not-size1 + retry-jumper not-size1 copy-bignum-loop add-bignum-loop add-bignum-done no-expansion - pfix-pbig-done)) + pfix-pbig-done + zero-padding-loop)) (:compile-two-forms (:eax :ebx) y x) (:testl :ebx :ebx) (:jz 'pfix-pbig-done)

1 0

[movitz-cvs] CVS update: movitz/doc/ChangeLog
by Frode Vatvedt Fjeld 20 Jul '04

20 Jul '04

Update of /project/movitz/cvsroot/movitz/doc In directory common-lisp.net:/tmp/cvs-serv6590 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Tue Jul 20 02:17:38 2004 Author: ffjeld Index: movitz/doc/ChangeLog diff -u movitz/doc/ChangeLog:1.7 movitz/doc/ChangeLog:1.8 --- movitz/doc/ChangeLog:1.7 Tue Jul 13 06:05:23 2004 +++ movitz/doc/ChangeLog Tue Jul 20 02:17:38 2004 @@ -1,3 +1,9 @@ +2004-07-19 Frode Vatvedt Fjeld <frodef(a)cs.uit.no> + + * Bignums are now working to the extent that one can basically + expect things to work, although there still are arithmetic operators + without bignum support. + 2004-07-13 Frode Vatvedt Fjeld <frodef(a)cs.uit.no> * Added the feature that after each GC cycle, the keyboard is

1 0

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

20 Jul '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv18624 Modified Files: compiler.lisp Log Message: Detect if code declares a jumper-set multiple times, don't just silently overwrite the old jumper-set, which caused very weird effects when such a jumper was actually used. Date: Tue Jul 20 02:08:38 2004 Author: ffjeld Index: movitz/compiler.lisp diff -u movitz/compiler.lisp:1.77 movitz/compiler.lisp:1.78 --- movitz/compiler.lisp:1.77 Sun Jul 18 16:45:45 2004 +++ movitz/compiler.lisp Tue Jul 20 02:08:38 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.77 2004/07/18 23:45:45 ffjeld Exp $ +;;;; $Id: compiler.lisp,v 1.78 2004/07/20 09:08:38 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -2497,6 +2497,8 @@ (:declare-label-set (destructuring-bind (name set) (cdr instruction) + (assert (not (getf jumper-sets name)) () + "Duplicate jumper declaration for ~S." name) (setf (getf jumper-sets name) set)))) do (let ((sub (instruction-sub-program instruction))) (when sub (process sub))))))

1 0

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

20 Jul '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv19360 Modified Files: scavenge.lisp Log Message: Cleaned up most ":int 107" instances. Now, we mostly use the semi-standardized ":int 64" which means that the value in EAX wasn't integer. The default interrupt-handler understands this and signals the appropriate error. Date: Tue Jul 20 01:54:52 2004 Author: ffjeld Index: movitz/losp/muerte/scavenge.lisp diff -u movitz/losp/muerte/scavenge.lisp:1.20 movitz/losp/muerte/scavenge.lisp:1.21 --- movitz/losp/muerte/scavenge.lisp:1.20 Mon Jul 19 07:44:25 2004 +++ movitz/losp/muerte/scavenge.lisp Tue Jul 20 01:54:52 2004 @@ -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.20 2004/07/19 14:44:25 ffjeld Exp $ +;;;; $Id: scavenge.lisp,v 1.21 2004/07/20 08:54:52 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -50,7 +50,7 @@ (:compile-form (:result-mode :eax) ,x) (:shrl 16 :eax) (:testb ,movitz:+movitz-fixnum-zmask+ :al) - (:jnz '(:sub-program () (:int 107)))))) + (:jnz '(:sub-program () (:int 63)))))) (do ((*scan-last* nil) ; Last scanned object, for debugging. (scan start-location (1+ scan))) ((>= scan end-location)) @@ -64,7 +64,7 @@ (error "Illegal word ~Z at ~S." x scan)) ((scavenge-typep x :bignum) (assert (evenp scan) () - "Scanned ~Z at odd address #x~X." x scan) + "Scanned ~Z at odd location #x~X." x scan) ;; Just skip the bigits (let* ((bigits (word-bigits x)) (delta (logior bigits 1))) @@ -72,7 +72,7 @@ (incf scan delta))) ((scavenge-typep x :funobj) (assert (evenp scan) () - "Scanned ~Z at odd address #x~X." x scan) + "Scanned ~Z at odd location #x~X." x scan) (setf *scan-last* (%word-offset scan #.(movitz:tag :other))) ;; Process code-vector pointers specially.. (let* ((funobj (%word-offset scan #.(movitz:tag :other))) @@ -90,7 +90,7 @@ (incf scan (+ 7 num-jumpers)))) ; Don't scan the jumpers. ((scavenge-typep x :infant-object) (assert (evenp scan) () - "Scanned #x~Z at odd address #x~X." x scan) + "Scanned #x~Z at odd location #x~X." x scan) (error "Scanning an infant object ~Z at ~S (end ~S)." x scan end-location)) ((or (scavenge-wide-typep x :basic-vector #.(bt:enum-value 'movitz:movitz-vector-element-type :u8)) @@ -99,21 +99,21 @@ (scavenge-wide-typep x :basic-vector #.(bt:enum-value 'movitz:movitz-vector-element-type :code))) (assert (evenp scan) () - "Scanned ~Z at odd address #x~X." x scan) + "Scanned ~Z at odd location #x~X." x scan) (let ((len (memref scan 0 1 :lisp))) (check-type len positive-fixnum) (setf *scan-last* (%word-offset scan #.(movitz:tag :other))) (incf scan (1+ (* 2 (truncate (+ 7 len) 8)))))) ((scavenge-wide-typep x :basic-vector #.(bt:enum-value 'movitz:movitz-vector-element-type :u16)) (assert (evenp scan) () - "Scanned ~Z at odd address #x~X." x scan) + "Scanned ~Z at odd location #x~X." x scan) (let ((len (memref scan 0 1 :lisp))) (check-type len positive-fixnum) (setf *scan-last* (%word-offset scan #.(movitz:tag :other))) (incf scan (1+ (* 2 (truncate (+ 3 len) 4)))))) ((scavenge-wide-typep x :basic-vector #.(bt:enum-value 'movitz:movitz-vector-element-type :u32)) (assert (evenp scan) () - "Scanned ~Z at odd address #x~X." x scan) + "Scanned ~Z at odd location #x~X." x scan) (let ((len (memref scan 0 1 :lisp))) (check-type len positive-fixnum) (setf *scan-last* (%word-offset scan #.(movitz:tag :other)))

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/run-time-context.lisp
by Frode Vatvedt Fjeld 20 Jul '04

20 Jul '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv19194 Modified Files: run-time-context.lisp Log Message: Cleaned up most ":int 107" instances. Now, we mostly use the semi-standardized ":int 64" which means that the value in EAX wasn't integer. The default interrupt-handler understands this and signals the appropriate error. Date: Tue Jul 20 01:54:48 2004 Author: ffjeld Index: movitz/losp/muerte/run-time-context.lisp diff -u movitz/losp/muerte/run-time-context.lisp:1.9 movitz/losp/muerte/run-time-context.lisp:1.10 --- movitz/losp/muerte/run-time-context.lisp:1.9 Thu Jul 15 14:07:27 2004 +++ movitz/losp/muerte/run-time-context.lisp Tue Jul 20 01:54:48 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Wed Nov 12 18:33:02 2003 ;;;; -;;;; $Id: run-time-context.lisp,v 1.9 2004/07/15 21:07:27 ffjeld Exp $ +;;;; $Id: run-time-context.lisp,v 1.10 2004/07/20 08:54:48 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -30,24 +30,6 @@ (or (assoc slot-name (slot-value (class-of context) 'slot-map)) (when errorp (error "No run-time-context slot named ~S in ~S." slot-name context)))) - -(define-compiler-macro %run-time-context-slot (&whole form &environment env slot-name - &optional (context '(current-run-time-context))) - (if (not (and (movitz:movitz-constantp slot-name env) - (equal context '(current-run-time-context)))) - form - (let ((slot-name (movitz::eval-form slot-name env))) - (ecase (bt:binary-slot-type 'movitz::movitz-constant-block (intern (symbol-name slot-name) :movitz)) - (movitz::word - `(with-inline-assembly (:returns :eax) - (:locally (:movl (:edi (:edi-offset ,slot-name)) :eax)))) - (movitz::code-vector-word - `(with-inline-assembly (:returns :eax) - (:locally (:movl (:edi (:edi-offset ,slot-name)) :eax)) - (:subl ,movitz::+code-vector-word-offset+ :eax))) - (movitz::lu32 - `(with-inline-assembly (:returns :untagged-fixnum-ecx) - (:locally (:movl (:edi (:edi-offset ,slot-name)) :ecx)))))))) (defun %run-time-context-slot (slot-name &optional (context (current-run-time-context))) (check-type context run-time-context)

1 0

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

20 Jul '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv18880 Modified Files: print.lisp Log Message: Cleaned up most ":int 107" instances. Now, we mostly use the semi-standardized ":int 64" which means that the value in EAX wasn't integer. The default interrupt-handler understands this and signals the appropriate error. Date: Tue Jul 20 01:54:43 2004 Author: ffjeld Index: movitz/losp/muerte/print.lisp diff -u movitz/losp/muerte/print.lisp:1.12 movitz/losp/muerte/print.lisp:1.13 --- movitz/losp/muerte/print.lisp:1.12 Mon Jul 19 02:57:44 2004 +++ movitz/losp/muerte/print.lisp Tue Jul 20 01:54:43 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Mon Sep 3 11:48:19 2001 ;;;; -;;;; $Id: print.lisp,v 1.12 2004/07/19 09:57:44 ffjeld Exp $ +;;;; $Id: print.lisp,v 1.13 2004/07/20 08:54:43 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -312,6 +312,10 @@ (hash-table-count (package-object-external-symbols object)) (hash-table-count (package-object-internal-symbols object)))) (print-unreadable-object (object stream :identity t :type t)))) + (ratio + (write-integer (ratio-numerator object) stream *print-base* *print-radix*) + (write-char #\/ stream) + (write-integer (ratio-denominator object) stream *print-base* nil)) (t (if (not *never-use-print-object*) (print-object object stream) (print-unreadable-object (object stream :identity t)

1 0

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

20 Jul '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv18432 Modified Files: primitive-functions.lisp Log Message: Cleaned up most ":int 107" instances. Now, we mostly use the semi-standardized ":int 64" which means that the value in EAX wasn't integer. The default interrupt-handler understands this and signals the appropriate error. Date: Tue Jul 20 01:54:38 2004 Author: ffjeld Index: movitz/losp/muerte/primitive-functions.lisp diff -u movitz/losp/muerte/primitive-functions.lisp:1.30 movitz/losp/muerte/primitive-functions.lisp:1.31 --- movitz/losp/muerte/primitive-functions.lisp:1.30 Fri Jul 16 18:54:12 2004 +++ movitz/losp/muerte/primitive-functions.lisp Tue Jul 20 01:54:38 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Tue Oct 2 21:02:18 2001 ;;;; -;;;; $Id: primitive-functions.lisp,v 1.30 2004/07/17 01:54:12 ffjeld Exp $ +;;;; $Id: primitive-functions.lisp,v 1.31 2004/07/20 08:54:38 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -530,7 +530,7 @@ (:locally (:movl (:edi (:edi-offset nursery-space)) :eax)) (:testb 7 :al) (:jnz '(:sub-program () - (:int 107))))) + (:int 63))))) (defun malloc-cons-pointer () "Return current cons-pointer in 8-byte units since buffer-start." @@ -633,10 +633,8 @@ :ecx) (:ret) fail - (:int 107)))) + (:int 64)))) (do-it))) - - ;;;;

1 0