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

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

10 Jun '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv10838 Modified Files: functions.lisp Log Message: Made unbound-function produce an undefined-function-call error, rather than just undefined-function. Date: Thu Jun 10 05:09:15 2004 Author: ffjeld Index: movitz/losp/muerte/functions.lisp diff -u movitz/losp/muerte/functions.lisp:1.11 movitz/losp/muerte/functions.lisp:1.12 --- movitz/losp/muerte/functions.lisp:1.11 Fri Apr 23 08:05:35 2004 +++ movitz/losp/muerte/functions.lisp Thu Jun 10 05:09:15 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Tue Mar 12 22:58:54 2002 ;;;; -;;;; $Id: functions.lisp,v 1.11 2004/04/23 15:05:35 ffjeld Exp $ +;;;; $Id: functions.lisp,v 1.12 2004/06/10 12:09:15 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -75,14 +75,17 @@ (not (apply function args)))) (defun unbound-function (&edx edx &rest args) - (declare (ignore args)) + "This is the function that is the unbound value for function cells." + (declare (dynamic-extent args)) (let ((function-name (typecase edx (symbol edx) (compiled-function (funobj-name edx)) (t '(unknown))))) - (error 'undefined-function :name function-name))) + (error 'undefined-function-call + :name function-name + :arguments (copy-list args)))) ;;; funobj object

1 0

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

10 Jun '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv2551 Modified Files: conditions.lisp Log Message: Added condition undefined-function-call as a subclass of undefined-function. Date: Thu Jun 10 05:07:02 2004 Author: ffjeld Index: movitz/losp/muerte/conditions.lisp diff -u movitz/losp/muerte/conditions.lisp:1.6 movitz/losp/muerte/conditions.lisp:1.7 --- movitz/losp/muerte/conditions.lisp:1.6 Sun Apr 18 16:17:36 2004 +++ movitz/losp/muerte/conditions.lisp Thu Jun 10 05:07:02 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.6 2004/04/18 23:17:36 ffjeld Exp $ +;;;; $Id: conditions.lisp,v 1.7 2004/06/10 12:07:02 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -79,6 +79,15 @@ (:report (lambda (c s) (format s "Undefined function ~S." (cell-error-name c))))) + +(define-condition undefined-function-call (undefined-function) + ((arguments + :initarg :arguments + :reader undefined-function-call-arguments)) + (:report (lambda (c s) + (format s "Undefined function ~S called with arguments ~:S." + (cell-error-name c) + (undefined-function-call-arguments c))))) (define-condition unbound-variable (cell-error) ()

1 0

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

10 Jun '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv2108 Modified Files: compiler.lisp Log Message: Fixed nasty omission of functionality for functions with arglist like (x &optional y). Still somewhat missing, but at least now it will complain rather than silently produce faulty code. Date: Thu Jun 10 05:05:56 2004 Author: ffjeld Index: movitz/compiler.lisp diff -u movitz/compiler.lisp:1.66 movitz/compiler.lisp:1.67 --- movitz/compiler.lisp:1.66 Wed Jun 9 15:55:37 2004 +++ movitz/compiler.lisp Thu Jun 10 05:05:56 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.66 2004/06/09 22:55:37 ffjeld Exp $ +;;;; $Id: compiler.lisp,v 1.67 2004/06/10 12:05:56 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -723,6 +723,21 @@ (t (error "Can't deal with optional-p at ~S, after (~S ~S)." optp-location req-location opt-location))) (make-stack-setup-code (- stack-frame-size stack-setup-pre)) + (when (binding-lended-p req-binding) + (let ((lended-cons-position (getf (binding-lended-p req-binding) + :stack-cons-location))) + (etypecase req-location + (integer + `((:movl (:ebp ,(stack-frame-offset req-location)) :edx) + (:movl :edi (:ebp ,(stack-frame-offset lended-cons-position))) ; cdr + (:movl :edx (:ebp ,(stack-frame-offset (1+ lended-cons-position)))) ; car + (:leal (:ebp 1 ,(stack-frame-offset (1+ lended-cons-position))) + :edx) + (:movl :edx (:ebp ,(stack-frame-offset req-location)))))))) + (when (binding-lended-p opt-binding) + (error "Can't deal with lending optional right now.")) + (when (and optp-binding (binding-lended-p optp-binding)) + (error "Can't deal with lending optionalp right now.")) resolved-code (make-compiled-function-postlude funobj function-env use-stack-frame-p))))) @@ -798,7 +813,7 @@ (and code2 (eq x 'entry%2op)) (and code3 (eq x 'entry%3op)))) codet))))) - ;; (warn "opt code: ~{~&~A~}" optimized-function-code) + ;; (print-code funobj combined-code) (assemble-funobj funobj combined-code)))) funobj) @@ -5839,6 +5854,8 @@ init-with-register init-with-type) (cdr instruction) (declare (ignore protect-carry)) ; nothing modifies carry anyway. + (when (string= (binding-name binding) 'reader-function) + (break "init: ~S" instruction)) ;; (assert (eq binding (ensure-local-binding binding funobj))) (assert (eq funobj (binding-funobj binding))) (cond @@ -5854,6 +5871,7 @@ (warn "Unused variable: ~S." binding))) ((typep binding 'forwarding-binding) ;; No need to do any initialization because the target will be initialized. + (assert (not (binding-lended-p binding))) nil) (t (when (movitz-env-get (binding-name binding) 'ignore nil (binding-env binding)) (warn "Variable ~S used while declared ignored." (binding-name binding)))

1 0

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

09 Jun '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv2187 Modified Files: integers.lisp Log Message: Imrpoved logandc1 and logandc2. Date: Wed Jun 9 19:13:19 2004 Author: ffjeld Index: movitz/losp/muerte/integers.lisp diff -u movitz/losp/muerte/integers.lisp:1.34 movitz/losp/muerte/integers.lisp:1.35 --- movitz/losp/muerte/integers.lisp:1.34 Wed Jun 9 18:51:26 2004 +++ movitz/losp/muerte/integers.lisp Wed Jun 9 19:13:19 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.34 2004/06/10 01:51:26 ffjeld Exp $ +;;;; $Id: integers.lisp,v 1.35 2004/06/10 02:13:19 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -1422,22 +1422,42 @@ ,@(cddr constant-folded-integers)))))) (defun logandc1 (integer1 integer2) - (check-type integer1 fixnum) - (check-type integer2 fixnum) - (with-inline-assembly (:returns :eax) - (:compile-form (:result-mode :eax) integer1) - (:compile-form (:result-mode :ebx) integer2) - (:notl :eax) - (:andl :ebx :eax))) + (number-double-dispatch (integer1 integer2) + ((t positive-fixnum) + (with-inline-assembly (:returns :eax) + (:compile-form (:result-mode :eax) integer1) + (:call-global-constant unbox-u32) + (:shll #.movitz:+movitz-fixnum-shift+ :ecx) + (:compile-form (:result-mode :eax) integer2) + (:notl :ecx) + (:andl :ecx :eax))) + ((positive-fixnum t) + (with-inline-assembly (:returns :eax) + (:compile-form (:result-mode :eax) integer2) + (:call-global-constant unbox-u32) + (:leal ((:ecx #.movitz:+movitz-fixnum-factor+)) :eax) + (:compile-form (:result-mode :ecx) integer1) + (:notl :ecx) + (:andl :ecx :eax))))) (defun logandc2 (integer1 integer2) - (check-type integer1 fixnum) - (check-type integer2 fixnum) - (with-inline-assembly (:returns :eax) - (:compile-form (:result-mode :eax) integer1) - (:compile-form (:result-mode :ebx) integer2) - (:notl :ebx) - (:andl :ebx :eax))) + (number-double-dispatch (integer1 integer2) + ((positive-fixnum t) + (with-inline-assembly (:returns :eax) + (:compile-form (:result-mode :eax) integer2) + (:call-global-constant unbox-u32) + (:shll #.movitz:+movitz-fixnum-shift+ :ecx) + (:compile-form (:result-mode :eax) integer1) + (:notl :ecx) + (:andl :ecx :eax))) + ((t positive-fixnum) + (with-inline-assembly (:returns :eax) + (:compile-form (:result-mode :eax) integer1) + (:call-global-constant unbox-u32) + (:leal ((:ecx #.movitz:+movitz-fixnum-factor+)) :eax) + (:compile-form (:result-mode :ecx) integer2) + (:notl :ecx) + (:andl :ecx :eax))))) (defun logior%2op (x y) (with-inline-assembly (:returns :eax)

1 0

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

09 Jun '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv1378 Modified Files: integers.lisp Log Message: A simple but working ash. Date: Wed Jun 9 18:51:26 2004 Author: ffjeld Index: movitz/losp/muerte/integers.lisp diff -u movitz/losp/muerte/integers.lisp:1.33 movitz/losp/muerte/integers.lisp:1.34 --- movitz/losp/muerte/integers.lisp:1.33 Wed Jun 9 18:30:31 2004 +++ movitz/losp/muerte/integers.lisp Wed Jun 9 18:51:26 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.33 2004/06/10 01:30:31 ffjeld Exp $ +;;;; $Id: integers.lisp,v 1.34 2004/06/10 01:51:26 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -835,27 +835,35 @@ ((minusp count) `(if (minusp ,integer) -1 0)) (t `(if (= 0 ,integer) 0 (with-inline-assembly (:returns :non-local-exit) (:int 4))))))))))) - + (defun ash (integer count) - (check-type integer fixnum) - (check-type count fixnum) (cond - ((= 0 count) - integer) - ((<= 1 count 29) + ((not (minusp count)) (dotimes (i count integer) - (setq integer (ash integer 1)))) - ((<= count #.(cl:- 1 movitz::+movitz-fixnum-bits+)) - (if (minusp integer) -1 0)) - ((minusp count) - (with-inline-assembly (:returns :eax) - (:compile-form (:result-mode :ecx) count) - (:compile-form (:result-mode :eax) integer) - (:negl :ecx) - (:shrl #.movitz::+movitz-fixnum-shift+ :ecx) - (:sarl :cl :eax) - (:andb #.(cl:logxor #xff movitz::+movitz-fixnum-zmask+) :al))) - (t (if (= 0 integer) 0 (error "Illegal ash count: ~D" count))))) + (setf integer (no-macro-call * 2 integer)))) + (t (dotimes (i (- count) integer) + (setf integer (truncate integer 2)))))) + +;;;(defun ash (integer count) +;;; (check-type integer fixnum) +;;; (check-type count fixnum) +;;; (cond +;;; ((= 0 count) +;;; integer) +;;; ((<= 1 count 29) +;;; (dotimes (i count integer) +;;; (setq integer (ash integer 1)))) +;;; ((<= count #.(cl:- 1 movitz::+movitz-fixnum-bits+)) +;;; (if (minusp integer) -1 0)) +;;; ((minusp count) +;;; (with-inline-assembly (:returns :eax) +;;; (:compile-form (:result-mode :ecx) count) +;;; (:compile-form (:result-mode :eax) integer) +;;; (:negl :ecx) +;;; (:shrl #.movitz::+movitz-fixnum-shift+ :ecx) +;;; (:sarl :cl :eax) +;;; (:andb #.(cl:logxor #xff movitz::+movitz-fixnum-zmask+) :al))) +;;; (t (if (= 0 integer) 0 (error "Illegal ash count: ~D" count))))) ;;; Types

1 0

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

09 Jun '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv3889 Modified Files: integers.lisp Log Message: Re-wrote rem in terms of truncate, taking advantage of truncate's bignum support. Date: Wed Jun 9 18:30:31 2004 Author: ffjeld Index: movitz/losp/muerte/integers.lisp diff -u movitz/losp/muerte/integers.lisp:1.32 movitz/losp/muerte/integers.lisp:1.33 --- movitz/losp/muerte/integers.lisp:1.32 Wed Jun 9 18:25:27 2004 +++ movitz/losp/muerte/integers.lisp Wed Jun 9 18:30:31 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.32 2004/06/10 01:25:27 ffjeld Exp $ +;;;; $Id: integers.lisp,v 1.33 2004/06/10 01:30:31 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -1316,18 +1316,7 @@ (t (error "Don't know.")))) (defun rem (dividend divisor) - (with-inline-assembly (:returns :eax) - (:compile-form (:result-mode :eax) dividend) - (:compile-form (:result-mode :ebx) divisor) - (:movl :eax :ecx) - (:orl :ebx :ecx) - (:testb #.movitz::+movitz-fixnum-zmask+ :cl) - (:jnz '(:sub-program (not-integer) (:int 107))) - (:cdq :eax :edx) - (:idivl :ebx :eax :edx) - (:movl :edx :eax))) - - + (nth-value 1 (truncate dividend divisor))) (defun mod (number divisor) "Returns second result of FLOOR."

1 0

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

09 Jun '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv22039 Modified Files: integers.lisp Log Message: Minor shifting around of code. Date: Wed Jun 9 18:25:27 2004 Author: ffjeld Index: movitz/losp/muerte/integers.lisp diff -u movitz/losp/muerte/integers.lisp:1.31 movitz/losp/muerte/integers.lisp:1.32 --- movitz/losp/muerte/integers.lisp:1.31 Wed Jun 9 15:52:12 2004 +++ movitz/losp/muerte/integers.lisp Wed Jun 9 18:25:27 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.31 2004/06/09 22:52:12 ffjeld Exp $ +;;;; $Id: integers.lisp,v 1.32 2004/06/10 01:25:27 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -788,34 +788,6 @@ (when (< x min) (setq min x))))) -;;; Types - -(define-typep integer (x &optional (min '*) (max '*)) - (and (typep x 'integer) - (or (eq min '*) (<= min x)) - (or (eq max '*) (<= x max)))) - -(deftype signed-byte (&optional (size '*)) - (cond - ((eq size '*) - 'integer) - ((typep size '(integer 1 *)) - (list 'integer - (- (ash 1 (1- size))) - (1- (ash 1 (1- size))))) - (t (error "Illegal size for signed-byte.")))) - -(deftype unsigned-byte (&optional (size '*)) - (cond - ((eq size '*) - '(integer 0)) - ((typep size '(integer 1 *)) - (list 'integer 0 (1- (ash 1 size)))) - (t (error "Illegal size for unsigned-byte.")))) - -(define-simple-typep (bit bitp) (x) - (or (eq x 0) (eq x 1))) - ;; shift (define-compiler-macro ash (&whole form integer count &environment env) @@ -884,6 +856,36 @@ (:sarl :cl :eax) (:andb #.(cl:logxor #xff movitz::+movitz-fixnum-zmask+) :al))) (t (if (= 0 integer) 0 (error "Illegal ash count: ~D" count))))) + +;;; Types + +(define-typep integer (x &optional (min '*) (max '*)) + (and (typep x 'integer) + (or (eq min '*) (<= min x)) + (or (eq max '*) (<= x max)))) + +(deftype signed-byte (&optional (size '*)) + (cond + ((eq size '*) + 'integer) + ((typep size '(integer 1 *)) + (list 'integer + (- (ash 1 (1- size))) + (1- (ash 1 (1- size))))) + (t (error "Illegal size for signed-byte.")))) + +(deftype unsigned-byte (&optional (size '*)) + (cond + ((eq size '*) + '(integer 0)) + ((typep size '(integer 1 *)) + (list 'integer 0 (1- (ash 1 size)))) + (t (error "Illegal size for unsigned-byte.")))) + +(define-simple-typep (bit bitp) (x) + (or (eq x 0) (eq x 1))) + +;;;; (defun integer-length (integer) "=> number-of-bits"

1 0

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

09 Jun '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv21062 Modified Files: typep.lisp Log Message: Small fix. Date: Wed Jun 9 16:05:34 2004 Author: ffjeld Index: movitz/losp/muerte/typep.lisp diff -u movitz/losp/muerte/typep.lisp:1.15 movitz/losp/muerte/typep.lisp:1.16 --- movitz/losp/muerte/typep.lisp:1.15 Wed Jun 9 13:13:16 2004 +++ movitz/losp/muerte/typep.lisp Wed Jun 9 16:05:34 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.15 2004/06/09 20:13:16 ffjeld Exp $ +;;;; $Id: typep.lisp,v 1.16 2004/06/09 23:05:34 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -253,7 +253,8 @@ (when deriver-function `(typep ,object ',(funcall deriver-function))))))) ((consp type) - (let ((deriver-function (gethash (car type) *compiler-derived-typespecs*))) + (let ((deriver-function (gethash (translate-program (car type) :cl :muerte.cl) + *compiler-derived-typespecs*))) (if deriver-function `(typep ,object ',(apply deriver-function (cdr type))) (case (car type) @@ -372,7 +373,8 @@ (,(car type) ,@(loop for subtype in (cdr type) collect `(typep typep-object ',subtype))))) - (t (warn "compiling typep ~A" type))))))) + (t (warn "compiling typep ~S [~A]" type + (package-name (symbol-package (car type)))))))))) form))))) #+ignore

1 0

[movitz-cvs] CVS update: movitz/losp/muerte/more-macros.lisp
by Frode Vatvedt Fjeld 09 Jun '04

09 Jun '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv18632 Modified Files: more-macros.lisp Log Message: Moved %bignum-bigits compiler-macro here. Date: Wed Jun 9 16:04:26 2004 Author: ffjeld Index: movitz/losp/muerte/more-macros.lisp diff -u movitz/losp/muerte/more-macros.lisp:1.9 movitz/losp/muerte/more-macros.lisp:1.10 --- movitz/losp/muerte/more-macros.lisp:1.9 Wed Jun 9 10:22:51 2004 +++ movitz/losp/muerte/more-macros.lisp Wed Jun 9 16:04:26 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Fri Jun 7 15:05:57 2002 ;;;; -;;;; $Id: more-macros.lisp,v 1.9 2004/06/09 17:22:51 ffjeld Exp $ +;;;; $Id: more-macros.lisp,v 1.10 2004/06/09 23:04:26 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -311,6 +311,15 @@ (let ((,object-var ,instance-form)) ,@declarations-and-forms)))) + +(define-compiler-macro %bignum-bigits (x) + `(with-inline-assembly (:returns :eax) + (:compile-form (:result-mode :eax) ,x) + (:movzxw (:eax ,(bt:slot-offset 'movitz::movitz-bignum + 'movitz::length)) + :ecx) + (:leal ((:ecx ,movitz:+movitz-fixnum-factor+)) + :eax))) ;;; Some macros that aren't implemented, and we want to give compiler errors.

1 0

[movitz-cvs] CVS update: movitz/losp/lib/malloc-init.lisp
by Frode Vatvedt Fjeld 09 Jun '04

09 Jun '04

Update of /project/movitz/cvsroot/movitz/losp/lib In directory common-lisp.net:/tmp/cvs-serv14421 Modified Files: malloc-init.lisp Log Message: We'll start allocating at 2MB rather than 1MB, leaving more space for the kernel. Date: Wed Jun 9 16:00:57 2004 Author: ffjeld Index: movitz/losp/lib/malloc-init.lisp diff -u movitz/losp/lib/malloc-init.lisp:1.2 movitz/losp/lib/malloc-init.lisp:1.3 --- movitz/losp/lib/malloc-init.lisp:1.2 Mon Jan 19 03:23:44 2004 +++ movitz/losp/lib/malloc-init.lisp Wed Jun 9 16:00:57 2004 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Wed Jan 9 15:57:22 2002 ;;;; -;;;; $Id: malloc-init.lisp,v 1.2 2004/01/19 11:23:44 ffjeld Exp $ +;;;; $Id: malloc-init.lisp,v 1.3 2004/06/09 23:00:57 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -20,7 +20,7 @@ (in-package muerte.lib) (let ((memsize (muerte.x86-pc::memory-size)) - (start (truncate (* 1 1024 1024) 4096))) + (start (truncate (* 2 1024 1024) 4096))) ; XXX We really should calcucalte this.. ;; (format t "Memory: ~D MB.~%" memsize) (muerte:malloc-initialize start (- (* memsize #x100) start)))

1 0