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

[movitz-cvs] CVS update: movitz/slime-movitz.el
by Frode Vatvedt Fjeld 17 Mar '04

17 Mar '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv32571 Added Files: slime-movitz.el Log Message: >From Aleksandar Bakic. Date: Wed Mar 17 03:26:50 2004 Author: ffjeld

1 0

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

12 Mar '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv15616 Modified Files: conditions.lisp Log Message: Improved error message in signal-simple. Date: Fri Mar 12 06:47:42 2004 Author: ffjeld Index: movitz/losp/muerte/conditions.lisp diff -u movitz/losp/muerte/conditions.lisp:1.2 movitz/losp/muerte/conditions.lisp:1.3 --- movitz/losp/muerte/conditions.lisp:1.2 Mon Jan 19 06:23:46 2004 +++ movitz/losp/muerte/conditions.lisp Fri Mar 12 06:47:41 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.2 2004/01/19 11:23:46 ffjeld Exp $ +;;;; $Id: conditions.lisp,v 1.3 2004/03/12 11:47:41 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -250,7 +250,8 @@ (declare (dynamic-extent arguments)) (let* ((class (etypecase datum (symbol - (find-class datum)) + (or (find-class datum nil) + (error "No condition class named ~S." datum))) (string (find-class default-type)) (condition

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/arrays.lisp
by Frode Vatvedt Fjeld 08 Mar '04

08 Mar '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv9248 Modified Files: arrays.lisp Log Message: Fixed stupid bug in aref in previous check-in. Date: Mon Mar 8 09:33:52 2004 Author: ffjeld Index: movitz/losp/muerte/arrays.lisp diff -u movitz/losp/muerte/arrays.lisp:1.4 movitz/losp/muerte/arrays.lisp:1.5 --- movitz/losp/muerte/arrays.lisp:1.4 Mon Mar 8 09:26:13 2004 +++ movitz/losp/muerte/arrays.lisp Mon Mar 8 09:33:52 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.4 2004/03/08 14:26:13 ffjeld Exp $ +;;;; $Id: arrays.lisp,v 1.5 2004/03/08 14:33:52 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -199,7 +199,7 @@ (:compile-form (:result-mode :ignore) (error "Not a vector: ~S" vector)))) -;;; (:shrl #.movitz::+movitz-fixnum-shift+ :ebx) + (:shrl #.movitz::+movitz-fixnum-shift+ :ebx) (:movzxw (:eax -2) :ecx) (:cmpw (:eax #.(bt:slot-offset 'movitz:movitz-vector 'movitz::num-elements)) :bx) @@ -209,13 +209,12 @@ (:cmpl #.(movitz:vector-type-tag :any-t) :ecx) (:jne 'not-any-t) - (:movl (:eax :ebx 2) :eax) + (:movl (:eax (:ebx 4) 2) :eax) (:jmp 'done) not-any-t (:cmpl #.(movitz:vector-type-tag :character) :ecx) (:jne 'not-character) - (:shrl #.movitz::+movitz-fixnum-shift+ :ebx) (:movb (:eax :ebx 2) :bl) (:xorl :eax :eax) (:movb :bl :ah) @@ -225,7 +224,6 @@ not-character (:cmpl #.(movitz:vector-type-tag :u8) :ecx) (:jne 'not-u8) - (:shrl #.movitz::+movitz-fixnum-shift+ :ebx) (:movzxb (:eax :ebx 2) :eax) ; u8 (:shll #.movitz::+movitz-fixnum-shift+ :eax) (:jmp 'done) @@ -233,14 +231,13 @@ not-u8 (:cmpl #.(movitz:vector-type-tag :u16) :ecx) (:je 'not-u16) - (:shrl #.(cl:1- movitz::+movitz-fixnum-shift+) :ebx) - (:movzxw (:eax :ebx 2) :eax) ; u16 + (:movzxw (:eax (:ebx 2) 2) :eax) ; u16 (:jmp 'done) not-u16 (:cmpl #.(movitz:vector-type-tag :u32) :ecx) (:je 'not-u32) - (:movl (:eax :ebx 2) :ecx) ; u32 + (:movl (:eax (:ebx 4) 2) :ecx) ; u32 (:cmpl #.movitz::+movitz-most-positive-fixnum+ :ecx) (:jg '(:sub-program (:overflowing-u32) (:int 107)))

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/arrays.lisp
by Frode Vatvedt Fjeld 08 Mar '04

08 Mar '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv20499 Modified Files: arrays.lisp Log Message: Minor fixes to aref and (setf aref). Date: Mon Mar 8 09:26:13 2004 Author: ffjeld Index: movitz/losp/muerte/arrays.lisp diff -u movitz/losp/muerte/arrays.lisp:1.3 movitz/losp/muerte/arrays.lisp:1.4 --- movitz/losp/muerte/arrays.lisp:1.3 Mon Mar 8 08:17:38 2004 +++ movitz/losp/muerte/arrays.lisp Mon Mar 8 09:26:13 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.3 2004/03/08 13:17:38 ffjeld Exp $ +;;;; $Id: arrays.lisp,v 1.4 2004/03/08 14:26:13 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -183,141 +183,163 @@ done)) -(defun aref (vector index) - (with-inline-assembly (:returns :eax) - (:compile-form (:result-mode :eax) vector) - (:compile-form (:result-mode :ebx) index) - (:leal (:eax #.(cl:- (movitz::tag :other))) :ecx) - (:testb #.movitz::+movitz-fixnum-zmask+ :bl) - (:jnz '(:sub-program (not-fixnum) (:int 107))) ; index not fixnum - (:andl #.(cl:ash #x000ffff movitz::+movitz-fixnum-shift+) :ebx) - (:testb 7 :cl) - (:jnz '(:sub-program () (:int 60))) ; not other-type - (:shrl #.movitz::+movitz-fixnum-shift+ :ebx) - (:movw (:eax -2) :cx) - (:cmpb #.(movitz::tag :vector) :cl) - (:jne '(:sub-program () (:int 60) (:jmp (:pc+ -4)))) ; not vector-type - (:cmpw (:eax -4) :bx) - (:jae '(:sub-program () - (:movzxw :bx :eax) - (:int 61) (:jmp (:pc+ -4)))) ; index out of bounds - (:testb :ch :ch) ; element-type 0? - (:jnz 'not-any-t) - (:movl (:eax (:ebx 4) 2) :eax) - (:jmp 'done) - - not-any-t - (:decb :ch) ; element-type 1? - (:jnz 'not-character) - (:movb (:eax :ebx 2) :bl) - (:xorl :eax :eax) - (:movb :bl :ah) - (:movb #.(movitz::tag :character) :al) ; character - (:jmp 'done) - - not-character - (:decb :ch) - (:jnz 'not-u8) - (:movzxb (:eax :ebx 2) :eax) ; u8 - (:shll #.movitz::+movitz-fixnum-shift+ :eax) - (:jmp 'done) - - not-u8 - (:decb :ch) - (:jnz 'not-u16) - (:movzxw (:eax (:ebx 2) 2) :eax) ; u16 - (:jmp 'done) - - not-u16 - (:decb :ch) - (:jnz 'not-u32) - (:movl (:eax (:ebx 4) 2) :ecx) ; u32 - (:cmpl #.movitz::+movitz-most-positive-fixnum+ :ecx) - (:jg '(:sub-program (:overflowing-u32) - (:int 107))) - (:leal ((:ecx #.movitz::+movitz-fixnum-factor+)) :eax) - (:jmp 'done) - - not-u32 - (:int 107) - - done)) - -(defun (setf aref) (value vector index) - (with-inline-assembly (:returns :ebx) - (:compile-form (:result-mode :ebx) value) - (:compile-form (:result-mode :eax) vector) - - (:leal (:eax #.(cl:- (movitz::tag :other))) :ecx) - (:testb 7 :cl) - (:jnz '(:sub-program () (:int 60) (:jmp (:pc+ -4)))) ; not other-type - (:movzxw (:eax -2) :edx) - - (:compile-form (:result-mode :ecx) index) - (:testb #.movitz::+movitz-fixnum-zmask+ :cl) - (:jnz '(:sub-program () (:int 107))) ; index not fixnum - (:andl #.(cl:ash #xffff movitz::+movitz-fixnum-shift+) :ecx) - (:shrl #.movitz::+movitz-fixnum-shift+ :ecx) - - (:cmpw (:eax -4) :cx) - (:jae '(:sub-program () (:int 61) (:jmp (:pc+ -4)))) ; index out of bounds - - (:cmpl #.(movitz:vector-type-tag :any-t) :edx) - (:jnz 'not-any-t) - - (:movl :ebx (:eax (:ecx 4) 2)) - (:jmp 'done) - - not-any-t - (:cmpl #.(movitz:vector-type-tag :character) :edx) - (:jnz 'not-character) - (:cmpb #.(movitz:tag :character) :bl) - (:jnz '(:sub-program (not-character-value) - (:compile-form (:result-mode :ignore) - (error "Value not character: ~S" value)))) - (:movb :bh (:eax :ecx 2)) - (:jmp 'done) - - not-character - (:cmpl #.(movitz:vector-type-tag :u8) :edx) - (:jnz 'not-u8) - (:testl #.(cl:ldb (cl:byte 32 0) (cl:- -1 (cl:* #xff movitz:+movitz-fixnum-factor+))) :ebx) - (:jnz '(:sub-program (not-u8-value) - (:compile-form (:result-mode :ignore) - (error "Value not (unsigned-byte 8): ~S" value)))) - (:shrl #.movitz:+movitz-fixnum-shift+ :ebx) - (:movb :bl (:eax (:ecx 1) #.(bt:slot-offset 'movitz:movitz-vector 'movitz::data))) - (:leal ((:ebx #.movitz:+movitz-fixnum-factor+)) :ebx) - (:jmp 'done) - - - not-u8 - (:cmpl #.(movitz:vector-type-tag :u16) :edx) - (:jnz 'not-u16) - (:testl #.(cl:ldb (cl:byte 32 0) (cl:- -1 (cl:* #xffff movitz:+movitz-fixnum-factor+))) :ebx) - (:jnz '(:sub-program (not-u16-value) - (:compile-form (:result-mode :ignore) - (error "Value not (unsigned-byte 16): ~S" value)))) - (:shrl #.movitz:+movitz-fixnum-shift+ :ebx) - (:movw :bx (:eax (:ecx 2) #.(bt:slot-offset 'movitz:movitz-vector 'movitz::data))) - (:leal ((:ebx #.movitz:+movitz-fixnum-factor+)) :ebx) - (:jmp 'done) - - not-u16 - (:cmpl #.(movitz:vector-type-tag :u32) :edx) - (:jnz 'not-u32) - (:testl #.(cl:ldb (cl:byte 32 0) (cl:- -1 (cl:* #xffffffff movitz:+movitz-fixnum-factor+))) :ebx) - (:jnz '(:sub-program (not-u32-value) - (:compile-form (:result-mode :ignore) - (error "Value not (unsigned-byte 32): ~S" value)))) - (:shrl #.movitz:+movitz-fixnum-shift+ :ebx) - (:movw :bx (:eax (:ecx 4) #.(bt:slot-offset 'movitz:movitz-vector 'movitz::data))) - (:leal ((:ebx #.movitz:+movitz-fixnum-factor+)) :ebx) - (:jmp 'done) - - not-u32 - (:compile-form (:result-mode :ignore) (error "Not a vector: ~S" vector)) - done)) +(defun aref (vector &rest subscripts) + (numargs-case + (2 (vector index) + (with-inline-assembly (:returns :eax) + (:compile-form (:result-mode :eax) vector) + (:compile-form (:result-mode :ebx) index) + (:leal (:eax #.(cl:- (movitz::tag :other))) :ecx) + (:testb #.movitz::+movitz-fixnum-zmask+ :bl) + (:jnz '(:sub-program (not-fixnum) (:int 107))) ; index not fixnum + (:andl #.(cl:ash #x000ffff movitz::+movitz-fixnum-shift+) :ebx) + + (:testb 7 :cl) + (:jnz '(:sub-program () + (:compile-form (:result-mode :ignore) + (error "Not a vector: ~S" vector)))) + +;;; (:shrl #.movitz::+movitz-fixnum-shift+ :ebx) + (:movzxw (:eax -2) :ecx) + + (:cmpw (:eax #.(bt:slot-offset 'movitz:movitz-vector 'movitz::num-elements)) :bx) + (:jae '(:sub-program () + (:compile-form (:result-mode :ignore) + (error "Index ~D out of bounds ~D." index (length vector))))) + + (:cmpl #.(movitz:vector-type-tag :any-t) :ecx) + (:jne 'not-any-t) + (:movl (:eax :ebx 2) :eax) + (:jmp 'done) + + not-any-t + (:cmpl #.(movitz:vector-type-tag :character) :ecx) + (:jne 'not-character) + (:shrl #.movitz::+movitz-fixnum-shift+ :ebx) + (:movb (:eax :ebx 2) :bl) + (:xorl :eax :eax) + (:movb :bl :ah) + (:movb #.(movitz::tag :character) :al) ; character + (:jmp 'done) + + not-character + (:cmpl #.(movitz:vector-type-tag :u8) :ecx) + (:jne 'not-u8) + (:shrl #.movitz::+movitz-fixnum-shift+ :ebx) + (:movzxb (:eax :ebx 2) :eax) ; u8 + (:shll #.movitz::+movitz-fixnum-shift+ :eax) + (:jmp 'done) + + not-u8 + (:cmpl #.(movitz:vector-type-tag :u16) :ecx) + (:je 'not-u16) + (:shrl #.(cl:1- movitz::+movitz-fixnum-shift+) :ebx) + (:movzxw (:eax :ebx 2) :eax) ; u16 + (:jmp 'done) + + not-u16 + (:cmpl #.(movitz:vector-type-tag :u32) :ecx) + (:je 'not-u32) + (:movl (:eax :ebx 2) :ecx) ; u32 + (:cmpl #.movitz::+movitz-most-positive-fixnum+ :ecx) + (:jg '(:sub-program (:overflowing-u32) + (:int 107))) + (:leal ((:ecx #.movitz::+movitz-fixnum-factor+)) :eax) + (:jmp 'done) + + not-u32 + (:compile-form (:result-mode :ignore) + (error "Not a vector: ~S" vector)) + + done)) + (t (vector &rest subscripts) + (declare (dynamic-extent subscripts) + (ignore vector subscripts)) + (error "Multi-dimensional arrays not implemented.")))) + +(defun (setf aref) (value vector &rest subscripts) + (numargs-case + (3 (value vector index) + (with-inline-assembly (:returns :ebx) + (:compile-form (:result-mode :ebx) value) + (:compile-form (:result-mode :eax) vector) + + (:leal (:eax #.(cl:- (movitz::tag :other))) :ecx) + (:testb 7 :cl) + (:jnz '(:sub-program () + (:compile-form (:result-mode :ignore) + (error "Not a vector: ~S" vector)))) + (:movzxw (:eax -2) :edx) + + (:compile-form (:result-mode :ecx) index) + (:testb #.movitz::+movitz-fixnum-zmask+ :cl) + (:jnz '(:sub-program () (:int 107))) ; index not fixnum + (:andl #.(cl:ash #xffff movitz::+movitz-fixnum-shift+) :ecx) + (:shrl #.movitz::+movitz-fixnum-shift+ :ecx) + + (:cmpw (:eax #.(bt:slot-offset 'movitz:movitz-vector 'movitz::num-elements)) :cx) + (:jae '(:sub-program () (:int 61) (:jmp (:pc+ -4)))) ; index out of bounds + + (:cmpl #.(movitz:vector-type-tag :any-t) :edx) + (:jnz 'not-any-t) + + (:movl :ebx (:eax (:ecx 4) 2)) + (:jmp 'done) + + not-any-t + (:cmpl #.(movitz:vector-type-tag :character) :edx) + (:jnz 'not-character) + (:cmpb #.(movitz:tag :character) :bl) + (:jnz '(:sub-program (not-character-value) + (:compile-form (:result-mode :ignore) + (error "Value not character: ~S" value)))) + (:movb :bh (:eax :ecx 2)) + (:jmp 'done) + + not-character + (:cmpl #.(movitz:vector-type-tag :u8) :edx) + (:jnz 'not-u8) + (:testl #.(cl:ldb (cl:byte 32 0) (cl:- -1 (cl:* #xff movitz:+movitz-fixnum-factor+))) :ebx) + (:jnz '(:sub-program (not-u8-value) + (:compile-form (:result-mode :ignore) + (error "Value not (unsigned-byte 8): ~S" value)))) + (:shrl #.movitz:+movitz-fixnum-shift+ :ebx) + (:movb :bl (:eax (:ecx 1) #.(bt:slot-offset 'movitz:movitz-vector 'movitz::data))) + (:leal ((:ebx #.movitz:+movitz-fixnum-factor+)) :ebx) + (:jmp 'done) + + + not-u8 + (:cmpl #.(movitz:vector-type-tag :u16) :edx) + (:jnz 'not-u16) + (:testl #.(cl:ldb (cl:byte 32 0) (cl:- -1 (cl:* #xffff movitz:+movitz-fixnum-factor+))) :ebx) + (:jnz '(:sub-program (not-u16-value) + (:compile-form (:result-mode :ignore) + (error "Value not (unsigned-byte 16): ~S" value)))) + (:shrl #.movitz:+movitz-fixnum-shift+ :ebx) + (:movw :bx (:eax (:ecx 2) #.(bt:slot-offset 'movitz:movitz-vector 'movitz::data))) + (:leal ((:ebx #.movitz:+movitz-fixnum-factor+)) :ebx) + (:jmp 'done) + + not-u16 + (:cmpl #.(movitz:vector-type-tag :u32) :edx) + (:jnz 'not-u32) + (:testl #.(cl:ldb (cl:byte 32 0) (cl:- -1 (cl:* #xffffffff movitz:+movitz-fixnum-factor+))) :ebx) + (:jnz '(:sub-program (not-u32-value) + (:compile-form (:result-mode :ignore) + (error "Value not (unsigned-byte 32): ~S" value)))) + (:shrl #.movitz:+movitz-fixnum-shift+ :ebx) + (:movw :bx (:eax (:ecx 4) #.(bt:slot-offset 'movitz:movitz-vector 'movitz::data))) + (:leal ((:ebx #.movitz:+movitz-fixnum-factor+)) :ebx) + (:jmp 'done) + + not-u32 + (:compile-form (:result-mode :ignore) (error "Not a vector: ~S" vector)) + done)) + (t (value vector &rest subscripts) + (declare (dynamic-extent subscripts) + (ignore value vector subscripts)) + (error "Multi-dimensional arrays not implemented.")))) ;;; simple-vector accessors @@ -329,7 +351,9 @@ `(setf (memref ,simple-vector 2 ,index :lisp) ,value)) (defun svref%unsafe (simple-vector index) - (svref%unsafe simple-vector index)) + (with-inline-assembly (:returns :eax) + (:compile-two-forms (:eax :ebx) simple-vector index) + (:movl (:eax :ebx #.(bt:slot-offset 'movitz:movitz-vector 'movitz::data)) :eax))) (defun (setf svref%unsafe) (value simple-vector index) (setf (svref%unsafe simple-vector index) value)) @@ -447,10 +471,6 @@ (values #'u8ref%unsafe #'(setf u8ref%unsafe))) (#.(bt:enum-value 'movitz::movitz-vector-element-type :u32) (values #'u32ref%unsafe #'(setf u32ref%unsafe))) -;;; (#.(bt:enum-value 'movitz::movitz-vector-element-type :u16) -;;; '(unsigned-byte 16)) -;;; (#.(bt:enum-value 'movitz::movitz-vector-element-type :u32) -;;; '(unsigned-byte 32)) (t (warn "don't know about vector's element-type: ~S" vector) (values #'aref #'(setf aref)))))

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/arrays.lisp
by Frode Vatvedt Fjeld 08 Mar '04

08 Mar '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv10377 Modified Files: arrays.lisp Log Message: Improved (setf aref). Date: Mon Mar 8 08:17:38 2004 Author: ffjeld Index: movitz/losp/muerte/arrays.lisp diff -u movitz/losp/muerte/arrays.lisp:1.2 movitz/losp/muerte/arrays.lisp:1.3 --- movitz/losp/muerte/arrays.lisp:1.2 Mon Jan 19 06:23:46 2004 +++ movitz/losp/muerte/arrays.lisp Mon Mar 8 08:17:38 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.2 2004/01/19 11:23:46 ffjeld Exp $ +;;;; $Id: arrays.lisp,v 1.3 2004/03/08 13:17:38 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -252,8 +252,6 @@ (:testb 7 :cl) (:jnz '(:sub-program () (:int 60) (:jmp (:pc+ -4)))) ; not other-type (:movzxw (:eax -2) :edx) - (:cmpb #.(movitz::tag :vector) :dl) - (:jne '(:sub-program () (:int 60) (:jmp (:pc+ -4)))) ; not vector-type (:compile-form (:result-mode :ecx) index) (:testb #.movitz::+movitz-fixnum-zmask+ :cl) @@ -262,27 +260,64 @@ (:shrl #.movitz::+movitz-fixnum-shift+ :ecx) (:cmpw (:eax -4) :cx) - (:jae '(:sub-program () (:int 61) (:jmp (:pc+ -4)))) ; index out of bounds - (:testb :dh :dh) ; element-type 0? + (:jae '(:sub-program () (:int 61) (:jmp (:pc+ -4)))) ; index out of bounds + + (:cmpl #.(movitz:vector-type-tag :any-t) :edx) (:jnz 'not-any-t) (:movl :ebx (:eax (:ecx 4) 2)) (:jmp 'done) - not-any-t - (:decb :dh) ; element-type 1? + not-any-t + (:cmpl #.(movitz:vector-type-tag :character) :edx) (:jnz 'not-character) + (:cmpb #.(movitz:tag :character) :bl) + (:jnz '(:sub-program (not-character-value) + (:compile-form (:result-mode :ignore) + (error "Value not character: ~S" value)))) (:movb :bh (:eax :ecx 2)) (:jmp 'done) - not-character - (:decb :dh) - (:jnz '(:sub-program (not-u8) (:int 62) (:jmp (:pc+ -4)))) - (:shll #.(cl:- 8 movitz::+movitz-fixnum-shift+) :ebx) - (:movb :bh (:eax :ecx 2)) - (:shrl #.(cl:- 8 movitz::+movitz-fixnum-shift+) :ebx) + not-character + (:cmpl #.(movitz:vector-type-tag :u8) :edx) + (:jnz 'not-u8) + (:testl #.(cl:ldb (cl:byte 32 0) (cl:- -1 (cl:* #xff movitz:+movitz-fixnum-factor+))) :ebx) + (:jnz '(:sub-program (not-u8-value) + (:compile-form (:result-mode :ignore) + (error "Value not (unsigned-byte 8): ~S" value)))) + (:shrl #.movitz:+movitz-fixnum-shift+ :ebx) + (:movb :bl (:eax (:ecx 1) #.(bt:slot-offset 'movitz:movitz-vector 'movitz::data))) + (:leal ((:ebx #.movitz:+movitz-fixnum-factor+)) :ebx) + (:jmp 'done) + + + not-u8 + (:cmpl #.(movitz:vector-type-tag :u16) :edx) + (:jnz 'not-u16) + (:testl #.(cl:ldb (cl:byte 32 0) (cl:- -1 (cl:* #xffff movitz:+movitz-fixnum-factor+))) :ebx) + (:jnz '(:sub-program (not-u16-value) + (:compile-form (:result-mode :ignore) + (error "Value not (unsigned-byte 16): ~S" value)))) + (:shrl #.movitz:+movitz-fixnum-shift+ :ebx) + (:movw :bx (:eax (:ecx 2) #.(bt:slot-offset 'movitz:movitz-vector 'movitz::data))) + (:leal ((:ebx #.movitz:+movitz-fixnum-factor+)) :ebx) + (:jmp 'done) - done)) + not-u16 + (:cmpl #.(movitz:vector-type-tag :u32) :edx) + (:jnz 'not-u32) + (:testl #.(cl:ldb (cl:byte 32 0) (cl:- -1 (cl:* #xffffffff movitz:+movitz-fixnum-factor+))) :ebx) + (:jnz '(:sub-program (not-u32-value) + (:compile-form (:result-mode :ignore) + (error "Value not (unsigned-byte 32): ~S" value)))) + (:shrl #.movitz:+movitz-fixnum-shift+ :ebx) + (:movw :bx (:eax (:ecx 4) #.(bt:slot-offset 'movitz:movitz-vector 'movitz::data))) + (:leal ((:ebx #.movitz:+movitz-fixnum-factor+)) :ebx) + (:jmp 'done) + + not-u32 + (:compile-form (:result-mode :ignore) (error "Not a vector: ~S" vector)) + done)) ;;; simple-vector accessors

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/sequences.lisp
by Frode Vatvedt Fjeld 29 Feb '04

29 Feb '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv22755 Modified Files: sequences.lisp Log Message: Completed map-into somewhat. Date: Sun Feb 29 14:14:59 2004 Author: ffjeld Index: movitz/losp/muerte/sequences.lisp diff -u movitz/losp/muerte/sequences.lisp:1.4 movitz/losp/muerte/sequences.lisp:1.5 --- movitz/losp/muerte/sequences.lisp:1.4 Wed Jan 28 16:06:08 2004 +++ movitz/losp/muerte/sequences.lisp Sun Feb 29 14:14:59 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Tue Sep 11 14:19:23 2001 ;;;; -;;;; $Id: sequences.lisp,v 1.4 2004/01/28 21:06:08 ffjeld Exp $ +;;;; $Id: sequences.lisp,v 1.5 2004/02/29 19:14:59 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -543,7 +543,21 @@ (q first-sequence (cdr q))) ((or (null p) (null q)) result-sequence) - (setf (car p) (map (car q)))))))) + (setf (car p) (map (car q))))) + ((vector list) + (with-subvector-accessor (result-ref result-sequence) + (do ((end (length result-sequence)) + (i 0 (1+ i)) + (p first-sequence (cdr p))) + ((or (endp p) (>= i end)) result-sequence) + (setf (result-ref i) (map (car p)))))) + ((list vector) + (with-subvector-accessor (first-ref first-sequence) + (do ((end (length first-sequence)) + (i 0 (1+ i)) + (p result-sequence (cdr p))) + ((or (endp p) (>= i end)) result-sequence) + (setf (car p) (map (first-ref i))))))))) (defun map-for-nil (function first-sequence &rest more-sequences) (numargs-case

1 0

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

26 Feb '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv17969 Modified Files: compiler.lisp Log Message: Fixed a bug that caused compilation of some 1req1opt functions to fail. Date: Thu Feb 26 08:48:43 2004 Author: ffjeld Index: movitz/compiler.lisp diff -u movitz/compiler.lisp:1.32 movitz/compiler.lisp:1.33 --- movitz/compiler.lisp:1.32 Sun Feb 22 10:55:03 2004 +++ movitz/compiler.lisp Thu Feb 26 08:48:42 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.32 2004/02/22 15:55:03 ffjeld Exp $ +;;;; $Id: compiler.lisp,v 1.33 2004/02/26 13:48:42 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -599,7 +599,7 @@ finally (multiple-value-bind (const-list num-jumpers jumpers-map) (layout-funobj-vector all-constants-plist - jumper-sets + all-jumper-sets (length (borrowed-bindings funobj))) (setf (movitz-funobj-num-jumpers funobj) num-jumpers (movitz-funobj-const-list funobj) const-list @@ -705,9 +705,9 @@ use-stack-frame-p))))) (let ((optimized-function-code (optimize-code function-code - :keep-labels (nconc (subseq (movitz-funobj-const-list funobj) - 0 (movitz-funobj-num-jumpers funobj)) - '(entry%1op entry%2op))))) + :keep-labels (append (subseq (movitz-funobj-const-list funobj) + 0 (movitz-funobj-num-jumpers funobj)) + '(entry%1op entry%2op))))) (assemble-funobj funobj optimized-function-code))))) (defun complete-funobj-default (funobj) @@ -731,11 +731,11 @@ have-normalized-ecx-p))) (let ((optimized-function-code (optimize-code function-code - :keep-labels (nconc (subseq (movitz-funobj-const-list funobj) - 0 (movitz-funobj-num-jumpers funobj)) - '(entry%1op - entry%2op - entry%3op))))) + :keep-labels (append (subseq (movitz-funobj-const-list funobj) + 0 (movitz-funobj-num-jumpers funobj)) + '(entry%1op + entry%2op + entry%3op))))) (cons numargs optimized-function-code)))))))) (let ((code1 (cdr (assoc 1 code-specs))) (code2 (cdr (assoc 2 code-specs)))

1 0

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

26 Feb '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv13105 Modified Files: integers.lisp Log Message: Transforming e.g (- x 1) into (+ x -1). Added some type information. Date: Thu Feb 26 08:46:37 2004 Author: ffjeld Index: movitz/losp/muerte/integers.lisp diff -u movitz/losp/muerte/integers.lisp:1.2 movitz/losp/muerte/integers.lisp:1.3 --- movitz/losp/muerte/integers.lisp:1.2 Mon Jan 19 06:23:46 2004 +++ movitz/losp/muerte/integers.lisp Thu Feb 26 08:46:36 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.2 2004/01/19 11:23:46 ffjeld Exp $ +;;;; $Id: integers.lisp,v 1.3 2004/02/26 13:46:36 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -188,10 +188,7 @@ ((movitz:movitz-constantp subtrahend) (let ((constant-subtrahend (movitz::eval-form subtrahend))) (check-type constant-subtrahend (signed-byte 30)) - `(with-inline-assembly (:returns :register :side-effects nil) ; inline - (:compile-form (:result-mode :register) ,minuend) - (:subl ,(* movitz::+movitz-fixnum-factor+ constant-subtrahend) (:result-register)) - (:into)))) + `(+%2op ,minuend ,(- constant-subtrahend)))) (t `(with-inline-assembly (:returns :eax :side-effects nil) (:compile-two-forms (:eax :ebx) ,minuend ,subtrahend) (:subl :ebx :eax) @@ -517,7 +514,7 @@ (if (< number1 number2) number2 number1)) (let ((label (gensym))) - `(with-inline-assembly (:returns :eax) + `(with-inline-assembly (:returns :eax :type integer) (:compile-two-forms (:eax :ebx) ,number1 ,number2) (:movl :ebx :ecx) (:orl :eax :ecx) @@ -542,30 +539,15 @@ (defun max (number1 &rest numbers) (declare (dynamic-extent numbers)) - #+ignore (reduce #'max%2op numbers :initial-value number1) (let ((max number1)) (dolist (x numbers max) (when (>= x max) (setq max x))))) (define-compiler-macro min%2op (number1 number2) - `(let ((number1 ,number1) (number2 ,number2)) - (if (< number1 number2) - number1 number2)) - #+ignore - (let ((label (gensym))) - `(with-inline-assembly (:returns :eax) - (:compile-two-forms (:eax :ebx) ,number1 ,number2) - (:movl :ebx :ecx) - (:orl :eax :ecx) - (:testb 7 :cl) - (:jnz '(:sub-program () (:int 107))) - (:subl :ebx :eax) (:sbbl :ecx :ecx) (:andl :ecx :eax) (:addl :ebx :eax) - - (:cmpl :eax :ebx) - (:jg ',label) - (:movl :ebx :eax) - ,label))) + `(let ((number1 ,number1) (number2 ,number2)) + (if (< number1 number2) + number1 number2))) (defun min%2op (number1 number2) (min%2op number1 number2)) @@ -608,7 +590,7 @@ append `((:addl (:result-register) (:result-register)) (:into))))) ((< 0 count #.(cl:1- movitz::+movitz-fixnum-bits+)) - `(with-inline-assembly (:returns :register :side-effects nil) + `(with-inline-assembly (:returns :register :side-effects nil :type integer) ,@load-integer (:cmpl ,(ash 1 (- (- 31 0) count)) (:result-register)) @@ -618,12 +600,12 @@ (:jl '(:sub-program () (:int 4))) (:shll ,count (:result-register)))) ((= -1 count) - `(with-inline-assembly (:returns :register :side-effects nil) + `(with-inline-assembly (:returns :register :side-effects nil :type integer) ,@load-integer (:andb #.(cl:logxor #xfe (cl:* 2 movitz::+movitz-fixnum-zmask+)) (:result-register-low8)) (:sarl 1 (:result-register)))) ((> 0 count #.(cl:- (cl:1- movitz::+movitz-fixnum-bits+))) - `(with-inline-assembly (:returns :register :side-effects nil) + `(with-inline-assembly (:returns :register :side-effects nil :type integer) ,@load-integer (:sarl ,(- count) (:result-register)) (:andb #.(cl:logxor #xff movitz::+movitz-fixnum-zmask+) (:result-register-low8)))) @@ -670,7 +652,7 @@ (0 `(progn ,factor2 0)) (1 factor2) (2 `(ash ,factor2 1)) - (t `(with-inline-assembly (:returns :eax) + (t `(with-inline-assembly (:returns :eax :type integer) (:compile-form (:result-mode :eax) ,factor2) (:testb #.movitz::+movitz-fixnum-zmask+ :al) (:jnz '(:sub-program () (:int 107))) @@ -762,7 +744,7 @@ (case d (0 (error "Truncate by zero.")) (1 number) - (t `(with-inline-assembly (:returns :eax) + (t `(with-inline-assembly (:returns :eax :type integer) (:compile-form (:result-mode :eax) ,number) (:compile-form (:result-mode :ebx) ,divisor) (:testb #.movitz::+movitz-fixnum-zmask+ :al) @@ -1028,7 +1010,7 @@ (let ((size (movitz::eval-form (second bytespec) env)) (position (movitz::eval-form (third bytespec) env))) (assert (<= (+ size position) 30)) - `(with-inline-assembly (:returns :register) + `(with-inline-assembly (:returns :register :type integer) (:compile-form (:result-mode :register) ,integer) (:andl ,(mask-field (byte size (+ position movitz::+movitz-fixnum-shift+)) -1) (:result-register))

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/basic-functions.lisp
by Frode Vatvedt Fjeld 26 Feb '04

26 Feb '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv28608 Modified Files: basic-functions.lisp Log Message: Minor edit of object-location inline assembly. Date: Thu Feb 26 08:44:29 2004 Author: ffjeld Index: movitz/losp/muerte/basic-functions.lisp diff -u movitz/losp/muerte/basic-functions.lisp:1.2 movitz/losp/muerte/basic-functions.lisp:1.3 --- movitz/losp/muerte/basic-functions.lisp:1.2 Mon Jan 19 06:23:46 2004 +++ movitz/losp/muerte/basic-functions.lisp Thu Feb 26 08:44:29 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Tue Sep 4 18:41:57 2001 ;;;; -;;;; $Id: basic-functions.lisp,v 1.2 2004/01/19 11:23:46 ffjeld Exp $ +;;;; $Id: basic-functions.lisp,v 1.3 2004/02/26 13:44:29 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -331,14 +331,14 @@ (getf (load-global-constant global-properties) property)) (define-compiler-macro object-location (object) - `(with-inline-assembly (:returns :eax) - (:compile-form (:result-mode :eax) ,object) - (:andb #xf8 :al))) + `(with-inline-assembly (:returns :register) + (:compile-form (:result-mode :register) ,object) + (:andl ,(* -2 movitz::+movitz-fixnum-factor+) (:result-register)))) + (defun object-location (object) "The location is the object's address divided by fixnum-factor." (object-location object)) - (defun halt-cpu () (halt-cpu))

1 0

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

26 Feb '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv15216 Modified Files: primitive-functions.lisp Log Message: Insignificant edits. Date: Thu Feb 26 08:43:52 2004 Author: ffjeld Index: movitz/losp/muerte/primitive-functions.lisp diff -u movitz/losp/muerte/primitive-functions.lisp:1.3 movitz/losp/muerte/primitive-functions.lisp:1.4 --- movitz/losp/muerte/primitive-functions.lisp:1.3 Thu Feb 5 09:46:24 2004 +++ movitz/losp/muerte/primitive-functions.lisp Thu Feb 26 08:43:51 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.3 2004/02/05 14:46:24 ffjeld Exp $ +;;;; $Id: primitive-functions.lisp,v 1.4 2004/02/26 13:43:51 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -437,8 +437,8 @@ (defun malloc-initialize (buffer-start buffer-size) "BUFFER-START: the (fixnum) 4K address. BUFFER-SIZE: The size in 4K units." - (check-type buffer-start integer); unsigned-byte) - (check-type buffer-size integer); unsigned-byte) + (check-type buffer-start integer) + (check-type buffer-size integer) (with-inline-assembly (:returns :nothing) (:compile-form (:result-mode :eax) buffer-start) (:shll #.(cl:- 12 movitz::+movitz-fixnum-shift+) :eax)

1 0