February 2004 - movitz-cvs@common-lisp.net

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

11 Feb '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv26136 Modified Files: compiler-types.lisp Log Message: Small fix in encoded-types-or: Remember to return complement-p nil for the normal case when inputs complement0 and complement1 are nil. Date: Wed Feb 11 13:01:40 2004 Author: ffjeld Index: movitz/compiler-types.lisp diff -u movitz/compiler-types.lisp:1.2 movitz/compiler-types.lisp:1.3 --- movitz/compiler-types.lisp:1.2 Mon Jan 19 06:23:41 2004 +++ movitz/compiler-types.lisp Wed Feb 11 13:01:40 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Wed Sep 10 00:40:07 2003 ;;;; -;;;; $Id: compiler-types.lisp,v 1.2 2004/01/19 11:23:41 ffjeld Exp $ +;;;; $Id: compiler-types.lisp,v 1.3 2004/02/11 18:01:40 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -442,11 +442,13 @@ (or (encoded-typep nil t x code0 integer-range0 nil include0 nil) (encoded-typep nil t x code1 integer-range1 nil include1 nil))) (union members0 members1 :test #'movitz-eql)) - (union include0 include1 :test #'equal)))) + (union include0 include1 :test #'equal) + nil))) (t (error "Not implemented")))) (defun type-specifier-encode (type-specifier) + "Encode a type-specifier to internal representation." (let ((type-specifier (translate-program type-specifier :muerte.cl :cl))) (cond ((atom type-specifier)

1 0

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

11 Feb '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv23329 Modified Files: image.lisp Log Message: Fixed movitz-word-by-image and image-memref. Date: Wed Feb 11 11:22:38 2004 Author: ffjeld Index: movitz/image.lisp diff -u movitz/image.lisp:1.13 movitz/image.lisp:1.14 --- movitz/image.lisp:1.13 Tue Feb 10 13:06:13 2004 +++ movitz/image.lisp Wed Feb 11 11:22:38 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.13 2004/02/10 18:06:13 ffjeld Exp $ +;;;; $Id: image.lisp,v 1.14 2004/02/11 16:22:38 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -543,7 +543,7 @@ new-ptr)))))) (defmethod image-memref ((image symbolic-image) address &optional (errorp nil)) - (let ((obj (gethash address (image-address-hash image)))) + (let ((obj (gethash address (image-address-hash image) :nothing))) (when (and errorp (not (typep obj 'movitz-object))) (error "Found non-movitz-object at image-address #x~X: ~A" address obj)) obj)) @@ -614,7 +614,7 @@ (:character (make-instance 'movitz-character :char (code-char (ldb (byte 8 8) word)))) (:null - (image-memref *image* (+ 3 word) t)) + (image-nil-word image)) (t (image-memref *image* (logand word #xfffffff8) t)))) (defun movitz-intern-code-vector (object &optional (type 'code-vector-word))

1 0

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

11 Feb '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv25313 Modified Files: loop.lisp Log Message: Added to loop expansions some ignorable declarations for hash-table iteration. Date: Wed Feb 11 09:52:51 2004 Author: ffjeld Index: movitz/losp/muerte/loop.lisp diff -u movitz/losp/muerte/loop.lisp:1.4 movitz/losp/muerte/loop.lisp:1.5 --- movitz/losp/muerte/loop.lisp:1.4 Tue Feb 10 18:40:17 2004 +++ movitz/losp/muerte/loop.lisp Wed Feb 11 09:52:51 2004 @@ -47,11 +47,22 @@ ;;;; LOOP Iteration Macro + +;;; Movitz notes: +;;; +;;; - Because much of this file is wrapped in eval-when (:compile-toplevel), +;;; (i.e. the host-side macroexpanders), it's probably best to +;;; recompile/reload this complete file rather than on a per-toplevel +;;; form basis. + +#+movitz +(in-package muerte) + ;;;#+allegro ;;;(in-package :excl) ;;;#-allegro ;;;(in-package :ansi-loop) -(in-package muerte) + (provide :muerte/loop :load-priority 0) @@ -1881,12 +1892,19 @@ dummy-predicate-var (loop-when-it-variable)) (let ((key-var nil) (val-var nil) + (ignore-vars nil) (bindings `((,variable nil ,data-type) (,ht-var ,(cadar prep-phrases)) ,@(and other-p other-var `((,other-var nil)))))) - (if (eq which 'hash-key) - (setq key-var variable val-var (and other-p other-var)) - (setq key-var (and other-p other-var) val-var variable)) + (ecase which + (hash-key + (setq key-var variable val-var (and other-p other-var)) + (when val-var + (pushnew val-var ignore-vars))) + (hash-value ; default? + (setq key-var (and other-p other-var) val-var variable) + (when key-var + (pushnew key-var ignore-vars)))) (push `(with-hash-table-iterator (,next-fn ,ht-var)) *loop-wrappers*) (when (consp key-var) (setq post-steps `(,key-var ,(setq key-var (loop-gentemp 'loop-hash-key-temp-)) @@ -1896,6 +1914,11 @@ (setq post-steps `(,val-var ,(setq val-var (loop-gentemp 'loop-hash-val-temp-)) ,@post-steps)) (push `(,val-var nil) bindings)) + (pushnew dummy-predicate-var ignore-vars) + (when ignore-vars + (pushnew `(ignorable ,@ignore-vars) + *loop-declarations* + :test 'equalp)) `(,bindings ;bindings () ;prologue () ;pre-test

1 0

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

10 Feb '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv18912 Modified Files: loop.lisp Log Message: Factored out defstructs so they are not evaluated twice for every compilation of this file. Date: Tue Feb 10 18:40:17 2004 Author: ffjeld Index: movitz/losp/muerte/loop.lisp diff -u movitz/losp/muerte/loop.lisp:1.3 movitz/losp/muerte/loop.lisp:1.4 --- movitz/losp/muerte/loop.lisp:1.3 Wed Jan 21 17:02:09 2004 +++ movitz/losp/muerte/loop.lisp Tue Feb 10 18:40:17 2004 @@ -298,6 +298,53 @@ #-LISPM `(cdr ,head-var)))) +(defstruct (loop-minimax + (:constructor make-loop-minimax-internal) + (:copier nil) + (:predicate nil)) + answer-variable + type + temp-variable + flag-variable + operations + infinity-data) + +(defstruct (loop-universe + (:print-function print-loop-universe) + (:copier nil) + (:predicate nil)) + keywords ;hash table, value = (fn-name . extra-data). + iteration-keywords ;hash table, value = (fn-name . extra-data). + for-keywords ;hash table, value = (fn-name . extra-data). + path-keywords ;hash table, value = (fn-name . extra-data). + type-symbols ;hash table of type SYMBOLS, test EQ, value = CL type specifier. + type-keywords ;hash table of type STRINGS, test EQUAL, value = CL type spec. + ansi ;NIL, T, or :EXTENDED. + implicit-for-required ;see loop-hack-iteration + ) + + +(defstruct (loop-collector + (:copier nil) + (:predicate nil)) + name + class + (history nil) + (tempvars nil) + dtype + (data nil)) ;collector-specific data + +(defstruct (loop-path + (:copier nil) + (:predicate nil)) + names + preposition-groups + inclusive-permitted + function + user-data) + + + ;;;; Maximization Technology (eval-when (:compile-toplevel :execute) @@ -317,18 +364,6 @@ |# -(defstruct (loop-minimax - (:constructor make-loop-minimax-internal) - (:copier nil) - (:predicate nil)) - answer-variable - type - temp-variable - flag-variable - operations - infinity-data) - - (defvar *loop-minimax-type-infinities-alist* ;;@@@@ This is the sort of value this should take on for a Lisp that has ;; "eminently usable" infinities. n.b. there are neither constants nor @@ -467,19 +502,7 @@ (defmacro loop-store-table-data (symbol table datum) `(setf (gethash (symbol-name ,symbol) ,table) ,datum)) -(defstruct (loop-universe - (:print-function print-loop-universe) - (:copier nil) - (:predicate nil)) - keywords ;hash table, value = (fn-name . extra-data). - iteration-keywords ;hash table, value = (fn-name . extra-data). - for-keywords ;hash table, value = (fn-name . extra-data). - path-keywords ;hash table, value = (fn-name . extra-data). - type-symbols ;hash table of type SYMBOLS, test EQ, value = CL type specifier. - type-keywords ;hash table of type STRINGS, test EQUAL, value = CL type spec. - ansi ;NIL, T, or :EXTENDED. - implicit-for-required ;see loop-hack-iteration - ) + (defun print-loop-universe (u stream level) @@ -1192,15 +1215,6 @@ ;;;; Value Accumulation: List -(defstruct (loop-collector - (:copier nil) - (:predicate nil)) - name - class - (history nil) - (tempvars nil) - dtype - (data nil)) ;collector-specific data (eval-when (:compile-toplevel #+movitz-loop :load-toplevel) @@ -1578,14 +1592,6 @@ ;;;; Iteration Paths -(defstruct (loop-path - (:copier nil) - (:predicate nil)) - names - preposition-groups - inclusive-permitted - function - user-data) (defun add-loop-path (names function universe &key preposition-groups inclusive-permitted user-data)

1 0

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

10 Feb '04

Update of /project/movitz/cvsroot/movitz/losp In directory common-lisp.net:/tmp/cvs-serv12960 Modified Files: los0.lisp Log Message: sync. Date: Tue Feb 10 18:38:20 2004 Author: ffjeld Index: movitz/losp/los0.lisp diff -u movitz/losp/los0.lisp:1.2 movitz/losp/los0.lisp:1.3 --- movitz/losp/los0.lisp:1.2 Mon Jan 19 06:23:43 2004 +++ movitz/losp/los0.lisp Tue Feb 10 18:38:20 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.2 2004/01/19 11:23:43 ffjeld Exp $ +;;;; $Id: los0.lisp,v 1.3 2004/02/10 23:38:20 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -19,7 +19,7 @@ (require :x86-pc/all) (require :x86-pc/io-space) (require :x86-pc/ne2k) -(require :x86-pc/floppy) +;; (require :x86-pc/floppy) (require :lib/readline) (require :lib/toplevel) @@ -428,14 +428,13 @@ - -#+ignore +s#+ignore (defun test-ncase (x y z) (numargs-case (1 (x) (values x 'one)) (2 (x y) (values (+ x y) 'one 'two)) (3 (x y z) (values (+ x y z) 'one 'two 'three)) - (t (&rest args) (declare (ignore args)) 27))) + (t (args) (declare (ignore args)) 27))) #+ignore (defun xbar () @@ -488,8 +487,8 @@ (declare (ignore f)) (print "Cooking some food.")) -(defun foo (x) - (funcall (cdr x) 'abba)) +(defun foo (x &optional (y nil yp)) + (format t "~@{ ~A~}" yp)) (defun test-pie (n pie) (dotimes (i n)

1 0

[movitz-cvs] CVS update: movitz/special-operators.lisp
by Frode Vatvedt Fjeld 10 Feb '04

10 Feb '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv8243 Modified Files: special-operators.lisp Log Message: Minor edits and removed warnings. Date: Tue Feb 10 13:06:44 2004 Author: ffjeld Index: movitz/special-operators.lisp diff -u movitz/special-operators.lisp:1.7 movitz/special-operators.lisp:1.8 --- movitz/special-operators.lisp:1.7 Sun Feb 8 18:27:56 2004 +++ movitz/special-operators.lisp Tue Feb 10 13:06:44 2004 @@ -8,7 +8,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Fri Nov 24 16:22:59 2000 ;;;; -;;;; $Id: special-operators.lisp,v 1.7 2004/02/08 23:27:56 ffjeld Exp $ +;;;; $Id: special-operators.lisp,v 1.8 2004/02/10 18:06:44 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -593,9 +593,7 @@ (cdr form) (assert (not argument)) (compiler-values () - :code `(,@(when argument - `((:load-lexical ,argument :eax))) - (:call (:edi ,(slot-offset 'movitz-constant-block if-name)))) + :code `((:call (:edi ,(slot-offset 'movitz-constant-block if-name)))) :returns :nothing))) (define-special-operator inlined-not (&all forward &form form &result-mode result-mode) @@ -979,6 +977,7 @@ (let ((term2-type (type-specifier-primary term2-type))) ;;; (warn "t2-type: ~S, t2-ret: ~S, rm: ~S" ;;; term2-type term2-returns result-mode) + (declare (ignore term2-type)) (case term2-returns (:untagged-fixnum-eax (case result-mode @@ -1063,8 +1062,9 @@ (:into)))))))) (define-special-operator muerte::include (&form form) - (let ((*require-dependency-chain* (and (boundp '*require-dependency-chain*) - *require-dependency-chain*))) + (let ((*require-dependency-chain* + (and (boundp '*require-dependency-chain*) + (symbol-value '*require-dependency-chain*)))) (declare (special *require-dependency-chain*)) (destructuring-bind (module-name &optional path-spec) (cdr form) @@ -1142,6 +1142,7 @@ (make-compiled-argument-forms sub-forms (all :funobj) (all :env)) (multiple-value-bind (stack-restore-code new-returns) (make-compiled-stack-restore stack-displacement result-mode :multiple-values) + (declare (ignore stack-restore-code)) (compiler-values () :returns new-returns :type `(values ,@arguments-types)

1 0

[movitz-cvs] CVS update: movitz/special-operators-cl.lisp
by Frode Vatvedt Fjeld 10 Feb '04

10 Feb '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv7104 Modified Files: special-operators-cl.lisp Log Message: Minor edits and removed warnings. Date: Tue Feb 10 13:06:38 2004 Author: ffjeld Index: movitz/special-operators-cl.lisp diff -u movitz/special-operators-cl.lisp:1.6 movitz/special-operators-cl.lisp:1.7 --- movitz/special-operators-cl.lisp:1.6 Wed Feb 4 10:25:23 2004 +++ movitz/special-operators-cl.lisp Tue Feb 10 13:06:38 2004 @@ -9,7 +9,7 @@ ;;;; Created at: Fri Nov 24 16:31:11 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: special-operators-cl.lisp,v 1.6 2004/02/04 15:25:23 ffjeld Exp $ +;;;; $Id: special-operators-cl.lisp,v 1.7 2004/02/10 18:06:38 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -148,9 +148,7 @@ appending (cond ((binding-lended-p binding) - (error "Huh?") ; remove this clause.. - (append init-code - `((:initialize-lended-lexical ,binding :eax)))) + (error "Huh?")) ; remove this clause.. ;; #+ignore ((and (typep binding 'located-binding) (not (binding-lended-p binding)) @@ -757,8 +755,9 @@ ,result-form))))))) (define-special-operator require (&form form) - (let ((*require-dependency-chain* (and (boundp '*require-dependency-chain*) - *require-dependency-chain*))) + (let ((*require-dependency-chain* + (and (boundp '*require-dependency-chain*) + (symbol-value '*require-dependency-chain*)))) (declare (special *require-dependency-chain*)) (destructuring-bind (module-name &optional path-spec) (cdr form)

1 0

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

10 Feb '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv6753 Modified Files: packages.lisp Log Message: Minor edits and removed warnings. Date: Tue Feb 10 13:06:30 2004 Author: ffjeld Index: movitz/packages.lisp diff -u movitz/packages.lisp:1.4 movitz/packages.lisp:1.5 --- movitz/packages.lisp:1.4 Mon Feb 9 18:42:18 2004 +++ movitz/packages.lisp Tue Feb 10 13:06:30 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.4 2004/02/09 23:42:18 ffjeld Exp $ +;;;; $Id: packages.lisp,v 1.5 2004/02/10 18:06:30 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -1237,57 +1237,60 @@ (defpackage #:movitz (:use :common-lisp :binary-types) - (:export parse-docstring-and-declarations - global-constant-offset - tag tag-name - movitz-print - stream-image - with-procfs-image - *image* *i* - *default-image-file* - *default-image-init-file* - movitz-constantp - movitz-eval + (:export #:create-image + #:dump-image - movitz-compile-file + #:parse-docstring-and-declarations + #:global-constant-offset + #:tag #:tag-name + #:movitz-print + #:stream-image + #:with-procfs-image + #:*image* #:*i* + #:*default-image-file* + #:*default-image-init-file* + #:movitz-constantp + #:movitz-eval + + #:movitz-compile-file - movitz-std-instance - movitz-struct - type - movitz-funobj - funobj-type - code-vector - code-vector%1op - code-vector%2op - code-vector%3op + #:movitz-std-instance + #:movitz-struct + #:type + #:movitz-funobj + #:funobj-type + #:code-vector + #:code-vector%1op + #:code-vector%2op + #:code-vector%3op - +movitz-fixnum-factor+ - +movitz-fixnum-shift+ - constant0 + #:+movitz-fixnum-factor+ + #:+movitz-fixnum-shift+ + #:constant0 - movitz-object-browser-properties - movitz-heap-object + #:movitz-object-browser-properties + #:movitz-heap-object - movitz-vector - movitz-vector-num-elements - movitz-vector-element-type - movitz-vector-symbolic-data + #:movitz-vector + #:movitz-vector-num-elements + #:movitz-vector-element-type + #:movitz-vector-symbolic-data - movitz-symbol - movitz-string + #:movitz-symbol + #:movitz-string - movitz-character - movitz-char + #:movitz-character + #:movitz-char - movitz-struct - movitz-struct-length - movitz-struct-slot-values + #:movitz-struct + #:movitz-struct-length + #:movitz-struct-slot-values - movitz-intern - movitz-read - movitz-read-and-intern - movitz-word - word + #:movitz-intern + #:movitz-read + #:movitz-read-and-intern + #:movitz-word + #:word #:*warn-function-change-p* #:*compiler-do-optimize*

1 0

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

10 Feb '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv5249 Modified Files: load.lisp Log Message: Minor edits and removed warnings. Date: Tue Feb 10 13:06:22 2004 Author: ffjeld Index: movitz/load.lisp diff -u movitz/load.lisp:1.7 movitz/load.lisp:1.8 --- movitz/load.lisp:1.7 Mon Jan 19 14:21:14 2004 +++ movitz/load.lisp Tue Feb 10 13:06:22 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Thu Jan 15 18:40:58 2004 ;;;; -;;;; $Id: load.lisp,v 1.7 2004/01/19 19:21:14 ffjeld Exp $ +;;;; $Id: load.lisp,v 1.8 2004/02/10 18:06:22 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -85,3 +85,6 @@ "compiler" "special-operators" "special-operators-cl")))))) + +#+cmu18 (setf movitz:*compiler-compile-eval-whens* nil + movitz:*compiler-compile-macro-expanders* nil) \ No newline at end of file

1 0

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

10 Feb '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv3872 Modified Files: image.lisp Log Message: Minor edits and removed warnings. Date: Tue Feb 10 13:06:13 2004 Author: ffjeld Index: movitz/image.lisp diff -u movitz/image.lisp:1.12 movitz/image.lisp:1.13 --- movitz/image.lisp:1.12 Mon Feb 9 19:32:08 2004 +++ movitz/image.lisp Tue Feb 10 13:06:13 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.12 2004/02/10 00:32:08 ffjeld Exp $ +;;;; $Id: image.lisp,v 1.13 2004/02/10 18:06:13 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -1263,9 +1263,10 @@ (defmacro with-movitz-read-context (options &body body) (declare (ignore options)) - `(let ((*movitz-reader-clean-map* (if (boundp '*movitz-reader-clean-map*) - *movitz-reader-clean-map* - (make-hash-table :test #'eq)))) + `(let ((*movitz-reader-clean-map* + (if (boundp '*movitz-reader-clean-map*) + (symbol-value '*movitz-reader-clean-map*) + (make-hash-table :test #'eq)))) (declare (special *movitz-reader-clean-map*)) ,@body)) @@ -1402,6 +1403,7 @@ (error "Unknown Movitz object: ~S" expr))))) (defmethod make-toplevel-funobj ((*image* symbolic-image)) + (declare (special *image*)) (let ((toplevel-code (loop for (funobj) in (image-load-time-funobjs *image*) collect `(muerte::simple-funcall ,funobj)))) (make-compiled-funobj 'muerte::toplevel-function ()

1 0