movitz-cvs July 2004

movitz-cvs@common-lisp.net

2 participants
376 discussions

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

21 Jul '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv6312 Modified Files: read.lisp Log Message: Fixed un-backquote for non-proper lists, like `(a b . c). Date: Wed Jul 21 15:35:15 2004 Author: ffjeld Index: movitz/losp/muerte/read.lisp diff -u movitz/losp/muerte/read.lisp:1.6 movitz/losp/muerte/read.lisp:1.7 --- movitz/losp/muerte/read.lisp:1.6 Wed Jul 21 07:15:43 2004 +++ movitz/losp/muerte/read.lisp Wed Jul 21 15:35:15 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Wed Oct 17 21:50:42 2001 ;;;; -;;;; $Id: read.lisp,v 1.6 2004/07/21 14:15:43 ffjeld Exp $ +;;;; $Id: read.lisp,v 1.7 2004/07/21 22:35:15 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -19,6 +19,9 @@ (in-package muerte) +(defvar *read-suppress*) +(defvar *readtable*) + (defun substring (string start end) (if (and (zerop start) (= end (length string))) string @@ -302,19 +305,6 @@ (t (return-from simple-read-from-string (simple-read-token string :start i :end end)))))) -;;;(defun read-char (&optional input-stream eof-error-p eof-value recursive-p) -;;; " => char" -;;; (declare (ignore recursive-p)) -;;; (let* ((stream (input-stream-designator input-stream)) -;;; (char (stream-read-char stream))) -;;; (cond -;;; ((not (eq :eof char)) -;;; char) -;;; (eof-error-p -;;; (error 'end-of-file :stream stream)) -;;; (t eof-value)))) - - (defun un-backquote (form level) "Dont ask.." (declare (notinline un-backquote)) @@ -340,7 +330,7 @@ (muerte::movitz-backquote (list 'list (list 'list (list 'quote 'muerte::movitz-backquote) - (un-backquote-xxx (cadr sub-form) (1+ level))))) + (un-backquote (cadr sub-form) (1+ level))))) (backquote-comma (cond ((= 0 level) @@ -354,15 +344,19 @@ (t (list 'list (list 'list (list 'quote 'backquote-comma) - (un-backquote-xxx (cadr sub-form) (1- level))))))) + (un-backquote (cadr sub-form) (1- level))))))) (backquote-comma-at (if (= 0 level) (cadr sub-form) (list 'list (list 'list (list 'quote 'backquote-comma-at) - (un-backquote-xxx (cadr sub-form) (1- level)))))) - (t (list 'list (un-backquote-xxx sub-form level))))))))))) + (un-backquote (cadr sub-form) (1- level)))))) + (t (list 'list (un-backquote sub-form level)))))) + when (not (listp (cdr sub-form-head))) + collect (list 'quote (cdr sub-form-head))) + )))) (array (error "Array backquote not implemented.")) (t (list 'quote form))))) +

1 0

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

21 Jul '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv19811 Modified Files: arrays.lisp Log Message: Made array-element-type recognize bit-vectors. Wrote upgraded-array-element-type, and array-dimensions. Added a typep for array. Date: Wed Jul 21 15:33:55 2004 Author: ffjeld Index: movitz/losp/muerte/arrays.lisp diff -u movitz/losp/muerte/arrays.lisp:1.38 movitz/losp/muerte/arrays.lisp:1.39 --- movitz/losp/muerte/arrays.lisp:1.38 Wed Jul 21 04:47:49 2004 +++ movitz/losp/muerte/arrays.lisp Wed Jul 21 15:33:55 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.38 2004/07/21 11:47:49 lgorrie Exp $ +;;;; $Id: arrays.lisp,v 1.39 2004/07/21 22:33:55 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -65,15 +65,61 @@ '(unsigned-byte 16)) (#.(bt:enum-value 'movitz::movitz-vector-element-type :u32) '(unsigned-byte 32)) + (#.(bt:enum-value 'movitz::movitz-vector-element-type :bit) + 'bit) (#.(bt:enum-value 'movitz::movitz-vector-element-type :code) 'code))) +(defun upgraded-array-element-type (type-specifier &optional environment) + "=> upgraded-type-specifier" + ;; We're in dire need of subtypep.. + (cond + ((symbolp type-specifier) + (case type-specifier + ((character base-char standard-char) + 'character) + ((code) + 'code) + (t (let ((deriver (gethash type-specifier *derived-typespecs*))) + (if (not deriver) + t + (upgraded-array-element-type (funcall deriver))))))) + ((null type-specifier) + t) + ((consp type-specifier) + (case (car type-specifier) + ((integer) + (let* ((q (cdr type-specifier)) + (min (if q (pop q) '*)) + (max (if q (pop q) '*))) + (cond + ((or (eq min '*) (eq max '*)) + t) + ((<= 0 min max 1) + 'bit) + ((<= 0 min max #xff) + '(unsigned-byte 8)) + ((<= 0 min max #xffff) + '(unsigned-byte 16)) + ((<= 0 min max #xffffffff) + '(unsigned-byte 32))))) + (t (let ((deriver (gethash (car type-specifier) *derived-typespecs*))) + (if (not deriver) + t + (upgraded-array-element-type (apply deriver (cdr type-specifier)) environment)))))) + (t t))) + + (defun array-dimension (array axis-number) (etypecase array - (simple-array + ((simple-array * 1) (assert (zerop axis-number)) (movitz-accessor array movitz-basic-vector num-elements)))) +(defun array-dimensions (array) + (check-type array array) + 1) + (defun shrink-vector (vector new-size) (setf-movitz-accessor (vector movitz-basic-vector num-elements) new-size) vector) @@ -772,3 +818,19 @@ (defun bvref-u16 (vector offset index) "View <vector> as an sequence of octets, access the big-endian 16-bit word at position <index> + <offset>." (bvref-u16 vector offset index)) + +(define-typep array (x &optional (element-type '*) (dimension-spec '*)) + (and (typep x 'array) + (or (eq element-type '*) + (eq element-type t) + (equalp (array-element-type x) + (upgraded-array-element-type element-type))) + (or (eq dimension-spec '*) + (and (integerp dimension-spec) + (= dimension-spec (array-dimensions x))) + (and (listp dimension-spec) + (do ((d 0 (1+ d)) + (q dimension-spec)) + ((null q) t) + (unless (= (pop q) (array-dimension x d)) + (return nil)))))))

1 0

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

21 Jul '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv3534 Modified Files: integers.lisp Log Message: Improved the number-relational compiler-macros. Date: Wed Jul 21 15:30:52 2004 Author: ffjeld Index: movitz/losp/muerte/integers.lisp diff -u movitz/losp/muerte/integers.lisp:1.81 movitz/losp/muerte/integers.lisp:1.82 --- movitz/losp/muerte/integers.lisp:1.81 Wed Jul 21 07:18:03 2004 +++ movitz/losp/muerte/integers.lisp Wed Jul 21 15:30: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.81 2004/07/21 14:18:03 ffjeld Exp $ +;;;; $Id: integers.lisp,v 1.82 2004/07/21 22:30:51 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -232,20 +232,31 @@ (defmacro define-number-relational (name 2op-name condition &key (defun-p t) 3op-name) `(progn ,(when condition - `(define-compiler-macro ,2op-name (n1 n2) + `(define-compiler-macro ,2op-name (n1 n2 &environment env) (cond - ((movitz:movitz-constantp n1) - (let ((n1 (movitz::movitz-eval n1))) - (check-type n1 (signed-byte 30)) - `(with-inline-assembly (:returns ,,condition :side-effects nil) - (:compile-two-forms (:eax :ebx) ,n1 ,n2) - (:call-global-pf fast-compare-fixnum-real)))) - ((movitz:movitz-constantp n2) - (let ((n2 (movitz::movitz-eval n2))) - (check-type n2 (signed-byte 30)) - `(with-inline-assembly (:returns ,,condition :side-effects nil) - (:compile-two-forms (:eax :ebx) ,n1 ,n2) - (:call-global-pf fast-compare-real-fixnum)))) + ((and (movitz:movitz-constantp n1 env) + (movitz:movitz-constantp n2 env)) + (list ',2op-name (movitz:movitz-eval n1 env) (movitz:movitz-eval n2 env))) + ((movitz:movitz-constantp n1 env) + (let ((n1 (movitz::movitz-eval n1 env))) + (check-type n1 number) + (if (typep n1 '(signed-byte 30)) + `(with-inline-assembly (:returns ,,condition :side-effects nil) + (:compile-two-forms (:eax :ebx) ,n1 ,n2) + (:call-global-pf fast-compare-fixnum-real)) + `(with-inline-assembly (:returns ,,condition :side-effects nil) + (:compile-two-forms (:eax :ebx) ,n1 ,n2) + (:call-global-pf fast-compare-two-reals))))) + ((movitz:movitz-constantp n2 env) + (let ((n2 (movitz:movitz-eval n2 env))) + (check-type n2 number) + (if (typep n2 '(signed-byte 30)) + `(with-inline-assembly (:returns ,,condition :side-effects nil) + (:compile-two-forms (:eax :ebx) ,n1 ,n2) + (:call-global-pf fast-compare-real-fixnum)) + `(with-inline-assembly (:returns ,,condition :side-effects nil) + (:compile-two-forms (:eax :ebx) ,n1 ,n2) + (:call-global-pf fast-compare-two-reals))))) (t `(with-inline-assembly (:returns ,,condition :side-effects nil) (:compile-two-forms (:eax :ebx) ,n1 ,n2) (:call-global-pf fast-compare-two-reals))))))

1 0

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

21 Jul '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv4134 Modified Files: basic-macros.lisp Log Message: Made defpackage a bit smarter about recognizing nicknames. Date: Wed Jul 21 15:30:15 2004 Author: ffjeld Index: movitz/losp/muerte/basic-macros.lisp diff -u movitz/losp/muerte/basic-macros.lisp:1.30 movitz/losp/muerte/basic-macros.lisp:1.31 --- movitz/losp/muerte/basic-macros.lisp:1.30 Wed Jul 21 07:17:35 2004 +++ movitz/losp/muerte/basic-macros.lisp Wed Jul 21 15:30:14 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Wed Nov 8 18:44:57 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: basic-macros.lisp,v 1.30 2004/07/21 14:17:35 ffjeld Exp $ +;;;; $Id: basic-macros.lisp,v 1.31 2004/07/21 22:30:14 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -73,7 +73,8 @@ (pushnew '(:use) options :key #'car) (let ((uses (cdr (assoc :use options)))) (setf uses (mapcar (lambda (use) - (if (member use '(:cl :common-lisp) :test #'string=) + (if (member use (cons :common-lisp (package-nicknames :common-lisp)) + :test #'string=) :muerte.cl use)) uses))

1 0

[movitz-cvs] CVS update: movitz/losp/lib/repl.lisp
by Frode Vatvedt Fjeld 21 Jul '04

21 Jul '04

Update of /project/movitz/cvsroot/movitz/losp/lib In directory common-lisp.net:/tmp/cvs-serv14720 Modified Files: repl.lisp Log Message: Made repl a separate package. Date: Wed Jul 21 15:29:20 2004 Author: ffjeld Index: movitz/losp/lib/repl.lisp diff -u movitz/losp/lib/repl.lisp:1.11 movitz/losp/lib/repl.lisp:1.12 --- movitz/losp/lib/repl.lisp:1.11 Fri Apr 23 07:59:35 2004 +++ movitz/losp/lib/repl.lisp Wed Jul 21 15:29:20 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Wed Mar 19 14:58:12 2003 ;;;; -;;;; $Id: repl.lisp,v 1.11 2004/04/23 14:59:35 ffjeld Exp $ +;;;; $Id: repl.lisp,v 1.12 2004/07/21 22:29:20 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -18,7 +18,18 @@ (require :lib/readline) (provide :lib/repl) -(in-package muerte.lib) +(defpackage #:muerte.repl + (:documentation "Implementation of Read Eval Print Loop.") + (:nicknames #:repl) + (:use #:common-lisp #:muerte) + (:export #:*repl-level* + #:*repl-prompter* + #:*repl-prompt-context* + #:*repl-print-format* + #:*repl-readline-context* + #:read-eval-print)) + +(in-package #:muerte.repl) (defparameter *repl-level* -1) (defparameter *repl-prompter* 'default-repl-prompter)

1 0

[movitz-cvs] CVS update: movitz/losp/lib/package.lisp
by Frode Vatvedt Fjeld 21 Jul '04

21 Jul '04

Update of /project/movitz/cvsroot/movitz/losp/lib In directory common-lisp.net:/tmp/cvs-serv6752/losp/lib Modified Files: package.lisp Log Message: Made repl a separate package. Date: Wed Jul 21 15:29:16 2004 Author: ffjeld Index: movitz/losp/lib/package.lisp diff -u movitz/losp/lib/package.lisp:1.3 movitz/losp/lib/package.lisp:1.4 --- movitz/losp/lib/package.lisp:1.3 Mon Jan 19 03:23:44 2004 +++ movitz/losp/lib/package.lisp Wed Jul 21 15:29:16 2004 @@ -10,12 +10,13 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Fri Sep 27 17:24:11 2002 ;;;; -;;;; $Id: package.lisp,v 1.3 2004/01/19 11:23:44 ffjeld Exp $ +;;;; $Id: package.lisp,v 1.4 2004/07/21 22:29:16 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ -(defpackage muerte.lib - (:use muerte.cl muerte) +(defpackage #:muerte.lib + (:nicknames #:lib) + (:use #:common-lisp #:muerte) (:export #:*scroll-offset* #:cursor-x cursor-y #:console-width console-height @@ -58,12 +59,12 @@ #:with-named-integers-syntax ;; :lib/repl - #:*repl-level* - #:*repl-prompter* - #:*repl-prompt-context* - #:*repl-print-format* - #:*repl-readline-context* - #:read-eval-print +;;; #:*repl-level* +;;; #:*repl-prompter* +;;; #:*repl-prompt-context* +;;; #:*repl-print-format* +;;; #:*repl-readline-context* +;;; #:read-eval-print )) (provide :lib/package)

1 0

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

21 Jul '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv25024 Modified Files: movitz.lisp Log Message: Fixed un-backquote for non-proper lists, like `(a b . c). Date: Wed Jul 21 15:28:48 2004 Author: ffjeld Index: movitz/movitz.lisp diff -u movitz/movitz.lisp:1.7 movitz/movitz.lisp:1.8 --- movitz/movitz.lisp:1.7 Wed Apr 21 08:09:25 2004 +++ movitz/movitz.lisp Wed Jul 21 15:28:48 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Mon Oct 9 20:52:58 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: movitz.lisp,v 1.7 2004/04/21 15:09:25 ffjeld Exp $ +;;;; $Id: movitz.lisp,v 1.8 2004/07/21 22:28:48 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -132,7 +132,10 @@ (list 'list (list 'quote 'backquote-comma-at) (un-backquote (cadr sub-form) (1- level)))))) - (t (list 'list (un-backquote sub-form level))))))))))) + (t (list 'list (un-backquote sub-form level)))))) + when (not (listp (cdr sub-form-head))) + collect (list 'quote (cdr sub-form-head))) + )))) (array (error "Array backquote not implemented.")) (t (list 'quote form)))))

1 0

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

21 Jul '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv13376 Modified Files: compiler.lisp Log Message: Small fix to "unused variable" warning. Date: Wed Jul 21 15:26:55 2004 Author: ffjeld Index: movitz/compiler.lisp diff -u movitz/compiler.lisp:1.80 movitz/compiler.lisp:1.81 --- movitz/compiler.lisp:1.80 Tue Jul 20 05:59:53 2004 +++ movitz/compiler.lisp Wed Jul 21 15:26:55 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.80 2004/07/20 12:59:53 ffjeld Exp $ +;;;; $Id: compiler.lisp,v 1.81 2004/07/21 22:26:55 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -2821,7 +2821,8 @@ (unless (or (movitz-env-get variable 'ignore nil env nil) (movitz-env-get variable 'ignorable nil env nil) (typep binding 'hidden-rest-function-argument)) - (warn "Unused variable: ~S" binding))))) + (warn "Unused variable: ~S" + (binding-name binding)))))) collect binding)) (bindings-fun-arg-sorted (when (eq env function-env) @@ -5884,7 +5885,7 @@ (and (typep binding 'forwarding-binding) (recursive-located-p (forwarding-binding-target b)))))) (recursive-located-p binding))) - (warn "Unused variable: ~S." binding))) + (warn "Unused variable: ~S." (binding-name binding)))) ((typep binding 'forwarding-binding) ;; No need to do any initialization because the target will be initialized. (assert (not (binding-lended-p binding)))

1 0

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

21 Jul '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv23105 Modified Files: integers.lisp Log Message: Improved deftypes so they work on both movitz and host-sides. Date: Wed Jul 21 07:18:03 2004 Author: ffjeld Index: movitz/losp/muerte/integers.lisp diff -u movitz/losp/muerte/integers.lisp:1.80 movitz/losp/muerte/integers.lisp:1.81 --- movitz/losp/muerte/integers.lisp:1.80 Tue Jul 20 02:19:00 2004 +++ movitz/losp/muerte/integers.lisp Wed Jul 21 07:18:03 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.80 2004/07/20 09:19:00 ffjeld Exp $ +;;;; $Id: integers.lisp,v 1.81 2004/07/21 14:18:03 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -344,13 +344,13 @@ ;;;; (deftype positive-fixnum () - `(integer 0 ,movitz:+movitz-most-positive-fixnum+)) + '(integer 0 #.movitz:+movitz-most-positive-fixnum+)) (deftype positive-bignum () - `(integer ,(1+ movitz:+movitz-most-positive-fixnum+) *)) + `(integer #.(cl:1+ movitz:+movitz-most-positive-fixnum+) *)) (deftype negative-fixnum () - `(integer ,movitz:+movitz-most-negative-fixnum+ -1)) + `(integer #.movitz:+movitz-most-negative-fixnum+ -1)) (defun fixnump (x) (typep x 'fixnum))

1 0

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

21 Jul '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv18273 Modified Files: basic-macros.lisp Log Message: Correct movitz-backquote macro. Date: Wed Jul 21 07:17:35 2004 Author: ffjeld Index: movitz/losp/muerte/basic-macros.lisp diff -u movitz/losp/muerte/basic-macros.lisp:1.29 movitz/losp/muerte/basic-macros.lisp:1.30 --- movitz/losp/muerte/basic-macros.lisp:1.29 Wed Jul 21 06:28:44 2004 +++ movitz/losp/muerte/basic-macros.lisp Wed Jul 21 07:17:35 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Wed Nov 8 18:44:57 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: basic-macros.lisp,v 1.29 2004/07/21 13:28:44 ffjeld Exp $ +;;;; $Id: basic-macros.lisp,v 1.30 2004/07/21 14:17:35 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -966,7 +966,7 @@ (error "numargs-case at illegal position.")) (defmacro movitz-backquote (expression) - `(un-backquote ',expression 0)) + (un-backquote expression 0)) (define-compiler-macro spin-wait-pause () "Insert a pause instruction, which improves performance of

1 0

← Newer
1
...
8
9
10
11
12
13
14
...
38
Older →

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

2004

movitz-cvs July 2004