movitz-cvs

movitz-cvs@common-lisp.net

2595 discussions

[movitz-cvs] CVS movitz/losp/muerte
by ffjeld 26 Feb '07

26 Feb '07

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory clnet:/tmp/cvs-serv22556 Modified Files: eval.lisp Log Message: Added trivial constantp and macro-function. --- /project/movitz/cvsroot/movitz/losp/muerte/eval.lisp 2005/04/20 06:53:23 1.17 +++ /project/movitz/cvsroot/movitz/losp/muerte/eval.lisp 2007/02/26 18:22:27 1.18 @@ -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.17 2005/04/20 06:53:23 ffjeld Exp $ +;;;; $Id: eval.lisp,v 1.18 2007/02/26 18:22:27 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -444,3 +444,17 @@ ;; What do do? (warn "Unknown declaration: ~S" declaration) (values)) + + +(defun constantp (form &optional environment) + (typecase form + (boolean t) + (keyword t) + (symbol nil) + (cons (eq 'quote (car form))) + (t t))) + +(defun macro-function (symbol &optional environment) + "=> function" + (declare (ignore symbol environment)) + nil)

1 0

[movitz-cvs] CVS movitz/losp/muerte
by ffjeld 22 Feb '07

22 Feb '07

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory clnet:/tmp/cvs-serv19944 Modified Files: symbols.lisp Log Message: Added function remprop. --- /project/movitz/cvsroot/movitz/losp/muerte/symbols.lisp 2004/11/25 16:46:01 1.27 +++ /project/movitz/cvsroot/movitz/losp/muerte/symbols.lisp 2007/02/22 22:11:21 1.28 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Tue Sep 4 23:55:41 2001 ;;;; -;;;; $Id: symbols.lisp,v 1.27 2004/11/25 16:46:01 ffjeld Exp $ +;;;; $Id: symbols.lisp,v 1.28 2007/02/22 22:11:21 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -253,3 +253,6 @@ (declare (ignore default)) (setf (getf (symbol-plist symbol) indicator) value)) + +(defun remprop (symbol indicator) + (remf (symbol-plist symbol) indicator))

1 0

[movitz-cvs] CVS movitz/losp/muerte
by ffjeld 22 Feb '07

22 Feb '07

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory clnet:/tmp/cvs-serv15249 Modified Files: cons.lisp Log Message: Have tree-equal return singular value. --- /project/movitz/cvsroot/movitz/losp/muerte/cons.lisp 2006/05/06 20:30:53 1.16 +++ /project/movitz/cvsroot/movitz/losp/muerte/cons.lisp 2007/02/22 21:23:04 1.17 @@ -9,7 +9,7 @@ ;;;; Created at: Fri Dec 8 15:25:45 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: cons.lisp,v 1.16 2006/05/06 20:30:53 ffjeld Exp $ +;;;; $Id: cons.lisp,v 1.17 2007/02/22 21:23:04 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -265,7 +265,7 @@ (defun tree-equal (tree-1 tree-2 &key test test-not) (labels ((te (tree-1 tree-2 test) (if (not (consp tree-1)) - (funcall test tree-1 tree-2) + (values (funcall test tree-1 tree-2)) (if (not (consp tree-2)) nil (and (te (car tree-1) (car tree-2) test)

1 0

[movitz-cvs] CVS movitz/losp/muerte
by ffjeld 22 Feb '07

22 Feb '07

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory clnet:/tmp/cvs-serv13103 Modified Files: interrupt.lisp Log Message: Tweaks to exception-to-error mapping. --- /project/movitz/cvsroot/movitz/losp/muerte/interrupt.lisp 2007/02/19 20:24:54 1.53 +++ /project/movitz/cvsroot/movitz/losp/muerte/interrupt.lisp 2007/02/22 21:03:50 1.54 @@ -10,7 +10,7 @@ ;;;; Author: Frode Vatvedt Fjeld <frodef(a)acm.org> ;;;; Created at: Wed Apr 7 01:50:03 2004 ;;;; -;;;; $Id: interrupt.lisp,v 1.53 2007/02/19 20:24:54 ffjeld Exp $ +;;;; $Id: interrupt.lisp,v 1.54 2007/02/22 21:03:50 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -316,14 +316,22 @@ ((60) ;; EAX failed type in EDX. May be restarted by returning with a new value in EAX. (with-simple-restart (continue "Retry with a different value.") - (error 'type-error :datum (dereference $eax) :expected-type (dereference $edx))) + (error 'type-error + :datum (dereference $eax) + :expected-type (dereference $edx))) (format *query-io* "Enter a new value: ") (setf (dereference $eax) (read *query-io*))) - (61 (error 'type-error :datum (dereference $eax) :expected-type 'list)) + (61 (error 'type-error + :datum (dereference $eax) + :expected-type 'list)) (62 (error "Trying to save too many values: ~@Z." $ecx)) (63 (error "Primitive assertion error. EIP=~@Z, ESI=~@Z." $eip $esi)) - (64 (error 'type-error :datum (dereference $eax) :expected-type 'integer)) - (65 (error 'index-out-of-range :index (dereference $ebx) (dereference $ecx))) + (64 (error 'type-error + :datum (dereference $eax) + :expected-type 'integer)) + (65 (error 'index-out-of-range + :index (dereference $ebx) + :range (dereference $ecx))) (66 (error "Unspecified type error at ~@Z in ~S with EAX=~@Z, ECX=~@Z." $eip (dereference (+ dit-frame (dit-frame-index :esi))) $eax $ecx))

1 0

[movitz-cvs] CVS movitz/losp/muerte
by ffjeld 22 Feb '07

22 Feb '07

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory clnet:/tmp/cvs-serv13062 Modified Files: basic-macros.lisp Log Message: Tweak check-type compiler-macro to support retry restart. --- /project/movitz/cvsroot/movitz/losp/muerte/basic-macros.lisp 2007/02/20 23:11:22 1.68 +++ /project/movitz/cvsroot/movitz/losp/muerte/basic-macros.lisp 2007/02/22 21:03:10 1.69 @@ -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.68 2007/02/20 23:11:22 ffjeld Exp $ +;;;; $Id: basic-macros.lisp,v 1.69 2007/02/22 21:03:10 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -558,14 +558,16 @@ (t (if (member type '(standard-gf-instance function pointer atom integer fixnum positive-fixnum cons symbol character null list string vector simple-vector vector-u8 vector-u16)) - `(with-inline-assembly (:returns :nothing :labels (fail)) + `(with-inline-assembly (:returns :nothing :labels (check-type-failed retry-check-type)) + retry-check-type (:compile-form (:result-mode (:boolean-branch-on-false . check-type-failed)) (typep ,place ',type)) - (() () '(:sub-program (check-type-failed) (:int 66)))) - #+ignore - `(unless (typep ,place ',type) - (with-inline-assembly (:returns :non-local-exit) - (:int 66))) + (:jnever '(:sub-program (check-type-failed) + (:compile-form (:result-mode :edx) (quote ,type)) + (:compile-form (:result-mode :ignore) + (setf ,place (with-inline-assembly (:returns :eax) + (:int 60)))) + (:jmp 'retry-check-type)))) form)))) (defmacro assert (test-form &optional places datum-form &rest argument-forms)

1 0

[movitz-cvs] CVS movitz/losp/muerte
by ffjeld 22 Feb '07

22 Feb '07

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory clnet:/tmp/cvs-serv13001 Modified Files: arrays.lisp Log Message: Use :jnever assembly syntax. --- /project/movitz/cvsroot/movitz/losp/muerte/arrays.lisp 2006/05/05 18:14:41 1.59 +++ /project/movitz/cvsroot/movitz/losp/muerte/arrays.lisp 2007/02/22 21:02:09 1.60 @@ -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.59 2006/05/05 18:14:41 ffjeld Exp $ +;;;; $Id: arrays.lisp,v 1.60 2007/02/22 21:02:09 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -348,7 +348,8 @@ (:jmp (:esi (:ecx 4) 'basic-vector-dispatcher ,(bt:slot-offset 'movitz:movitz-funobj 'movitz::constant0))) - (() () '(:sub-program (unknown) (:int 100))) + (:jnever '(:sub-program (unknown) + (:int 100))) :u32 (:movl (:eax :ebx ,(bt:slot-offset 'movitz:movitz-basic-vector 'movitz::data)) :ecx)

1 0

[movitz-cvs] CVS movitz
by ffjeld 22 Feb '07

22 Feb '07

Update of /project/movitz/cvsroot/movitz In directory clnet:/tmp/cvs-serv12394 Modified Files: compiler.lisp Log Message: Fixed up layout-program and related functions a bit. Removed remnants of old &key parsing strategy. --- /project/movitz/cvsroot/movitz/compiler.lisp 2007/02/20 21:57:13 1.177 +++ /project/movitz/cvsroot/movitz/compiler.lisp 2007/02/22 21:00:21 1.178 @@ -8,7 +8,7 @@ ;;;; Created at: Wed Oct 25 12:30:49 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: compiler.lisp,v 1.177 2007/02/20 21:57:13 ffjeld Exp $ +;;;; $Id: compiler.lisp,v 1.178 2007/02/22 21:00:21 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -1484,7 +1484,7 @@ (new-program nil)) ((endp pc) (assert (not pending-subs) () - "pending subs: ~S" pending-subs) + "pending sub-programs: ~S" pending-subs) (nreverse new-program)) (let ((i (pop pc))) (multiple-value-bind (sub-prg sub-opts) @@ -2605,15 +2605,11 @@ (defclass supplied-p-function-argument (function-argument) ()) (defclass rest-function-argument (positional-function-argument) ()) -(defclass hidden-rest-function-argument (rest-function-argument) ()) (defclass keyword-function-argument (non-required-function-argument) ((keyword-name :initarg :keyword-name - :reader keyword-function-argument-keyword-name) - (rest-var-name - :initarg :rest-var-name - :reader keyword-function-argument-rest-var-name))) + :reader keyword-function-argument-keyword-name))) (defclass dynamic-binding (variable-binding) ()) @@ -2745,25 +2741,26 @@ ;;; -(defun instruction-sub-program (instruction) - "When an instruction contains a sub-program, return that program, and -the sub-program options (&optional label) as secondary value." - (and (consp instruction) - (consp (second instruction)) - (symbolp (car (second instruction))) - (string= 'quote (car (second instruction))) - (let ((x (second (second instruction)))) - (and (consp x) - (eq :sub-program (car x)) - (values (cddr x) - (second x)))))) - (defun ignore-instruction-prefixes (instruction) (if (and (consp instruction) (listp (car instruction))) (cdr instruction) instruction)) +(defun instruction-sub-program (instruction) + "When an instruction contains a sub-program, return that program, and +the sub-program options (&optional label) as secondary value." + (let ((instruction (ignore-instruction-prefixes instruction))) + (and (consp instruction) + (consp (second instruction)) + (symbolp (car (second instruction))) + (string= 'quote (car (second instruction))) + (let ((x (second (second instruction)))) + (and (consp x) + (eq :sub-program (car x)) + (values (cddr x) + (second x))))))) + (defun instruction-is (instruction &optional operator) (and (listp instruction) (if (member (car instruction) '(:globally :locally)) @@ -3205,7 +3202,6 @@ (binding-env binding) nil) (movitz-env-get variable 'ignorable nil (binding-env binding) nil) - (typep binding 'hidden-rest-function-argument) (third (gethash binding var-counts))) (warn "Unused variable: ~S" (binding-name binding)))) @@ -4410,11 +4406,6 @@ (movitz-env-add-binding env (make-instance 'rest-function-argument :name formal :argnum (post-incf arg-pos))))) -;;; (when key-vars-p -;;; ;; We need to check at run-time whether keyword checking is supressed or not. -;;; (setf (allow-other-keys-var env) -;;; (movitz-env-add-binding env (make-instance 'located-binding -;;; :name (gensym "allow-other-keys-var-"))))) (when key-vars-p (setf (key-vars-p env) t) (when (>= 1 (rest-args-position env)) @@ -4436,28 +4427,16 @@ (setf (movitz-env-get name 'ignore nil env) t)))) (setf (key-vars env) (loop for spec in key-vars - with rest-var-name = - (or rest-var - (and key-vars - (let ((name (gensym "hidden-rest-var-"))) - (movitz-env-add-binding env (make-instance 'hidden-rest-function-argument - :name name - :argnum (post-incf arg-pos))) - name))) collect (multiple-value-bind (formal keyword-name init-form supplied-p) (decode-keyword-formal spec) - (let ((formal - (shadow-when-special formal env)) - (supplied-p-parameter - (or supplied-p - #+ignore (gensym "supplied-p-")))) + (let ((formal (shadow-when-special formal env)) + (supplied-p-parameter supplied-p)) (movitz-env-add-binding env (make-instance 'keyword-function-argument :name formal 'init-form init-form 'supplied-p-var supplied-p-parameter - :keyword-name keyword-name - :rest-var-name rest-var-name)) + :keyword-name keyword-name)) (when supplied-p-parameter (movitz-env-add-binding env (make-instance 'supplied-p-function-argument :name (shadow-when-special supplied-p-parameter env)))) @@ -4830,12 +4809,6 @@ (optional-vars (optional-vars env)) (rest-var (rest-var env)) (key-vars (key-vars env))) - (when (and (not rest-var) - key-vars - (not (= 1 (length key-vars)))) - (setf rest-var - (keyword-function-argument-rest-var-name - (movitz-binding (decode-keyword-formal (first key-vars)) env)))) (values (append (loop for optional in optional-vars @@ -6753,9 +6726,8 @@ (cond ((typep binding 'rest-function-argument) (assert (eq :edx init-with-register)) - (assert (or (typep binding 'hidden-rest-function-argument) - (movitz-env-get (binding-name binding) - 'dynamic-extent nil (binding-env binding))) + (assert (movitz-env-get (binding-name binding) + 'dynamic-extent nil (binding-env binding)) () "&REST variable ~S must be dynamic-extent." (binding-name binding)) (setf (need-normalized-ecx-p (find-function-env (binding-env binding)

1 0

[movitz-cvs] CVS movitz/losp/muerte
by ffjeld 22 Feb '07

22 Feb '07

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory clnet:/tmp/cvs-serv8518 Modified Files: lists.lisp Log Message: Removed dead comment. --- /project/movitz/cvsroot/movitz/losp/muerte/lists.lisp 2007/02/22 20:27:31 1.20 +++ /project/movitz/cvsroot/movitz/losp/muerte/lists.lisp 2007/02/22 20:28:37 1.21 @@ -9,7 +9,7 @@ ;;;; Created at: Tue Dec 5 18:40:11 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: lists.lisp,v 1.20 2007/02/22 20:27:31 ffjeld Exp $ +;;;; $Id: lists.lisp,v 1.21 2007/02/22 20:28:37 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -243,9 +243,6 @@ (when (eq indicator (car p)) (return (cadr p))))) -;;;(defun (setf getf) (value plist indicator &optional default) -;;; (error "Must be implemented as a macro..")) - (defsetf getf (plist indicator &optional default) (new-value) `(do ((p ,plist (cddr p))) ((null p)

1 0

[movitz-cvs] CVS movitz/losp/muerte
by ffjeld 22 Feb '07

22 Feb '07

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory clnet:/tmp/cvs-serv8464 Modified Files: lists.lisp Log Message: Tweaked make-list. --- /project/movitz/cvsroot/movitz/losp/muerte/lists.lisp 2007/02/20 23:11:44 1.19 +++ /project/movitz/cvsroot/movitz/losp/muerte/lists.lisp 2007/02/22 20:27:31 1.20 @@ -9,7 +9,7 @@ ;;;; Created at: Tue Dec 5 18:40:11 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: lists.lisp,v 1.19 2007/02/20 23:11:44 ffjeld Exp $ +;;;; $Id: lists.lisp,v 1.20 2007/02/22 20:27:31 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -232,10 +232,10 @@ (setf (cdr new-tail) (cons (pop more-objects) nil))))))) (defun make-list (size &key initial-element) - (check-type size positive-fixnum) (do ((list nil (cons initial-element list)) - (c size (1- c))) - ((<= c 0) list))) + (c (check-the positive-fixnum size) (1- c))) + ((<= c 0) list) + (declare (positive-fixnum c)))) (defun getf (plist indicator &optional default) (do ((p plist (cddr p)))

1 0

[movitz-cvs] CVS movitz/losp/muerte
by ffjeld 20 Feb '07

20 Feb '07

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory clnet:/tmp/cvs-serv8445 Modified Files: lists.lisp Log Message: Have make-list check that the list-size is an integer. --- /project/movitz/cvsroot/movitz/losp/muerte/lists.lisp 2006/05/06 20:30:54 1.18 +++ /project/movitz/cvsroot/movitz/losp/muerte/lists.lisp 2007/02/20 23:11:44 1.19 @@ -9,7 +9,7 @@ ;;;; Created at: Tue Dec 5 18:40:11 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: lists.lisp,v 1.18 2006/05/06 20:30:54 ffjeld Exp $ +;;;; $Id: lists.lisp,v 1.19 2007/02/20 23:11:44 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -232,6 +232,7 @@ (setf (cdr new-tail) (cons (pop more-objects) nil))))))) (defun make-list (size &key initial-element) + (check-type size positive-fixnum) (do ((list nil (cons initial-element list)) (c size (1- c))) ((<= c 0) list)))

1 0

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