movitz-cvs

movitz-cvs@common-lisp.net

2595 discussions

[movitz-cvs] CVS movitz
by ffjeld 14 Apr '08

14 Apr '08

Update of /project/movitz/cvsroot/movitz In directory clnet:/tmp/cvs-serv12646 Modified Files: compiler.lisp Log Message: Fix a compiler bug where the compiler would barf on e.g. (flet ((foo ..)) (lambda () #'foo)). --- /project/movitz/cvsroot/movitz/compiler.lisp 2008/04/12 16:46:05 1.200 +++ /project/movitz/cvsroot/movitz/compiler.lisp 2008/04/14 20:39:42 1.201 @@ -8,7 +8,7 @@ ;;;; Created at: Wed Oct 25 12:30:49 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: compiler.lisp,v 1.200 2008/04/12 16:46:05 ffjeld Exp $ +;;;; $Id: compiler.lisp,v 1.201 2008/04/14 20:39:42 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -6377,7 +6377,7 @@ (defun ensure-local-binding (binding funobj) "When referencing binding in funobj, ensure we have the binding local to funobj." - (if (typep binding '(or (not binding) constant-object-binding)) + (if (typep binding '(or (not binding) constant-object-binding funobj-binding)) binding ; Never mind if "binding" isn't a binding, or is a constant-binding. (let ((target-binding (binding-target binding))) (cond @@ -7145,7 +7145,9 @@ but it's requested to be in ~S." destreg) (let ((srcloc (new-binding-location (binding-target src) frame-map))) - (unless (eql srcloc loc1) (break)) + (unless (eql srcloc loc1) + #+ignore (break) + (warn "add srcloc: ~S, loc1: ~S" srcloc loc1)) (if (integerp srcloc) `((:addl (:ebp ,(stack-frame-offset srcloc)) ,destreg)

1 0

[movitz-cvs] CVS movitz/losp/muerte
by ffjeld 13 Apr '08

13 Apr '08

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory clnet:/tmp/cvs-serv10793 Modified Files: eval.lisp Log Message: For make-destructuring-env, throw program-error when too few or too many values are provided. --- /project/movitz/cvsroot/movitz/losp/muerte/eval.lisp 2008/04/08 21:39:52 1.29 +++ /project/movitz/cvsroot/movitz/losp/muerte/eval.lisp 2008/04/13 20:12:37 1.30 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Fri Oct 19 21:15:12 2001 ;;;; -;;;; $Id: eval.lisp,v 1.29 2008/04/08 21:39:52 ffjeld Exp $ +;;;; $Id: eval.lisp,v 1.30 2008/04/13 20:12:37 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -279,17 +279,17 @@ (setf env-var (cadr pattern) pattern (cddr pattern))) (loop with next-states = '(&optional &rest &key &aux) - with state = 'requireds - for pp on pattern as p = (car pp) - if (member p next-states) - do (setf next-states (member p next-states) - state p) - else do (cond + with state = 'requireds + for pp on pattern as p = (car pp) + if (member p next-states) + do (setf next-states (member p next-states) + state p) + else do (cond ((and (eq state 'requireds) recursive-p (consp p)) (unless (listp (car values)) - (error "Pattern mismatch.")) + (simple-program-error "Lambda-list pattern mismatch.")) (setf env (make-destructuring-env p (pop values) env :recursive-p nil :environment-p nil))) @@ -302,7 +302,8 @@ (case state (requireds (when (null values) - (error "Too few values provided. [~S:~S:~S]" state next-states env)) + (simple-program-error "Too few values provided. [~S:~S:~S]" + state next-states env)) (push (cons p (pop values)) env)) (&optional @@ -314,7 +315,7 @@ env)) (push (cons var (if values (pop values) - (eval-form init-form env))) + (eval-form init-form env))) env))) (&rest (push (cons p values) @@ -326,7 +327,7 @@ (present-p (not (null x))) (value (if present-p (cadr x) - (eval-form init-form env)))) + (eval-form init-form env)))) (when supplied-p-parameter (push (cons supplied-p-parameter present-p) @@ -341,9 +342,12 @@ (push (cons var (eval-form init-form env)) env))))) (t (error "Illegal destructuring pattern: ~S" pattern))) - (when (not (listp (cdr pp))) - (push (cons (cdr pp) values) - env))) + (when (not (listp (cdr pp))) + (push (cons (cdr pp) values) + env)) + finally + (when (and values (member state '(requireds optionals))) + (simple-program-error "Too many arguments."))) (if (and environment-p env-var) (cons (cons env-var env) env)

1 0

[movitz-cvs] CVS movitz/losp/muerte
by ffjeld 13 Apr '08

13 Apr '08

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory clnet:/tmp/cvs-serv5960 Modified Files: integers.lisp Log Message: Implement boole and friends. --- /project/movitz/cvsroot/movitz/losp/muerte/integers.lisp 2008/02/04 10:08:18 1.124 +++ /project/movitz/cvsroot/movitz/losp/muerte/integers.lisp 2008/04/13 08:21:40 1.125 @@ -9,7 +9,7 @@ ;;;; Created at: Wed Nov 8 18:44:57 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: integers.lisp,v 1.124 2008/02/04 10:08:18 ffjeld Exp $ +;;;; $Id: integers.lisp,v 1.125 2008/04/13 08:21:40 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -2248,8 +2248,7 @@ (numerator power-number))))) (defun floatp (x) - (declare (ignore x)) - nil) + (typep x 'real)) (defun realpart (number) number) @@ -2263,3 +2262,73 @@ (defun realp (x) (typep x 'real)) + +(defconstant boole-clr 'boole-clr) +(defconstant boole-1 'boole-1) +(defconstant boole-2 'boole-2) +(defconstant boole-c1 'boole-c1) +(defconstant boole-c2 'boole-c2) +(defconstant boole-eqv 'logeqv) +(defconstant boole-and 'logand) +(defconstant boole-nand 'lognand) +(defconstant boole-andc1 'logandc1) +(defconstant boole-andc2 'logandc2) +(defconstant boole-ior 'logior) +(defconstant boole-nor 'lognor) +(defconstant boole-orc1 'logorc1) +(defconstant boole-orc2 'logorc2) +(defconstant boole-xor 'logxor) +(defconstant boole-set 'boole-set) + +(defun boole (op integer-1 integer-2) + "=> result-integer" + (funcall op integer-1 integer-2)) + +(defun boole-clr (integer-1 integer-2) + (declare (ignore integer-1 integer-2)) + 0) + +(defun boole-set (integer-1 integer-2) + (declare (ignore integer-1 integer-2)) + -1) + +(defun boole-1 (integer-1 integer-2) + (declare (ignore integer-2)) + integer-1) + +(defun boole-2 (integer-1 integer-2) + (declare (ignore integer-1)) + integer-2) + +(defun logandc1 (integer-1 integer-2) + (logand (lognot integer-1) + integer-2)) + +(defun logandc2 (integer-1 integer-2) + (logand integer-1 + (lognot integer-2))) + +(defun boole-c1 (integer-1 integer-2) + (declare (ignore integer-2)) + (lognot integer-1)) + +(defun boole-c2 (integer-1 integer-2) + (declare (ignore integer-1)) + (lognot integer-2)) + +(defun logeqv (integer-1 integer-2) + (lognot (logxor integer-1 integer-2))) + +(defun lognand (integer-1 integer-2) + (lognot (logand integer-1 integer-2))) + +(defun lognor (integer-1 integer-2) + (lognot (logior integer-1 integer-2))) + +(defun logorc1 (integer-1 integer-2) + (logior (lognot integer-1) + integer-2)) + +(defun logorc2 (integer-1 integer-2) + (logior integer-1 + (lognot integer-2)))

1 0

[movitz-cvs] CVS movitz/losp/muerte
by ffjeld 12 Apr '08

12 Apr '08

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory clnet:/tmp/cvs-serv9517 Modified Files: defmacro-bootstrap.lisp Log Message: Fix handling of &whole in defmacro/run-time. --- /project/movitz/cvsroot/movitz/losp/muerte/defmacro-bootstrap.lisp 2008/04/12 16:23:28 1.2 +++ /project/movitz/cvsroot/movitz/losp/muerte/defmacro-bootstrap.lisp 2008/04/12 17:11:23 1.3 @@ -7,7 +7,7 @@ ;;;; Created at: Wed Nov 8 18:44:57 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: defmacro-bootstrap.lisp,v 1.2 2008/04/12 16:23:28 ffjeld Exp $ +;;;; $Id: defmacro-bootstrap.lisp,v 1.3 2008/04/12 17:11:23 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -36,6 +36,9 @@ (movitz::parse-docstring-declarations-and-body body 'cl:declare) (let* ((block-name (compute-function-block-name name)) (ignore-var (gensym)) + (whole-var (when (eq '&whole (car lambda-list)) + (list (pop lambda-list) + (pop lambda-list)))) (form-var (gensym "form-")) (env-var nil) (operator-var (gensym)) @@ -54,14 +57,27 @@ (values env-var nil) (let ((e (gensym))) (values e (list e)))) - `(make-named-function ,name - (&edx edx &optional ,form-var ,env-var &rest ,ignore-var) - ((ignore ,ignore-var ,@ignore-env)) - ,docstring - (block ,block-name - (verify-macroexpand-call edx ',name) - (destructuring-bind ,destructuring-lambda-list - ,form-var - (declare (ignore ,operator-var) ,@declarations) - ,@real-body)) - :type :macro-function))))) + (cond + ((and whole-var + (null lambda-list)) + `(make-named-function ,name + (&edx edx &optional ,form-var ,env-var &rest ,ignore-var) + ((ignore ,ignore-var ,@ignore-env)) + ,docstring + (block ,block-name + (verify-macroexpand-call edx ',name) + (let ((,(second whole-var) ,form-var)) + (declare ,@declarations) + ,@real-body)) + :type :macro-function)) + (t `(make-named-function ,name + (&edx edx &optional ,form-var ,env-var &rest ,ignore-var) + ((ignore ,ignore-var ,@ignore-env)) + ,docstring + (block ,block-name + (verify-macroexpand-call edx ',name) + (destructuring-bind ,(append whole-var destructuring-lambda-list) + ,form-var + (declare (ignore ,operator-var) ,@declarations) + ,@real-body)) + :type :macro-function)))))))

1 0

[movitz-cvs] CVS movitz/losp/muerte
by ffjeld 12 Apr '08

12 Apr '08

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory clnet:/tmp/cvs-serv3986 Modified Files: los-closette.lisp Log Message: Allow :method options to defgeneric. --- /project/movitz/cvsroot/movitz/losp/muerte/los-closette.lisp 2008/03/15 20:57:57 1.38 +++ /project/movitz/cvsroot/movitz/losp/muerte/los-closette.lisp 2008/04/12 16:47:21 1.39 @@ -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.38 2008/03/15 20:57:57 ffjeld Exp $ +;;;; $Id: los-closette.lisp,v 1.39 2008/04/12 16:47:21 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -32,10 +32,15 @@ ,@(canonicalize-defclass-options options env name))))) (defmacro defgeneric (function-name lambda-list &rest options) - `(eval-when (:compile-toplevel) - (movitz-ensure-generic-function ',function-name - :lambda-list ',lambda-list - ,@(canonicalize-defgeneric-options options)))) + `(progn + (eval-when (:compile-toplevel) + (movitz-ensure-generic-function ',function-name + :lambda-list ',lambda-list + ,@(canonicalize-defgeneric-options options))) + ,@(mapcan (lambda (option) + (when (eq :method (car option)) + (list `(defmethod ,function-name ,@(cdr option))))) + options))) (defmacro defmethod (&rest args &environment env) (multiple-value-bind (name qualifiers lambda-list specializers body declarations documentation)

1 0

[movitz-cvs] CVS movitz/losp/muerte
by ffjeld 12 Apr '08

12 Apr '08

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory clnet:/tmp/cvs-serv3964 Modified Files: los-closette-compiler.lisp Log Message: Allow :method options to defgeneric. --- /project/movitz/cvsroot/movitz/losp/muerte/los-closette-compiler.lisp 2007/03/13 20:42:42 1.21 +++ /project/movitz/cvsroot/movitz/losp/muerte/los-closette-compiler.lisp 2008/04/12 16:47:18 1.22 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Thu Aug 29 13:15:11 2002 ;;;; -;;;; $Id: los-closette-compiler.lisp,v 1.21 2007/03/13 20:42:42 ffjeld Exp $ +;;;; $Id: los-closette-compiler.lisp,v 1.22 2008/04/12 16:47:18 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -1009,6 +1009,7 @@ (:method-class (list ':method-class `(movitz-find-class ',(cadr option)))) + (:method nil) (t (list `',(car option) `',(cadr option))))) ;;; ensure-generic-function

1 0

[movitz-cvs] CVS movitz
by ffjeld 12 Apr '08

12 Apr '08

Update of /project/movitz/cvsroot/movitz In directory clnet:/tmp/cvs-serv3853 Modified Files: asm-x86.lisp Log Message: Allow t as a "catch all" operator for *instruction-compute-extra-prefix-map*. --- /project/movitz/cvsroot/movitz/asm-x86.lisp 2008/03/06 19:14:39 1.37 +++ /project/movitz/cvsroot/movitz/asm-x86.lisp 2008/04/12 16:46:48 1.38 @@ -6,7 +6,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: asm-x86.lisp,v 1.37 2008/03/06 19:14:39 ffjeld Exp $ +;;;; $Id: asm-x86.lisp,v 1.38 2008/04/12 16:46:48 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -1050,9 +1050,11 @@ (defun compute-extra-prefixes (operator pc size) - (let ((ff (assoc operator *instruction-compute-extra-prefix-map*))) - (when ff - (funcall (cdr ff) pc size)))) + (loop for (pattern . function) in *instruction-compute-extra-prefix-map* + when (or (eq pattern t) + (eq pattern operator)) + return (funcall function pc size))) + (defun encode-pc-rel (operator legacy-prefixes opcode operand type &rest extras) (when (typep operand '(or pc-relative-operand symbol-reference))

1 0

[movitz-cvs] CVS movitz
by ffjeld 12 Apr '08

12 Apr '08

Update of /project/movitz/cvsroot/movitz In directory clnet:/tmp/cvs-serv3703 Modified Files: compiler.lisp Log Message: Fix the %find-code-vector problem by adding NOP-prefixes in assemble-funobj. --- /project/movitz/cvsroot/movitz/compiler.lisp 2008/03/21 22:29:57 1.199 +++ /project/movitz/cvsroot/movitz/compiler.lisp 2008/04/12 16:46:05 1.200 @@ -8,7 +8,7 @@ ;;;; Created at: Wed Oct 25 12:30:49 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: compiler.lisp,v 1.199 2008/03/21 22:29:57 ffjeld Exp $ +;;;; $Id: compiler.lisp,v 1.200 2008/04/12 16:46:05 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -1004,11 +1004,12 @@ (assemble-funobj funobj combined-code)))) funobj) -(defun assemble-funobj (funobj combined-code) - (multiple-value-bind (code-vector code-symtab) +(defun assemble-funobj (funobj combined-code &key extra-prefix-computers) + (multiple-value-bind (code code-symtab) (let ((asm-x86:*cpu-mode* :32-bit) (asm:*instruction-compute-extra-prefix-map* - '((:call . compute-call-extra-prefix)))) + (append extra-prefix-computers + '((:call . compute-call-extra-prefix))))) (asm:assemble-proglist combined-code :symtab (list* (cons :nil-value (image-nil-word *image*)) (loop for (label . set) in (movitz-funobj-jumpers-map funobj) @@ -1016,50 +1017,66 @@ (* 4 (or (search set (movitz-funobj-const-list funobj) :end2 (movitz-funobj-num-jumpers funobj)) (error "Jumper for ~S missing." label)))))))) - (setf (movitz-funobj-symtab funobj) code-symtab) - (let* ((code-length (- (length code-vector) 3 -3)) - (code-vector (make-array code-length - :initial-contents code-vector - :fill-pointer t))) - (setf (fill-pointer code-vector) code-length) - ;; debug info - (setf (ldb (byte 1 5) (slot-value funobj 'debug-info)) - 1 #+ignore (if use-stack-frame-p 1 0)) - (let ((x (cdr (assoc 'start-stack-frame-setup code-symtab)))) - (cond - ((not x) - #+ignore (warn "No start-stack-frame-setup label for ~S." name)) - ((<= 0 x 30) - (setf (ldb (byte 5 0) (slot-value funobj 'debug-info)) x)) - (t (warn "Can't encode start-stack-frame-setup label ~D into debug-info for ~S." - x (movitz-funobj-name funobj))))) - (let* ((a (or (cdr (assoc 'entry%1op code-symtab)) 0)) - (b (or (cdr (assoc 'entry%2op code-symtab)) a)) - (c (or (cdr (assoc 'entry%3op code-symtab)) b))) - (unless (<= a b c) - (warn "Weird code-entries: ~D, ~D, ~D." a b c)) - (unless (<= 0 a 255) - (break "entry%1: ~D" a)) - (unless (<= 0 b 2047) - (break "entry%2: ~D" b)) - (unless (<= 0 c 4095) - (break "entry%3: ~D" c))) - (loop for (entry-label slot-name) in '((entry%1op code-vector%1op) - (entry%2op code-vector%2op) - (entry%3op code-vector%3op)) - do (when (assoc entry-label code-symtab) - (let ((offset (cdr (assoc entry-label code-symtab)))) - (setf (slot-value funobj slot-name) - (cons offset funobj))))) - (check-locate-concistency code-vector) - (setf (movitz-funobj-code-vector funobj) - (make-movitz-vector (length code-vector) - :fill-pointer code-length - :element-type 'code - :initial-contents code-vector)))) + (let ((code-length (- (length code) 3 -3))) + (let ((locate-inconsistencies (check-locate-concistency code code-length))) + (when locate-inconsistencies + (when (rassoc 'compute-extra-prefix-locate-inconsistencies + extra-prefix-computers) + (error "~S failed to fix locate-inconsistencies. This should not happen." + 'compute-extra-prefix-locate-inconsistencies)) + (return-from assemble-funobj + (assemble-funobj funobj combined-code + :extra-prefix-computers (list (cons t (lambda (pc size) + (loop for bad-pc in locate-inconsistencies + when (<= pc bad-pc (+ pc size)) + return '(#x90))))))) + + (break "locate-inconsistencies: ~S" locate-inconsistencies))) + (setf (movitz-funobj-symtab funobj) code-symtab) + (let ((code-vector (make-array code-length + :initial-contents code + :fill-pointer t))) + (setf (fill-pointer code-vector) code-length) + ;; debug info + (setf (ldb (byte 1 5) (slot-value funobj 'debug-info)) + 1 #+ignore (if use-stack-frame-p 1 0)) + (let ((x (cdr (assoc 'start-stack-frame-setup code-symtab)))) + (cond + ((not x) + #+ignore (warn "No start-stack-frame-setup label for ~S." name)) + ((<= 0 x 30) + (setf (ldb (byte 5 0) (slot-value funobj 'debug-info)) x)) + (t (warn "Can't encode start-stack-frame-setup label ~D into debug-info for ~S." + x (movitz-funobj-name funobj))))) + (let* ((a (or (cdr (assoc 'entry%1op code-symtab)) 0)) + (b (or (cdr (assoc 'entry%2op code-symtab)) a)) + (c (or (cdr (assoc 'entry%3op code-symtab)) b))) + (unless (<= a b c) + (warn "Weird code-entries: ~D, ~D, ~D." a b c)) + (unless (<= 0 a 255) + (break "entry%1: ~D" a)) + (unless (<= 0 b 2047) + (break "entry%2: ~D" b)) + (unless (<= 0 c 4095) + (break "entry%3: ~D" c))) + (loop for (entry-label slot-name) in '((entry%1op code-vector%1op) + (entry%2op code-vector%2op) + (entry%3op code-vector%3op)) + do (when (assoc entry-label code-symtab) + (let ((offset (cdr (assoc entry-label code-symtab)))) + (setf (slot-value funobj slot-name) + (cons offset funobj))))) + (setf (movitz-funobj-code-vector funobj) + (make-movitz-vector (length code-vector) + :fill-pointer code-length + :element-type 'code + :initial-contents code-vector))))) funobj) (defun check-locate-concistency (code-vector) + "The run-time function muerte::%find-code-vector sometimes needs to find a code-vector by +searching through the machine-code for an object header signature. This function is to +make sure that no machine code accidentally forms such a header signature." (loop for x from 0 below (length code-vector) by 8 do (when (and (= (tag :basic-vector) (aref code-vector x)) (= (enum-value 'movitz-vector-element-type :code) (aref code-vector (1+ x))) @@ -1068,7 +1085,7 @@ (aref code-vector (+ x 2))) (= (ldb (byte 8 8) (length code-vector)) (aref code-vector (+ x 3)))))) - (break "Code-vector (length #x~X) can break %find-code-vector at ~D: #x~2,'0X~2,'0X ~2,'0X~2,'0X." + (break "Code-vector (length ~D) can break %find-code-vector at ~D: #x~2,'0X~2,'0X ~2,'0X~2,'0X." (length code-vector) x (aref code-vector (+ x 0)) (aref code-vector (+ x 1)) @@ -1076,6 +1093,22 @@ (aref code-vector (+ x 3))))) (values)) +(defun check-locate-concistency (code code-vector-length) + "The run-time function muerte::%find-code-vector sometimes needs to find a code-vector by +searching through the machine-code for an object header signature. This function is to +make sure that no machine code accidentally forms such a header signature." + (loop for (x0 x1 x2 x3) on code by (lambda (l) (nthcdr 8 l)) + for pc upfrom 0 by 8 + when (and (= x0 (tag :basic-vector)) + (= x1 (enum-value 'movitz-vector-element-type :code)) + (or (<= #x4000 code-vector-length) + (and (= x2 (ldb (byte 8 0) code-vector-length)) + (= x3 (ldb (byte 8 8) code-vector-length))))) + collect pc + and do (warn "Code-vector (length ~D) can break %find-code-vector at ~D: #x~2,'0X~2,'0X ~2,'0X~2,'0X." + code-vector-length + pc x0 x1 x2 x3))) + (defun make-2req (binding0 binding1 frame-map) (let ((location-0 (new-binding-location binding0 frame-map)) @@ -2730,9 +2763,9 @@ init-pc) (assert (instruction-is (first init-pc) :init-lexvar)) (destructuring-bind (init-binding &key init-with-register init-with-type - protect-registers protect-carry) + protect-registers protect-carry shared-reference-p) (cdr (first init-pc)) - (declare (ignore protect-registers protect-carry init-with-type)) + (declare (ignore protect-registers protect-carry init-with-type shared-reference-p)) (assert (eq binding init-binding)) (multiple-value-bind (load-instruction binding-destination distance) (loop for i in (cdr init-pc) as distance upfrom 0 @@ -3372,7 +3405,7 @@ 'integer)) (warn "ecx from ~S" binding))) (when (movitz-env-get (binding-name binding) 'ignore nil (binding-env binding)) - (break "The variable ~S is used even if it was declared ignored." + (warn "The variable ~S is used even if it was declared ignored." (binding-name binding))) (let ((binding (ensure-local-binding binding funobj)) (protect-registers (cons :edx protect-registers))) @@ -5938,7 +5971,8 @@ (cond ((not binding) (unless (movitz-env-get form 'special nil env) - (cerror "Compile like a special." "Undeclared variable: ~S." form)) + #+ignore (cerror "Compile like a special." "Undeclared variable: ~S." form) + (warn "Undeclared variable: ~S." form)) (compiler-values () :returns :eax :functional-p t

1 0

[movitz-cvs] CVS movitz
by ffjeld 12 Apr '08

12 Apr '08

Update of /project/movitz/cvsroot/movitz In directory clnet:/tmp/cvs-serv3258 Modified Files: image.lisp Log Message: Fix a buglet in comment-instruction. --- /project/movitz/cvsroot/movitz/image.lisp 2008/04/09 18:00:56 1.120 +++ /project/movitz/cvsroot/movitz/image.lisp 2008/04/12 16:43:49 1.121 @@ -9,7 +9,7 @@ ;;;; Created at: Sun Oct 22 00:22:43 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: image.lisp,v 1.120 2008/04/09 18:00:56 ffjeld Exp $ +;;;; $Id: image.lisp,v 1.121 2008/04/12 16:43:49 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -1287,6 +1287,7 @@ when (and funobj (typep operand 'asm:indirect-operand) (member :esi operand) + (= 2 (length operand)) (<= 12 (asm:indirect-operand-offset operand))) collect (format nil "~A" (nth (truncate (- (+ (asm:indirect-operand-offset operand) @@ -1703,7 +1704,9 @@ (movitz-read (rationalize expr))) (class (muerte::movitz-find-class (translate-program (class-name expr) - :cl :muerte.cl)))))))) + :cl :muerte.cl))) + (array ; XXX + (movitz-read nil))))))) ;;;

1 0

[movitz-cvs] CVS movitz
by ffjeld 12 Apr '08

12 Apr '08

Update of /project/movitz/cvsroot/movitz In directory clnet:/tmp/cvs-serv30230 Modified Files: storage-types.lisp Log Message: A bit of commenting. --- /project/movitz/cvsroot/movitz/storage-types.lisp 2008/04/02 20:47:09 1.63 +++ /project/movitz/cvsroot/movitz/storage-types.lisp 2008/04/12 16:26:56 1.64 @@ -9,7 +9,7 @@ ;;;; Created at: Sun Oct 22 00:22:43 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: storage-types.lisp,v 1.63 2008/04/02 20:47:09 ffjeld Exp $ +;;;; $Id: storage-types.lisp,v 1.64 2008/04/12 16:26:56 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -69,9 +69,13 @@ :other 6 :symbol 7 - ;; The lower 3 bits of these are significant in mysterious ways. + ;; The lower 2 bits of these are significant in mysterious ways. + ;; 10: Requires GC parsing. + ;; 00: Requires no GC parsing (all GC-safe lisp-vals). + ;; 11: Illegal/special values :basic-vector #x22 :defstruct #x2a + :basic-restart #x32 :funobj #x3a :bignum #x4a :ratio #x52 @@ -79,9 +83,7 @@ :std-instance #x40 :run-time-context #x62 :illegal #x13 - :infant-object #x23 - :basic-restart #x32 - ) + :infant-object #x23) (defconstant +fixnum-tags+ '(:even-fixnum :odd-fixnum)) (defparameter +scan-skip-word+ #x00000003)

1 0

← Newer
1
...
9
10
11
12
13
14
15
...
260
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