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

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

08 Jul '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv11392 Modified Files: typep.lisp Log Message: Slightly more correct dealing with simple-array type. Date: Thu Jul 8 14:50:03 2004 Author: ffjeld Index: movitz/losp/muerte/typep.lisp diff -u movitz/losp/muerte/typep.lisp:1.24 movitz/losp/muerte/typep.lisp:1.25 --- movitz/losp/muerte/typep.lisp:1.24 Thu Jul 8 11:54:01 2004 +++ movitz/losp/muerte/typep.lisp Thu Jul 8 14:50:03 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Fri Dec 8 11:07:53 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: typep.lisp,v 1.24 2004/07/08 18:54:01 ffjeld Exp $ +;;;; $Id: typep.lisp,v 1.25 2004/07/08 21:50:03 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -260,15 +260,20 @@ `(typep ,object ',(apply deriver-function (cdr type))) (case (car type) ((simple-array) - (let ((et (cadr type))) - (cond - ((movitz:movitz-subtypep et '(unsigned-byte 8)) - (make-basic-vector-typep :u8)) - ((movitz:movitz-subtypep et '(unsigned-byte 32)) - (make-basic-vector-typep :u32)) - ((movitz:movitz-subtypep et 'character) - (make-basic-vector-typep :character)) - (t (make-basic-vector-typep :any-t))))) + (let ((et (second type)) + (dim (if (listp (third type)) + (length (third type)) + (or (third type) '*)))) + (if (not (eql dim 1)) + form + (cond + ((movitz:movitz-subtypep et '(unsigned-byte 8)) + (make-basic-vector-typep :u8)) + ((movitz:movitz-subtypep et '(unsigned-byte 32)) + (make-basic-vector-typep :u32)) + ((movitz:movitz-subtypep et 'character) + (make-basic-vector-typep :character)) + (t (make-basic-vector-typep :any-t)))))) ((integer) (destructuring-bind (&optional (lower-limit '*) (upper-limit '*)) (cdr type)

1 0

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

08 Jul '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv1632 Modified Files: inspect.lisp Log Message: Added %bignum-canonicalize. Date: Thu Jul 8 14:48:58 2004 Author: ffjeld Index: movitz/losp/muerte/inspect.lisp diff -u movitz/losp/muerte/inspect.lisp:1.15 movitz/losp/muerte/inspect.lisp:1.16 --- movitz/losp/muerte/inspect.lisp:1.15 Thu Jul 8 11:53:47 2004 +++ movitz/losp/muerte/inspect.lisp Thu Jul 8 14:48:58 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.15 2004/07/08 18:53:47 ffjeld Exp $ +;;;; $Id: inspect.lisp,v 1.16 2004/07/08 21:48:58 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -245,7 +245,7 @@ (+ -1 object-location #.(movitz::movitz-type-word-size :movitz-funobj) (funobj-num-constants object)))) - ((or string code-vector (simple-array (unsigned-byte 8))) + ((or string code-vector (simple-array (unsigned-byte 8) 1)) (<= object-location location (+ -1 object-location @@ -272,6 +272,37 @@ (defun %bignum-bigits (x) (%bignum-bigits x)) + +(defun %bignum-canonicalize (x) + "Assuming x is a bignum, return the canonical integer value. That is, +either return a fixnum, or destructively modify the bignum's length so +that the msb isn't zero. DO NOT APPLY TO NON-BIGNUM VALUES!" + (macrolet + ((do-it () + `(with-inline-assembly (:returns :eax) + (:load-lexical (:lexical-binding x) :eax) + (:movl (:eax ,movitz:+other-type-offset+) :ecx) + (:shrl 16 :ecx) + shrink-loop + (:cmpl 1 :ecx) + (:je 'shrink-no-more) + (:cmpl 0 (:eax (:ecx 4) ,(+ -4 (bt:slot-offset 'movitz:movitz-bignum 'movitz::bigit0)))) + (:jnz 'shrink-done) + (:subl 1 :ecx) + (:jmp 'shrink-loop) + shrink-no-more + (:cmpl ,(1+ movitz:+movitz-most-positive-fixnum+) + (:eax ,(bt:slot-offset 'movitz:movitz-bignum 'movitz::bigit0))) + (:jc '(:sub-program (fixnum-result) + (:movl (:eax ,(bt:slot-offset 'movitz:movitz-bignum 'movitz::bigit0)) + :ecx) + (:leal ((:ecx ,movitz:+movitz-fixnum-factor+)) :eax) + (:jmp 'done))) + shrink-done + (:movw :cx (:eax ,(bt:slot-offset 'movitz:movitz-bignum 'movitz::length))) + done + ))) + (do-it))) (defun copy-bignum (old) (check-type old bignum)

1 0

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

08 Jul '04

Update of /project/movitz/cvsroot/movitz/losp In directory common-lisp.net:/tmp/cvs-serv15907 Modified Files: los0.lisp Log Message: Minor edits. Date: Thu Jul 8 11:59:56 2004 Author: ffjeld Index: movitz/losp/los0.lisp diff -u movitz/losp/los0.lisp:1.14 movitz/losp/los0.lisp:1.15 --- movitz/losp/los0.lisp:1.14 Mon May 24 07:58:39 2004 +++ movitz/losp/los0.lisp Thu Jul 8 11:59:55 2004 @@ -1,15 +1,15 @@ ;;;;------------------------------------------------------------------ ;;;; -;;;; Copyright (C) 2001,2000, 2002-2004, +;;;; Copyright (C) 2000-2004, ;;;; Department of Computer Science, University of Tromso, Norway ;;;; ;;;; Filename: los0.lisp -;;;; Description: Top-level initialization file. +;;;; Description: Top-level initialization and testing. ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Fri Dec 1 18:08:32 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: los0.lisp,v 1.14 2004/05/24 14:58:39 ffjeld Exp $ +;;;; $Id: los0.lisp,v 1.15 2004/07/08 18:59:55 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -80,6 +80,13 @@ ;;; (declare (dynamic-extent args)) ;;; (apply (constantly 'test-value) args)) +(defun test-break () + (with-inline-assembly (:returns :multiple-values) + (:movl 10 :ecx) + (:movl :esi :eax) ; This function should return itself! + (:clc) + (:break))) + (defun test-upload (x) ;; (warn "Test-upload blab la bla!!") (setf x (cdr x)) @@ -266,14 +273,68 @@ (defun test-bignum () 123456789123456) -(defun ff32 () - #xffffffff) +(defun fe32 () + #xfffffffe) + +(defun fe64 () + #xfffffffffffffffe) + +(defun fe96 () + #xfffffffffffffffffffffffe) (defun one32 () #x100000000) -(defun test-nbignum () - -123456789123456) +(defun z (op x y) + (let ((foo (cons 1 2)) + (result (funcall op x y)) + (bar (cons 3 4))) + (if (not (typep result 'pointer)) + (warn "foo: ~Z result: ~Z, bar: ~Z, diff foo-bar: ~D." + foo result bar + (- (object-location bar) (object-location foo))) + (warn "foo: ~Z result: ~Z, bar: ~Z, diff: ~D, ~D." + foo result bar + (- (object-location result) (object-location foo)) + (- (object-location bar) (object-location result)))) + (values foo result bar))) + +(defun foo (number &rest more-numbers) + (declare (dynamic-extent more-numbers)) + (do ((p more-numbers (cdr p))) + ((not (cdr p)) number) + (unless (< (car p) (cadr p)) + (return nil)))) + +(defun modx (x) + (lambda () + (print x))) + +(defun mod30 (x) + (ldb (Byte 30 0) x)) + +(defun mod32-4 (x) + (ldb (byte 28 4) x)) + +(defun mod24-4 (x) + (ldb (Byte 24 4) x)) + +(defun zz (op x y) + (let ((foo (vector 1 2)) + (result (funcall op x y)) + (bar (vector 3 4))) + (if (not (typep result 'pointer)) + (warn "foo: ~Z result: ~Z, bar: ~Z, diff foo-bar: ~D." + foo result bar + (- (object-location bar) (object-location foo))) + (warn "foo: ~Z result: ~Z, bar: ~Z, diff: ~D, ~D." + foo result bar + (- (object-location result) (object-location foo)) + (- (object-location bar) (object-location result)))) + (values foo result bar))) + +(defun testb () + #(1 2 3 4)) (defun gt5 (x) (<= x 5)) @@ -632,9 +693,6 @@ (defun test-nano-sleep (x) (time (nano-sleep x))) -(defun test () - (time 123)) - (defun mvtest () (multiple-value-call #'list (round 5 2)) (list (memref-int #x1000000 0 0 :unsigned-byte8) @@ -730,7 +788,8 @@ (format t " ~~ ~,3F" x))) (pointer (format t "~&~Z = ~W" x x)) - (t (write x :radix nil :base (case *print-base* (10 16) (t 10))))) + (t (fresh-line) + (write x :radix nil :base (case *print-base* (10 16) (t 10))))) x)) (if x-list (do-print (eval x-list)) @@ -782,7 +841,8 @@ (write (cdr condition)))) (t (format t "~&Error: ~A" condition))) (if *debugger-printing-restarts* - (format t "~&[restarts suppressed]") + (progn (format t "~&[restarts suppressed]") + (halt-cpu)) (let ((*debugger-printing-restarts* t)) (map-active-restarts (lambda (restart index) (format t "~&~2D: ~A~%" index restart)) @@ -881,10 +941,11 @@ (idt-init) (install-los0-consing) + (setf *debugger-function* #'los0-debugger) (let ((*repl-readline-context* (make-readline-context :history-size 16)) (*backtrace-stack-frame-barrier* (stack-frame-uplink (current-stack-frame))) #+ignore (*error-no-condition-for-debugger* t) - (*debugger-function* #'los0-debugger) + #+ignore (*debugger-function* #'los0-debugger) (*package* nil)) (with-simple-restart (abort "Skip Los0 boot-up initialization.") (setf *cpu-features*

1 0

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

08 Jul '04

Update of /project/movitz/cvsroot/movitz/losp In directory common-lisp.net:/tmp/cvs-serv14379 Modified Files: los0-gc.lisp Log Message: Minor edits. Date: Thu Jul 8 11:59:51 2004 Author: ffjeld Index: movitz/losp/los0-gc.lisp diff -u movitz/losp/los0-gc.lisp:1.20 movitz/losp/los0-gc.lisp:1.21 --- movitz/losp/los0-gc.lisp:1.20 Thu Jul 8 11:49:26 2004 +++ movitz/losp/los0-gc.lisp Thu Jul 8 11:59:51 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.20 2004/07/08 18:49:26 ffjeld Exp $ +;;;; $Id: los0-gc.lisp,v 1.21 2004/07/08 18:59:51 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -35,10 +35,6 @@ (defmacro space-fresh-pointer (space) `(memref ,space -6 2 :lisp)) -;;;(defmacro space-last-cons (space) -;;; "The location of the last cons-cell that will with in this space." -;;; `(memref ,space -6 3 :lisp)) - (defmacro space-other (space) `(memref ,space -6 3 :lisp)) @@ -49,12 +45,8 @@ space)) (defun initialize-space (space) - (setf (space-fresh-pointer space) 2 -;;; (space-last-cons space) (+ (object-location space) -;;; (array-dimension space 0))) - ) + (setf (space-fresh-pointer space) 2) space) - (defun allocate-duo-space (size) (let* ((space1 (allocate-space size))

1 0

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

08 Jul '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv1664 Modified Files: variables.lisp Log Message: Removed references to the old movitz-vector class. Date: Thu Jul 8 11:54:05 2004 Author: ffjeld Index: movitz/losp/muerte/variables.lisp diff -u movitz/losp/muerte/variables.lisp:1.5 movitz/losp/muerte/variables.lisp:1.6 --- movitz/losp/muerte/variables.lisp:1.5 Tue Apr 13 07:21:19 2004 +++ movitz/losp/muerte/variables.lisp Thu Jul 8 11:54:05 2004 @@ -1,7 +1,7 @@ ;;;;------------------------------------------------------------------ ;;;; ;;;; Copyright (C) 2003-2004, -;;;; Department of Computer Science, University of Tromsoe, Norway. +;;;; Department of Computer Science, University of Tromso, Norway. ;;;; ;;;; For distribution policy, see the accompanying file COPYING. ;;;; @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Wed Nov 5 21:53:34 2003 ;;;; -;;;; $Id: variables.lisp,v 1.5 2004/04/13 14:21:19 ffjeld Exp $ +;;;; $Id: variables.lisp,v 1.6 2004/07/08 18:54:05 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------

1 0

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

08 Jul '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv31297 Modified Files: typep.lisp Log Message: Removed references to the old movitz-vector class. Date: Thu Jul 8 11:54:01 2004 Author: ffjeld Index: movitz/losp/muerte/typep.lisp diff -u movitz/losp/muerte/typep.lisp:1.23 movitz/losp/muerte/typep.lisp:1.24 --- movitz/losp/muerte/typep.lisp:1.23 Thu Jul 8 08:28:12 2004 +++ movitz/losp/muerte/typep.lisp Thu Jul 8 11:54:01 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Fri Dec 8 11:07:53 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: typep.lisp,v 1.23 2004/07/08 15:28:12 ffjeld Exp $ +;;;; $Id: typep.lisp,v 1.24 2004/07/08 18:54:01 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -76,29 +76,26 @@ (:leal (:eax ,(cl:- (movitz:tag :other))) :ecx) (:testb 7 :cl) (:branch-when :boolean-zf=0) - (:cmpb ,(movitz:tag tag-name) - (:eax ,(bt:slot-offset 'movitz::movitz-vector 'movitz::type))) + (:cmpb ,(movitz:tag tag-name) (:eax ,movitz:+other-type-offset+)) (:branch-when :boolean-zf=0)) (do-case (:boolean-branch-on-true :same :labels (other-typep-failed)) (:compile-form (:result-mode :eax) ,object) (:leal (:eax ,(cl:- (movitz:tag :other))) :ecx) (:testb 7 :cl) (:jnz 'other-typep-failed) - (:cmpb ,(movitz:tag tag-name) - (:eax ,(bt:slot-offset 'movitz::movitz-vector 'movitz::type))) + (:cmpb ,(movitz:tag tag-name) (:eax ,movitz:+other-type-offset+)) (:branch-when :boolean-zf=1) other-typep-failed) (do-case (t :boolean-zf=1 :labels (other-typep-failed)) (:compile-form (:result-mode :eax) ,object) - (:leal (:eax ,(cl:- (movitz:tag :other))) :ecx) + (:leal (:eax ,movitz:+other-type-offset+) :ecx) (:testb 7 :cl) (:jnz 'other-typep-failed) - (:cmpb ,(movitz:tag tag-name) - (:eax ,(bt:slot-offset 'movitz::movitz-vector 'movitz::type))) + (:cmpb ,(movitz:tag tag-name) (:eax ,movitz:+other-type-offset+)) other-typep-failed))) (make-basic-vector-typep (element-type) - (assert (= 1 (- (bt:slot-offset 'movitz::movitz-vector 'movitz::element-type) - (bt:slot-offset 'movitz::movitz-vector 'movitz::type)))) + (assert (= 1 (- (bt:slot-offset 'movitz::movitz-basic-vector 'movitz::element-type) + (bt:slot-offset 'movitz::movitz-basic-vector 'movitz::type)))) (let ((type-code (dpb (bt:enum-value 'movitz::movitz-vector-element-type element-type) (byte 8 8) (movitz:tag :basic-vector)))) @@ -108,16 +105,14 @@ (:leal (:eax ,(- (movitz::tag :other))) :ecx) (:testb 7 :cl) (:branch-when :boolean-zf=0) - (:cmpw ,type-code - (:eax ,(bt:slot-offset 'movitz::movitz-vector 'movitz::type))) + (:cmpw ,type-code (:eax ,movitz:+other-type-offset+)) (:branch-when :boolean-zf=0)) (do-case (:boolean-branch-on-true :same :labels (vector-typep-failed)) (:compile-form (:result-mode :eax) ,object) (:leal (:eax ,(- (movitz::tag :other))) :ecx) (:testb 7 :cl) (:jnz 'vector-typep-failed) - (:cmpw ,type-code - (:eax ,(bt:slot-offset 'movitz::movitz-vector 'movitz::type))) + (:cmpw ,type-code (:eax ,movitz:+other-type-offset+)) (:branch-when :boolean-zf=1) vector-typep-failed) (do-case (t :boolean-zf=1 :labels (vector-typep-failed)) @@ -125,8 +120,7 @@ (:leal (:eax ,(- (movitz::tag :other))) :ecx) (:testb 7 :cl) (:jnz 'vector-typep-failed) - (:cmpw ,type-code - (:eax ,(bt:slot-offset 'movitz::movitz-vector 'movitz::type))) + (:cmpw ,type-code (:eax ,movitz:+other-type-offset+)) vector-typep-failed)))) (make-function-typep (funobj-type) (assert (= 1 (- (bt:slot-offset 'movitz::movitz-funobj 'movitz::funobj-type)

1 0

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

08 Jul '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv26970 Modified Files: run-time-context.lisp Log Message: Removed references to the old movitz-vector class. Date: Thu Jul 8 11:53:57 2004 Author: ffjeld Index: movitz/losp/muerte/run-time-context.lisp diff -u movitz/losp/muerte/run-time-context.lisp:1.6 movitz/losp/muerte/run-time-context.lisp:1.7 --- movitz/losp/muerte/run-time-context.lisp:1.6 Mon Apr 19 08:05:01 2004 +++ movitz/losp/muerte/run-time-context.lisp Thu Jul 8 11:53:57 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.6 2004/04/19 15:05:01 ffjeld Exp $ +;;;; $Id: run-time-context.lisp,v 1.7 2004/07/08 18:53:57 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -78,7 +78,7 @@ (movitz:code-vector-word `(with-inline-assembly (:returns :eax) (:compile-form (:result-mode :eax) ,value) - (:leal (:eax ,(bt:slot-offset 'movitz:movitz-vector 'movitz::data)) :ecx) + (:leal (:eax ,(bt:slot-offset 'movitz:movitz-basic-vector 'movitz::data)) :ecx) (:locally (:movl :ecx (:edi (:edi-offset ,slot-name)))))))))) (defun (setf %run-time-context-slot) (value slot-name &optional (context (current-run-time-context)))

1 0

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

08 Jul '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv25908 Modified Files: los-closette.lisp Log Message: Removed references to the old movitz-vector class. Date: Thu Jul 8 11:53:52 2004 Author: ffjeld Index: movitz/losp/muerte/los-closette.lisp diff -u movitz/losp/muerte/los-closette.lisp:1.11 movitz/losp/muerte/los-closette.lisp:1.12 --- movitz/losp/muerte/los-closette.lisp:1.11 Mon May 24 07:59:08 2004 +++ movitz/losp/muerte/los-closette.lisp Thu Jul 8 11:53:52 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Tue Jul 23 14:29:10 2002 ;;;; -;;;; $Id: los-closette.lisp,v 1.11 2004/05/24 14:59:08 ffjeld Exp $ +;;;; $Id: los-closette.lisp,v 1.12 2004/07/08 18:53:52 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -871,7 +871,7 @@ (:compile-form (:result-mode :eax) instance) (:movl (:eax ,(bt:slot-offset 'movitz::movitz-std-instance 'movitz::slots)) :eax) - (:movl (:eax ,(+ (bt:slot-offset 'movitz::movitz-vector 'movitz::data) + (:movl (:eax ,(+ (bt:slot-offset 'movitz::movitz-basic-vector 'movitz::data) (* location 4))) :eax) (:cmpl :eax ,(movitz::make-indirect-reference :edi (movitz::global-constant-offset 'unbound-value)))

1 0

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

08 Jul '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv24160 Modified Files: inspect.lisp Log Message: Removed references to the old movitz-vector class. Date: Thu Jul 8 11:53:47 2004 Author: ffjeld Index: movitz/losp/muerte/inspect.lisp diff -u movitz/losp/muerte/inspect.lisp:1.14 movitz/losp/muerte/inspect.lisp:1.15 --- movitz/losp/muerte/inspect.lisp:1.14 Thu Jul 8 08:23:15 2004 +++ movitz/losp/muerte/inspect.lisp Thu Jul 8 11:53:47 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.14 2004/07/08 15:23:15 ffjeld Exp $ +;;;; $Id: inspect.lisp,v 1.15 2004/07/08 18:53:47 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -249,19 +249,19 @@ (<= object-location location (+ -1 object-location - #.(movitz::movitz-type-word-size :movitz-vector) + #.(movitz::movitz-type-word-size 'movitz-basic-vector) (* 2 (truncate (+ (array-dimension object 0) 7) 8))))) (vector-u16 (<= object-location location (+ -1 object-location - #.(movitz::movitz-type-word-size :movitz-vector) + #.(movitz::movitz-type-word-size 'movitz-basic-vector) (* 2 (truncate (+ (array-dimension object 0) 3) 4))))) ((or vector-u32 simple-vector) (<= object-location location (+ -1 object-location - #.(movitz::movitz-type-word-size :movitz-vector) + #.(movitz::movitz-type-word-size 'movitz-basic-vector) (* 2 (truncate (+ (array-dimension object 0) 1) 2))))) (structure-object (<= object-location

1 0

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

08 Jul '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv22988 Modified Files: arrays.lisp Log Message: Removed references to the old movitz-vector class. Date: Thu Jul 8 11:53:42 2004 Author: ffjeld Index: movitz/losp/muerte/arrays.lisp diff -u movitz/losp/muerte/arrays.lisp:1.32 movitz/losp/muerte/arrays.lisp:1.33 --- movitz/losp/muerte/arrays.lisp:1.32 Thu Jul 8 08:28:52 2004 +++ movitz/losp/muerte/arrays.lisp Thu Jul 8 11:53:42 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.32 2004/07/08 15:28:52 ffjeld Exp $ +;;;; $Id: arrays.lisp,v 1.33 2004/07/08 18:53:42 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -22,7 +22,7 @@ (in-package muerte) (defun vector-element-type (object) - (memref object #.(bt:slot-offset 'movitz::movitz-vector 'movitz::element-type) 0 + (memref object #.(bt:slot-offset 'movitz::movitz-basic-vector 'movitz::element-type) 0 :unsigned-byte8)) (defmacro vector-double-dispatch ((s1 s2) &rest clauses) @@ -44,12 +44,12 @@ (define-compiler-macro vector-element-type (object) `(memref ,object 0 - #.(bt:slot-offset 'movitz::movitz-vector 'movitz::element-type) + ,(bt:slot-offset 'movitz::movitz-basic-vector 'movitz::element-type) :unsigned-byte8)) (defun (setf vector-element-type) (numeric-element-type vector) (check-type vector vector) - (setf (memref vector #.(bt:slot-offset 'movitz::movitz-vector 'movitz::element-type) 0 + (setf (memref vector #.(bt:slot-offset 'movitz::movitz-basic-vector 'movitz::element-type) 0 :unsigned-byte8) numeric-element-type)) @@ -75,7 +75,7 @@ (movitz-accessor array movitz-basic-vector num-elements)))) (defun shrink-vector (vector new-size) - (set-movitz-accessor-u16 vector movitz-vector num-elements new-size) + (setf-movitz-accessor (vector movitz-basic-vector num-elements) new-size) vector) (define-compiler-macro %basic-vector-has-fill-pointer-p (vector) @@ -205,19 +205,19 @@ ((do-it () `(with-inline-assembly (:returns :eax) (:declare-label-set basic-vector-dispatcher - ,(print (loop with x = (make-list 8 :initial-element 'unknown) + ,(loop with x = (make-list 8 :initial-element 'unknown) for et in '(:any-t :character :u8 :u32 :code :bit) do (setf (elt x (bt:enum-value 'movitz::movitz-vector-element-type et)) et) - finally (return x)))) + finally (return x))) (:compile-two-forms (:eax :ebx) array index) (:movl (:eax ,movitz:+other-type-offset+) :ecx) - (:cmpb ,(movitz:tag :basic-vector) :cl) - (:jne '(:sub-program (not-vector) - (:compile-form (:result-mode :ignore) - (error "Not an array: ~S." array)))) +;;; (:cmpb ,(movitz:tag :basic-vector) :cl) +;;; (:jne '(:sub-program (not-vector) +;;; (:compile-form (:result-mode :ignore) +;;; (error "Not an array: ~S." array)))) (:testb ,movitz:+movitz-fixnum-zmask+ :bl) (:jnz '(:sub-program (illegal-index) (:compile-form (:result-mode :ignore) @@ -387,7 +387,7 @@ (defun 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))) + (:movl (:eax :ebx #.(bt:slot-offset 'movitz:movitz-basic-vector 'movitz::data)) :eax))) (defun (setf svref%unsafe) (value simple-vector index) (setf (svref%unsafe simple-vector index) value)) @@ -745,7 +745,7 @@ (define-compiler-macro bvref-u16 (&whole form vector offset index &environment env) (let ((actual-index (and (movitz:movitz-constantp index env) - (movitz::eval-form index env)))) + (movitz:movitz-eval index env)))) (if (not (typep actual-index '(integer 0 *))) `(bvref-u16-fallback ,vector ,offset ,index) (let ((var (gensym))) @@ -754,11 +754,14 @@ (bvref-u16-fallback ,var ,offset ,index) (with-inline-assembly (:returns :untagged-fixnum-ecx) (:compile-two-forms (:eax :ecx) ,var ,offset) - (:shrl #.movitz::+movitz-fixnum-shift+ :ecx) - (:andl #xfffe :ecx) - (:cmpw :cx (:eax #.(bt:slot-offset 'movitz::movitz-vector 'movitz::num-elements))) - (:jbe '(:sub-program () (:int 69))) - (:movw (:eax :ecx ,(+ actual-index (bt:slot-offset 'movitz::movitz-vector 'movitz::data))) :cx) + (:cmpl (:eax ,(bt:slot-offset 'movitz::movitz-basic-vector + 'movitz::num-elements)) + :ecx) + (:jnc '(:sub-program () (:int 69))) + (:shrl ,movitz::+movitz-fixnum-shift+ :ecx) + (:movw (:eax :ecx ,(+ actual-index (bt:slot-offset 'movitz::movitz-basic-vector + 'movitz::data))) + :cx) (:xchgb :cl :ch)))))))) (defun bvref-u16-fallback (vector offset index)

1 0