movitz-cvs May 2004

movitz-cvs@common-lisp.net

1 participants
48 discussions

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

24 May '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv23968 Modified Files: integers.lisp Log Message: Starting to add some bignum support. Date: Mon May 24 10:58:51 2004 Author: ffjeld Index: movitz/losp/muerte/integers.lisp diff -u movitz/losp/muerte/integers.lisp:1.10 movitz/losp/muerte/integers.lisp:1.11 --- movitz/losp/muerte/integers.lisp:1.10 Wed May 19 11:42:08 2004 +++ movitz/losp/muerte/integers.lisp Mon May 24 10:58:51 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.10 2004/05/19 15:42:08 ffjeld Exp $ +;;;; $Id: integers.lisp,v 1.11 2004/05/24 14:58:51 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -22,6 +22,12 @@ (defconstant most-positive-fixnum #.movitz::+movitz-most-positive-fixnum+) (defconstant most-negative-fixnum #.movitz::+movitz-most-negative-fixnum+) +(deftype positive-fixnum () + `(integer 0 ,movitz:+movitz-most-positive-fixnum+)) + +(deftype positive-bignum () + `(integer ,(1+ movitz:+movitz-most-positive-fixnum+) *)) + (defun fixnump (x) (typep x 'fixnum)) @@ -242,10 +248,26 @@ "Compare real <n1> with fixnum <n2>." (with-inline-assembly (:returns :nothing) ; unspecified (:testb #.movitz::+movitz-fixnum-zmask+ :al) + (:jnz 'not-fixnum) + (:cmpl :ebx :eax) + (:ret) + not-fixnum + (:leal (:eax #.(cl:- (movitz:tag :other))) :ecx) + (:testb 7 :cl) (:jnz '(:sub-program (not-integer) (:int 107) (:jmp 'not-integer))) - (:cmpl :ebx :eax) + (:movl (:eax #.movitz:+other-type-offset+) :ecx) + (:cmpw #.(movitz:tag :bignum 0) :cx) + (:jne 'not-plusbignum) + ;; compare ebx with something bigger + (:cmpl #x-10000000 :edi) + (:ret) + not-plusbignum + (:cmpw #.(movitz:tag :bignum #xff) :cx) + (:jne 'not-integer) + ;; compare ebx with something bigger + (:cmpl #x10000000 :edi) (:ret))) ;;; @@ -256,8 +278,8 @@ (movitz:movitz-constantp max env)) (let ((min (movitz:movitz-eval min env)) (max (movitz:movitz-eval max env))) - (check-type min integer) - (check-type max integer) + (check-type min fixnum) + (check-type max fixnum) ;; (warn "~D -- ~D" min max) (cond ((movitz:movitz-constantp x env) @@ -296,7 +318,7 @@ #+ignore ; this is buggy. ((movitz:movitz-constantp min env) (let ((min (movitz:movitz-eval min env))) - (check-type min integer) + (check-type min fixnum) (cond ((minusp min) `(let ((x ,x)) @@ -372,7 +394,7 @@ (declare (dynamic-extent more-numbers)) (cond ((null more-numbers) - (check-type number integer) + (check-type number fixnum) t) ((not (cdr more-numbers)) (,2op-name number (first more-numbers))) @@ -514,7 +536,7 @@ (if (< number1 number2) number2 number1)) (let ((label (gensym))) - `(with-inline-assembly (:returns :eax :type integer) + `(with-inline-assembly (:returns :eax :type fixnum) (:compile-two-forms (:eax :ebx) ,number1 ,number2) (:movl :ebx :ecx) (:orl :eax :ecx) @@ -650,7 +672,7 @@ `(*%2op ,(movitz:movitz-eval factor2 env) ,factor1)) ((movitz:movitz-constantp factor1 env) (let ((f1 (movitz:movitz-eval factor1 env))) - (check-type f1 integer) + (check-type f1 fixnum) (case f1 (0 `(progn ,factor2 0)) (1 factor2) @@ -708,9 +730,9 @@ `(do-result-mode-case () (:plural (no-macro-call ,@form)) - (t (truncate%2ops%1ret ,number ,divisor)))) + (t (truncate%1ret ,number ,divisor)))) -(defun truncate%2ops%1ret (number divisor) +(defun truncate%1ret (number divisor) (with-inline-assembly (:returns :multiple-values) (:compile-form (:result-mode :eax) number) (:compile-form (:result-mode :ebx) divisor) @@ -723,7 +745,7 @@ (:shll #.movitz::+movitz-fixnum-shift+ :eax) (:clc))) -(define-compiler-macro truncate%2ops%1ret (&whole form &environment env number divisor) +(define-compiler-macro truncate%1ret (&whole form &environment env number divisor) (cond ((movitz:movitz-constantp divisor env) (let ((d (movitz:movitz-eval divisor env))) @@ -731,7 +753,7 @@ (case d (0 (error "Truncate by zero.")) (1 number) - (t `(with-inline-assembly (:returns :eax :type integer) + (t `(with-inline-assembly (:returns :eax :type fixnum) (:compile-form (:result-mode :eax) ,number) (:compile-form (:result-mode :ebx) ,divisor) (:testb #.movitz::+movitz-fixnum-zmask+ :al) @@ -741,26 +763,116 @@ (:shll #.movitz::+movitz-fixnum-shift+ :eax)))))) (t form))) +(defmacro number-double-dispatch ((x y) &rest clauses) + `(let ((x ,x) (y ,y)) + (cond ,@(loop for ((x-type y-type) . then-body) in clauses + collect `((and (typep x ',x-type) (typep y ',y-type)) + ,@then-body)) + (t (error "Not numbers: ~S or ~S." x y))))) + (defun truncate (number &optional (divisor 1)) (numargs-case (1 (number) (values number 0)) (t (number divisor) - (with-inline-assembly (:returns :multiple-values) - (:compile-form (:result-mode :eax) number) - (:compile-form (:result-mode :ebx) divisor) - (:movl :eax :ecx) - (:orl :ebx :ecx) - (:testb #.movitz::+movitz-fixnum-zmask+ :cl) - (:jnz '(:sub-program (not-integer) (:int 107))) - (:cdq :eax :edx) - (:idivl :ebx :eax :edx) - (:shll #.movitz::+movitz-fixnum-shift+ :eax) - (:movl :edx :ebx) - (:xorl :ecx :ecx) - (:movb 2 :cl) ; return values: qutient, remainder. - (:stc))))) - + (number-double-dispatch (number divisor) + ((fixnum fixnum) + (with-inline-assembly (:returns :multiple-values) + (:compile-form (:result-mode :eax) number) + (:compile-form (:result-mode :ebx) divisor) + (:std) + (:cdq :eax :edx) + (:idivl :ebx :eax :edx) + (:shll #.movitz::+movitz-fixnum-shift+ :eax) + (:cld) + (:movl :edx :ebx) + (:xorl :ecx :ecx) + (:movb 2 :cl) ; return values: qutient, remainder. + (:stc))) + ((positive-bignum positive-fixnum) + (let (r n) + (with-inline-assembly (:returns :multiple-values) + (:compile-form (:result-mode :ebx) number) + (:movzxw (:ebx #.(bt:slot-offset 'movitz::movitz-bignum 'movitz::length)) :ecx) + (:cmpl 1 :ecx) + (:jne 'not-size1) + (:compile-form (:result-mode :ecx) divisor) + (:shrl #.movitz:+movitz-fixnum-shift+ :ecx) + (:std) + (:movl (:ebx #.(bt:slot-offset 'movitz::movitz-bignum 'movitz::bigit0)) :eax) + (:xorl :edx :edx) + (:divl :ecx :eax :edx) + (:movl :eax :ecx) + (:shll #.movitz:+movitz-fixnum-shift+ :edx) + (:movl :edi :eax) + (:cld) + (:pushl :edx) + (:call-global-constant normalize-u32-ecx) + (:popl :ebx) + (:jmp 'done) + not-size1 + (:cmpl 2 :ecx) + (:jne 'not-size2) + (:compile-form (:result-mode :ecx) divisor) + (:shrl #.movitz:+movitz-fixnum-shift+ :ecx) + (:std) + (:movl (:ebx #.(cl:+ 4 (bt:slot-offset 'movitz::movitz-bignum 'movitz::bigit0))) + :edx) + (:cmpl :ecx :edx) + (:jae 'not-size2) + (:movl (:ebx #.(bt:slot-offset 'movitz::movitz-bignum 'movitz::bigit0)) :eax) + (:divl :ecx :eax :edx) + (:movl :eax :ecx) + (:shll #.movitz:+movitz-fixnum-shift+ :edx) + (:movl :edi :eax) + (:cld) + (:pushl :edx) + (:call-global-constant normalize-u32-ecx) + (:popl :ebx) + (:jmp 'done) + not-size2 + (:cmpl :ecx (:ebx #.(bt:slot-offset 'movitz::movitz-bignum 'movitz::bigit0) + -4 (:ecx 4))) + (:jc 'shrink-not-size2) + not-shrink + (:leal ((:ecx #.movitz:+movitz-fixnum-factor+)) :eax) + (:compile-form (:result-mode :eax) + (malloc-words (with-inline-assembly (:returns :eax)))) + (:store-lexical (:lexical-binding r) :eax :type t) + (:compile-form (:result-mode :ebx) number) + (:movl (:ebx #.movitz:+other-type-offset+) :ecx) + (:movl :ecx (:eax #.movitz:+other-type-offset+)) + (:shrl 16 :ecx) + + (:xorl :edx :edx) ; edx=hi-digit=0 + ; eax=lo-digit=msd(number) + (:std) + (:compile-form (:result-mode :esi) divisor) + (:shrl #.movitz:+movitz-fixnum-shift+ :esi) + + divide-loop + (:load-lexical (:lexical-binding number) :ebx) + (:movl (:ebx #.(bt:slot-offset 'movitz::movitz-bignum 'movitz::bigit0) + -4 (:ecx 4)) + :eax) + (:divl :esi :eax :edx) + (:load-lexical (:lexical-binding r) :ebx) + (:movl :eax (:ebx #.(bt:slot-offset 'movitz::movitz-bignum 'movitz::bigit0) + -4 (:ecx 4))) + (:subl 1 :ecx) + (:jnz 'divide-loop) + (:movl :ebx :eax) + (:leal ((:edx #.movitz:+movitz-fixnum-factor+)) :ebx) + (:movl :edi :edx) + (:movl (:ebp -4) :esi) + (:cld) + (:jmp 'done) + shrink-not-size2 + (:int 107) + done + (:movl 2 :ecx) + (:stc)))) + )))) (defun round (number &optional (divisor 1)) "Mathematical rounding." @@ -1147,4 +1259,4 @@ (values q 0)) (t (values (1- q) (+ r divisor)))))) (t (n &optional (divisor 1)) - (floor n divisor)))) \ No newline at end of file + (floor n divisor))))

1 0

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

24 May '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv23769 Modified Files: print.lisp Log Message: Starting to add some bignum support. Date: Mon May 24 10:58:44 2004 Author: ffjeld Index: movitz/losp/muerte/print.lisp diff -u movitz/losp/muerte/print.lisp:1.8 movitz/losp/muerte/print.lisp:1.9 --- movitz/losp/muerte/print.lisp:1.8 Wed Apr 21 11:07:48 2004 +++ movitz/losp/muerte/print.lisp Mon May 24 10:58:44 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.8 2004/04/21 15:07:48 ffjeld Exp $ +;;;; $Id: print.lisp,v 1.9 2004/05/24 14:58:44 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -83,7 +83,8 @@ (write-digit (rem x base) stream)))) (defun write-lowlevel-integer (x stream base comma-char comma-interval mincol padchar sign-char pos) - (let ((bigit (truncate x base))) + (multiple-value-bind (bigit rem) + (truncate x base) (cond ((zerop bigit) (when mincol @@ -94,8 +95,8 @@ (when sign-char (write-char sign-char stream))) (t (write-lowlevel-integer bigit stream base comma-char comma-interval - mincol padchar sign-char (1+ pos))))) - (write-digit (rem x base) stream) + mincol padchar sign-char (1+ pos)))) + (write-digit rem stream)) (when (and comma-interval (plusp pos) (zerop (rem pos comma-interval))) (write-char comma-char stream)) nil) @@ -239,7 +240,8 @@ (if (and (plusp (length name)) (every (lambda (c) (or (upper-case-p c) - (member c '(#\- #\% #\$ #\* #\@ #\. #\& #\< #\> #\=)) + (member c '(#\+ #\- #\% #\$ #\* #\@ #\. #\& + #\/ #\< #\> #\=)) (digit-char-p c))) name) (not (every (lambda (c)

1 0

[movitz-cvs] CVS update: movitz/losp/los0.lisp
by Frode Vatvedt Fjeld 24 May '04

24 May '04

Update of /project/movitz/cvsroot/movitz/losp In directory common-lisp.net:/tmp/cvs-serv23601 Modified Files: los0.lisp Log Message: Starting to add some bignum support. Date: Mon May 24 10:58:39 2004 Author: ffjeld Index: movitz/losp/los0.lisp diff -u movitz/losp/los0.lisp:1.13 movitz/losp/los0.lisp:1.14 --- movitz/losp/los0.lisp:1.13 Fri Apr 23 11:04:07 2004 +++ movitz/losp/los0.lisp Mon May 24 10:58:39 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Fri Dec 1 18:08:32 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: los0.lisp,v 1.13 2004/04/23 15:04:07 ffjeld Exp $ +;;;; $Id: los0.lisp,v 1.14 2004/05/24 14:58:39 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -262,6 +262,24 @@ exit (warn "exited: ~S" c))) + +(defun test-bignum () + 123456789123456) + +(defun ff32 () + #xffffffff) + +(defun one32 () + #x100000000) + +(defun test-nbignum () + -123456789123456) + +(defun gt5 (x) + (<= x 5)) + +(defun xplus (x) + (typep x '(integer 0 *))) (defstruct xxx x y (z 'init-z))

1 0

[movitz-cvs] CVS update: movitz/losp/los0-gc.lisp
by Frode Vatvedt Fjeld 24 May '04

24 May '04

Update of /project/movitz/cvsroot/movitz/losp In directory common-lisp.net:/tmp/cvs-serv23392 Modified Files: los0-gc.lisp Log Message: Starting to add some bignum support. Date: Mon May 24 10:58:35 2004 Author: ffjeld Index: movitz/losp/los0-gc.lisp diff -u movitz/losp/los0-gc.lisp:1.10 movitz/losp/los0-gc.lisp:1.11 --- movitz/losp/los0-gc.lisp:1.10 Fri Apr 16 10:44:42 2004 +++ movitz/losp/los0-gc.lisp Mon May 24 10:58:34 2004 @@ -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.10 2004/04/16 14:44:42 ffjeld Exp $ +;;;; $Id: los0-gc.lisp,v 1.11 2004/05/24 14:58:34 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -72,6 +72,33 @@ (:movl :ecx (:edx 2)) (:ret))) +(define-primitive-function los0-normalize-u32-ecx () + "Make u32 in ECX into a fixnum or bignum." + (macrolet + ((do-it () + `(with-inline-assembly (:returns :multiple-values) + (:cmpl ,movitz:+movitz-most-positive-fixnum+ :ecx) + (:ja 'not-fixnum) + (:leal ((:ecx ,movitz:+movitz-fixnum-factor+)) :eax) + (:ret) + not-fixnum + retry-cons + (:locally (:movl (:edi (:edi-offset nursery-space)) :edx)) + (:movl (:edx 2) :eax) + (:cmpl #x3fff4 :eax) + (:jge '(:sub-program () + (:int 113) ; This interrupt can be retried. + (:jmp 'retry-cons))) + (:movl ,(dpb 1 (byte 16 16) (movitz:tag :bignum 0)) + (:edx :eax 2)) + (:movl :ecx (:edx :eax 6)) + (:addl 8 :eax) + (:movl :eax (:edx 2)) + (:leal (:edx :eax) :eax) + (:ret) + (:int 107)))) + (do-it))) + (defun los0-malloc-clumps (clumps) (check-type clumps (integer 0 4000)) (with-inline-assembly (:returns :eax) @@ -129,6 +156,10 @@ (let ((conser (symbol-value 'los0-fast-cons))) (check-type conser vector) (setf (%run-time-context-slot 'muerte::fast-cons) + conser)) + (let ((conser (symbol-value 'los0-normalize-u32-ecx))) + (check-type conser vector) + (setf (%run-time-context-slot 'muerte::normalize-u32-ecx) conser)) (let ((old-malloc (symbol-function 'muerte:malloc-clumps))) (setf (symbol-function 'muerte:malloc-clumps)

1 0

[movitz-cvs] CVS update: movitz/packages.lisp
by Frode Vatvedt Fjeld 24 May '04

24 May '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv22784 Modified Files: packages.lisp Log Message: Starting to add some bignum support. Date: Mon May 24 10:58:27 2004 Author: ffjeld Index: movitz/packages.lisp diff -u movitz/packages.lisp:1.22 movitz/packages.lisp:1.23 --- movitz/packages.lisp:1.22 Fri May 21 05:39:40 2004 +++ movitz/packages.lisp Mon May 24 10:58:27 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Sat Nov 15 21:39:55 2003 ;;;; -;;;; $Id: packages.lisp,v 1.22 2004/05/21 09:39:40 ffjeld Exp $ +;;;; $Id: packages.lisp,v 1.23 2004/05/24 14:58:27 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -1283,6 +1283,7 @@ (:export #:create-image #:dump-image + #:class-object-offset #:other-type-byte #:+other-type-offset+ #:parse-docstring-and-declarations

1 0

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

24 May '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv22002 Modified Files: storage-types.lisp Log Message: Starting to add some bignum support. Date: Mon May 24 10:58:22 2004 Author: ffjeld Index: movitz/storage-types.lisp diff -u movitz/storage-types.lisp:1.17 movitz/storage-types.lisp:1.18 --- movitz/storage-types.lisp:1.17 Fri May 21 05:39:30 2004 +++ movitz/storage-types.lisp Mon May 24 10:58: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.17 2004/05/21 09:39:30 ffjeld Exp $ +;;;; $Id: storage-types.lisp,v 1.18 2004/05/24 14:58:22 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -74,6 +74,7 @@ :run-time-context #x50 :illegal #x13 :infant-object #x23 + :bignum #x4a ;; :simple-vector #x20 ;; :character-vector @@ -84,8 +85,9 @@ (defconstant +fixnum-tags+ '(:even-fixnum :odd-fixnum)) (defparameter +scan-skip-word+ #x00000003) -(defun tag (type) - (bt:enum-value 'other-type-byte type)) +(defun tag (type &optional (wide-tag 0)) + (logior (bt:enum-value 'other-type-byte type) + (ash wide-tag 8))) (defun tag-name (number) (bt:enum-symbolic-value 'other-type-byte number)) @@ -1289,3 +1291,42 @@ :stream stream)))) object) +;;;; + +(define-binary-class movitz-bignum (movitz-heap-object-other) + ((type + :binary-type other-type-byte + :initform :bignum) + (sign + :binary-type u8 + :initarg :sign + :accessor movitz-bignum-sign) + (length + :binary-type lu16 + :initarg :length + :accessor movitz-bignum-length) + (bigit0 :binary-type :label) + (value + :initarg :value + :accessor movitz-bignum-value)) + (:slot-align type #.+other-type-offset+)) + +(defmethod write-binary-record ((obj movitz-bignum) stream) + (let* ((num (movitz-bignum-value obj)) + (length (ceiling (integer-length (abs num)) 32))) + (check-type length (unsigned-byte 16)) + (setf (movitz-bignum-length obj) length + (movitz-bignum-sign obj) (if (minusp num) #xff #x00)) + (+ (call-next-method) ; header + (loop for b from 0 below length + summing (write-binary 'lu32 stream (ldb (byte 32 (* b 32)) (abs num))))))) + +(defun make-movitz-integer (value) + (if (<= +movitz-most-negative-fixnum+ value +movitz-most-positive-fixnum+) + (make-movitz-fixnum value) + (make-instance 'movitz-bignum + :value value))) + +(defmethod sizeof ((obj movitz-bignum)) + (+ (sizeof 'movitz-bignum) + (* 4 (ceiling (integer-length (abs (movitz-bignum-value obj))) 32))))

1 0

[movitz-cvs] CVS update: movitz/movitz-mode.el
by Frode Vatvedt Fjeld 24 May '04

24 May '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv21530 Modified Files: movitz-mode.el Log Message: Starting to add some bignum support. Date: Mon May 24 10:58:17 2004 Author: ffjeld Index: movitz/movitz-mode.el diff -u movitz/movitz-mode.el:1.5 movitz/movitz-mode.el:1.6 --- movitz/movitz-mode.el:1.5 Wed May 19 10:57:46 2004 +++ movitz/movitz-mode.el Mon May 24 10:58:17 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Thu Sep 27 18:12:17 2001 ;;;; -;;;; $Id: movitz-mode.el,v 1.5 2004/05/19 14:57:46 ffjeld Exp $ +;;;; $Id: movitz-mode.el,v 1.6 2004/05/24 14:58:17 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -301,6 +301,7 @@ (put 'vector-double-dispatch tag '(like case)) (put 'sequence-dispatch tag '(like case)) (put 'sequence-double-dispatch tag '(like case)) + (put 'number-double-dispatch tag '(like case)) (put 'simple-stream-dispatch tag '(like case)) (put 'with-inline-assembly tag '(like prog)) (put 'with-inline-assembly-case tag '(like prog))

1 0

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

24 May '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv21343 Modified Files: image.lisp Log Message: Starting to add some bignum support. Date: Mon May 24 10:58:12 2004 Author: ffjeld Index: movitz/image.lisp diff -u movitz/image.lisp:1.29 movitz/image.lisp:1.30 --- movitz/image.lisp:1.29 Fri May 21 05:38:52 2004 +++ movitz/image.lisp Mon May 24 10:58:12 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.29 2004/05/21 09:38:52 ffjeld Exp $ +;;;; $Id: image.lisp,v 1.30 2004/05/24 14:58:12 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -226,6 +226,11 @@ :map-binary-write 'movitz-intern-code-vector :map-binary-read-delayed 'movitz-word-code-vector :binary-tag :primitive-function) + (normalize-u32-ecx + :binary-type code-vector-word + :map-binary-write 'movitz-intern-code-vector + :map-binary-read-delayed 'movitz-word-code-vector + :binary-tag :primitive-function) (malloc :binary-type code-vector-word :map-binary-write 'movitz-intern-code-vector @@ -543,6 +548,7 @@ (defmethod image-classes-map ((image symbolic-image)) '(muerte.cl:null muerte.cl:cons muerte.cl:fixnum muerte.cl:symbol muerte.cl:character muerte.cl:function muerte.cl:condition + muerte.cl:integer muerte.cl:ratio muerte.cl:vector muerte.cl:string muerte.cl:array muerte.cl:class muerte.cl:standard-class muerte.cl:standard-generic-function @@ -553,9 +559,10 @@ muerte:illegal-object)) (defun class-object-offset (name) - (+ (bt:slot-offset 'movitz-vector 'data) - (* 4 (1+ (or (position name (image-classes-map *image*)) - (error "No class named ~S in class-map." name)))))) + (let ((name (translate-program name :cl :muerte.cl))) + (+ (bt:slot-offset 'movitz-vector 'data) + (* 4 (1+ (or (position name (image-classes-map *image*)) + (error "No class named ~S in class-map." name))))))) (defun unbound-value () (declare (special *image*)) @@ -1361,7 +1368,7 @@ (null *movitz-nil*) ((member t) (movitz-read 'muerte.cl:t)) (symbol (intern-movitz-symbol expr)) - (integer (make-movitz-fixnum expr)) + (integer (make-movitz-integer expr)) (character (make-movitz-character expr)) (string (or (gethash expr (image-string-constants *image*)) (setf (gethash expr (image-string-constants *image*))

1 0

[movitz-cvs] CVS update: movitz/stream-image.lisp
by Frode Vatvedt Fjeld 24 May '04

24 May '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv21170 Modified Files: stream-image.lisp Log Message: Starting to add some bignum support. Date: Mon May 24 10:58:07 2004 Author: ffjeld Index: movitz/stream-image.lisp diff -u movitz/stream-image.lisp:1.4 movitz/stream-image.lisp:1.5 --- movitz/stream-image.lisp:1.4 Wed Mar 31 11:34:47 2004 +++ movitz/stream-image.lisp Mon May 24 10:58:07 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Mon Aug 27 14:46:50 2001 ;;;; -;;;; $Id: stream-image.lisp,v 1.4 2004/03/31 16:34:47 ffjeld Exp $ +;;;; $Id: stream-image.lisp,v 1.5 2004/05/24 14:58:07 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -80,7 +80,8 @@ (:other (setf (image-stream-position image) (+ 4 (extract-pointer word))) - (let ((type-tag (read-binary 'other-type-byte (image-stream image)))) + (let* ((type-code (read-binary 'u8 (image-stream image))) + (type-tag (enum-symbolic-value 'other-type-byte type-code))) (setf (image-stream-position image) (extract-pointer word)) (case type-tag @@ -92,7 +93,8 @@ (read-binary 'movitz-struct (image-stream image))) (:std-instance (read-binary 'movitz-std-instance (image-stream image))) - (t (warn "unknown other object: #x~X: ~S" word type-tag) + (t (warn "unknown other object: #x~X: ~S code #x~X." + word type-tag type-code) (make-instance 'movitz-fixnum :value (truncate word 4)))))) (t (make-instance 'movitz-fixnum :value 0))))) (when (typep object 'movitz-heap-object)

1 0

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

24 May '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv18785 Modified Files: compiler.lisp Log Message: Starting to add some bignum support. Date: Mon May 24 10:58:01 2004 Author: ffjeld Index: movitz/compiler.lisp diff -u movitz/compiler.lisp:1.59 movitz/compiler.lisp:1.60 --- movitz/compiler.lisp:1.59 Fri Apr 23 10:58:52 2004 +++ movitz/compiler.lisp Mon May 24 10:58:00 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.59 2004/04/23 14:58:52 ffjeld Exp $ +;;;; $Id: compiler.lisp,v 1.60 2004/05/24 14:58:00 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -4786,12 +4786,9 @@ :provider provider)) (:untagged-fixnum-ecx (case (result-mode-type desired-result) - ((:eax :ebx :ecx :edx) - (values (append code `((:cmpl ,+movitz-most-positive-fixnum+ :ecx) - (:ja '(:sub-program () - (:int 4))) - (:leal ((:ecx ,+movitz-fixnum-factor+) :edi ,(edi-offset)) - ,desired-result))) + ((:eax :single-value) + (values (append code + `((:call (:edi ,(global-constant-offset 'normalize-u32-ecx))))) desired-result)) (t (make-result-and-returns-glue desired-result :eax (make-result-and-returns-glue :eax :untagged-fixnum-ecx code

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 May 2004