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

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

05 Feb '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv11936 Modified Files: compiler.lisp Log Message: Changed ensure-pass1-funobj definition and usage, now utilizing init-args. Date: Thu Feb 5 06:02:39 2004 Author: ffjeld Index: movitz/compiler.lisp diff -u movitz/compiler.lisp:1.15 movitz/compiler.lisp:1.16 --- movitz/compiler.lisp:1.15 Thu Feb 5 05:45:20 2004 +++ movitz/compiler.lisp Thu Feb 5 06:02:39 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.15 2004/02/05 10:45:20 ffjeld Exp $ +;;;; $Id: compiler.lisp,v 1.16 2004/02/05 11:02:39 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -178,23 +178,25 @@ (= 1 (length optional-vars)) (null key-vars) (not rest-var)) - 'make-compiled-function-pass1) + 'make-compiled-function-pass1-1req1opt) (t 'make-compiled-function-pass1)) name lambda-list declarations form env top-level-p funobj)))) (defun ensure-pass1-funobj (funobj class &rest init-args) "If funobj is nil, return a fresh funobj of class. Otherwise coerce funobj to class." - (if funobj - (apply #'change-class funobj class init-args) - (apply #'make-instance class init-args))) + (apply #'reinitialize-instance + (if funobj + (change-class funobj class) + (make-instance class)) + init-args)) (defun make-compiled-function-pass1-numarg-case (name lambda-list declarations form env top-level-p funobj) - (let* ((funobj (ensure-pass1-funobj funobj 'movitz-funobj-pass1-numargs-case)) + (let* ((funobj (ensure-pass1-funobj funobj 'movitz-funobj-pass1-numargs-case + :name name + :lambda-list (movitz-read (lambda-list-simplify lambda-list)))) (funobj-env (make-local-movitz-environment env funobj :type 'funobj-env))) - (setf (movitz-funobj-name funobj) name - (movitz-funobj-lambda-list funobj) (movitz-read (lambda-list-simplify lambda-list)) - (funobj-env funobj) funobj-env + (setf (funobj-env funobj) funobj-env (function-envs funobj) nil) (loop for (numargs lambda-list . clause-body) in (cdr (caddr form)) do (when (duplicatesp lambda-list) @@ -232,7 +234,9 @@ "Returns funobj." (when (duplicatesp lambda-list) (error "There are duplicates in lambda-list ~S." lambda-list)) - (let* ((funobj (ensure-pass1-funobj funobj 'movitz-funobj-pass1)) + (let* ((funobj (ensure-pass1-funobj funobj 'movitz-funobj-pass1 + :name name + :lambda-list (movitz-read (lambda-list-simplify lambda-list)))) (funobj-env (make-local-movitz-environment env funobj :type 'funobj-env)) (function-env (add-bindings-from-lambda-list lambda-list @@ -240,9 +244,7 @@ :type 'function-env :declaration-context :funobj :declarations declarations)))) - (setf (movitz-funobj-name funobj) name - (movitz-funobj-lambda-list funobj) (movitz-read (lambda-list-simplify lambda-list)) - (funobj-env funobj) funobj-env + (setf (funobj-env funobj) funobj-env (function-envs funobj) (list (cons 'muerte.cl::t function-env))) (multiple-value-bind (arg-init-code need-normalized-ecx-p) (make-function-arguments-init funobj function-env)

1 0

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

05 Feb '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv13337 Modified Files: compiler.lisp Log Message: Removed function make-compiled-function-body-pass1. Date: Thu Feb 5 05:45:20 2004 Author: ffjeld Index: movitz/compiler.lisp diff -u movitz/compiler.lisp:1.14 movitz/compiler.lisp:1.15 --- movitz/compiler.lisp:1.14 Wed Feb 4 11:14:42 2004 +++ movitz/compiler.lisp Thu Feb 5 05:45:20 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.14 2004/02/04 16:14:42 ffjeld Exp $ +;;;; $Id: compiler.lisp,v 1.15 2004/02/05 10:45:20 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -168,13 +168,13 @@ (multiple-value-bind (required-vars optional-vars rest-var key-vars) (decode-normal-lambda-list lambda-list) ;; There are several main branches through the function - ;; compiler, and this is where we decide which to take. + ;; compiler, and this is where we decide which one to take. (funcall (cond ((let ((sub-form (cddr form))) (and (consp (car sub-form)) (eq 'muerte::numargs-case (caar sub-form)))) 'make-compiled-function-pass1-numarg-case) - ((and (= 1 (length required-vars)) + ((and (= 1 (length required-vars)) ; (x &optional y) (= 1 (length optional-vars)) (null key-vars) (not rest-var)) @@ -201,21 +201,29 @@ (error "There are duplicates in lambda-list ~S." lambda-list)) (multiple-value-bind (clause-body clause-declarations) (parse-declarations-and-body clause-body) - (let ((function-env - (add-bindings-from-lambda-list lambda-list - (make-local-movitz-environment - funobj-env funobj - :type 'function-env - :declaration-context :funobj - :declarations - (append clause-declarations - declarations))))) - (make-compiled-function-body-pass1 funobj - function-env - (list* 'muerte.cl::block - (compute-function-block-name name) - clause-body) - top-level-p) + (let* ((function-env + (add-bindings-from-lambda-list lambda-list + (make-local-movitz-environment + funobj-env funobj + :type 'function-env + :declaration-context :funobj + :declarations + (append clause-declarations + declarations)))) + (function-form (list* 'muerte.cl::block + (compute-function-block-name name) + clause-body))) + (multiple-value-bind (arg-init-code need-normalized-ecx-p) + (make-function-arguments-init funobj function-env) + (setf (extended-code function-env) + (append arg-init-code + (compiler-call #'compile-form + :form (make-special-funarg-shadowing function-env function-form) + :funobj funobj + :env function-env + :top-level-p top-level-p + :result-mode :function))) + (setf (need-normalized-ecx-p function-env) need-normalized-ecx-p)) (push (cons numargs function-env) (function-envs funobj))))) funobj)) @@ -236,22 +244,19 @@ (movitz-funobj-lambda-list funobj) (movitz-read (lambda-list-simplify lambda-list)) (funobj-env funobj) funobj-env (function-envs funobj) (list (cons 'muerte.cl::t function-env))) - (make-compiled-function-body-pass1 funobj function-env form top-level-p))) - -(defun make-compiled-function-body-pass1 (funobj function-env form top-level-p) - "Returns the funobj with its extended-code." - (compiler-values-bind (&code body-code) - (compiler-call #'compile-form - :form (make-special-funarg-shadowing function-env form) - :funobj funobj - :env function-env - :top-level-p top-level-p - :result-mode :function) (multiple-value-bind (arg-init-code need-normalized-ecx-p) (make-function-arguments-init funobj function-env) - (setf (extended-code function-env) (append arg-init-code body-code) - (need-normalized-ecx-p function-env) need-normalized-ecx-p) - funobj))) + (setf (need-normalized-ecx-p function-env) need-normalized-ecx-p) + (setf (extended-code function-env) + (append arg-init-code + (compiler-call #'compile-form + :form (make-special-funarg-shadowing function-env form) + :funobj funobj + :env function-env + :top-level-p top-level-p + :result-mode :function)))) + funobj)) + (defun make-compiled-funobj-pass2 (toplevel-funobj-pass1) "This is where second pass compilation for each top-level funobj begins."

1 0

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

04 Feb '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv31935 Modified Files: compiler.lisp Log Message: Factored out helper function ensure-pass1-funobj. Date: Wed Feb 4 11:14:42 2004 Author: ffjeld Index: movitz/compiler.lisp diff -u movitz/compiler.lisp:1.13 movitz/compiler.lisp:1.14 --- movitz/compiler.lisp:1.13 Wed Feb 4 11:01:14 2004 +++ movitz/compiler.lisp Wed Feb 4 11:14:42 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.13 2004/02/04 16:01:14 ffjeld Exp $ +;;;; $Id: compiler.lisp,v 1.14 2004/02/04 16:14:42 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -182,8 +182,15 @@ (t 'make-compiled-function-pass1)) name lambda-list declarations form env top-level-p funobj)))) +(defun ensure-pass1-funobj (funobj class &rest init-args) + "If funobj is nil, return a fresh funobj of class. +Otherwise coerce funobj to class." + (if funobj + (apply #'change-class funobj class init-args) + (apply #'make-instance class init-args))) + (defun make-compiled-function-pass1-numarg-case (name lambda-list declarations form env top-level-p funobj) - (let* ((funobj (or funobj (make-instance 'movitz-funobj-pass1-numargs-case))) + (let* ((funobj (ensure-pass1-funobj funobj 'movitz-funobj-pass1-numargs-case)) (funobj-env (make-local-movitz-environment env funobj :type 'funobj-env))) (setf (movitz-funobj-name funobj) name (movitz-funobj-lambda-list funobj) (movitz-read (lambda-list-simplify lambda-list)) @@ -204,11 +211,11 @@ (append clause-declarations declarations))))) (make-compiled-function-body-pass1 funobj - function-env - (list* 'muerte.cl::block - (compute-function-block-name name) - clause-body) - top-level-p) + function-env + (list* 'muerte.cl::block + (compute-function-block-name name) + clause-body) + top-level-p) (push (cons numargs function-env) (function-envs funobj))))) funobj)) @@ -217,7 +224,7 @@ "Returns funobj." (when (duplicatesp lambda-list) (error "There are duplicates in lambda-list ~S." lambda-list)) - (let* ((funobj (or funobj (make-instance 'movitz-funobj-pass1))) + (let* ((funobj (ensure-pass1-funobj funobj 'movitz-funobj-pass1)) (funobj-env (make-local-movitz-environment env funobj :type 'funobj-env)) (function-env (add-bindings-from-lambda-list lambda-list

1 0

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

04 Feb '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv32512 Modified Files: special-operators.lisp Log Message: Sync small edits. Date: Wed Feb 4 11:01:28 2004 Author: ffjeld Index: movitz/special-operators.lisp diff -u movitz/special-operators.lisp:1.5 movitz/special-operators.lisp:1.6 --- movitz/special-operators.lisp:1.5 Tue Feb 3 14:17:34 2004 +++ movitz/special-operators.lisp Wed Feb 4 11:01:26 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.5 2004/02/03 19:17:34 ffjeld Exp $ +;;;; $Id: special-operators.lisp,v 1.6 2004/02/04 16:01:26 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -259,7 +259,7 @@ (declare (ignore c)) (format *error-output* "~&;; In function ~S:~&" name)))) (let* ((*compiling-function-name* name) - (funobj (make-compiled-funobj name formals declarations body env nil nil))) + (funobj (make-compiled-funobj name formals declarations body env nil))) (setf (movitz-funobj-symbolic-name funobj) name) (setf (movitz-env-named-function name) funobj)))) (compiler-values ()))

1 0

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

04 Feb '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv21537 Modified Files: image.lisp Log Message: Sync small edits. Date: Wed Feb 4 11:01:21 2004 Author: ffjeld Index: movitz/image.lisp diff -u movitz/image.lisp:1.7 movitz/image.lisp:1.8 --- movitz/image.lisp:1.7 Tue Feb 3 14:18:43 2004 +++ movitz/image.lisp Wed Feb 4 11:01:21 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.7 2004/02/03 19:18:43 ffjeld Exp $ +;;;; $Id: image.lisp,v 1.8 2004/02/04 16:01:21 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -1469,7 +1469,7 @@ ,@toplevel-code (muerte::halt-cpu)) - nil t nil))) + nil t))) (defun mkasm-write-word-eax-ebx () (let ((loop-label (make-symbol "write-word-loop"))

1 0

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

04 Feb '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv4480 Modified Files: compiler.lisp Log Message: Sync small edits. Date: Wed Feb 4 11:01:16 2004 Author: ffjeld Index: movitz/compiler.lisp diff -u movitz/compiler.lisp:1.12 movitz/compiler.lisp:1.13 --- movitz/compiler.lisp:1.12 Wed Feb 4 10:25:15 2004 +++ movitz/compiler.lisp Wed Feb 4 11:01:14 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.12 2004/02/04 15:25:15 ffjeld Exp $ +;;;; $Id: compiler.lisp,v 1.13 2004/02/04 16:01:14 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -140,7 +140,7 @@ lambda-form) (coerce lambda-form 'function))) -(defun make-compiled-funobj (name lambda-list declarations form env top-level-p funobj) +(defun make-compiled-funobj (name lambda-list declarations form env top-level-p &key funobj) "Compiler entry-point for making a (lexically) top-level function." (handler-bind (((or warning error) (lambda (c)

1 0

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

04 Feb '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv13377 Modified Files: los-closette-compiler.lisp Log Message: Undo of last check-in to this file, really. Date: Wed Feb 4 10:29:25 2004 Author: ffjeld Index: movitz/losp/muerte/los-closette-compiler.lisp diff -u movitz/losp/muerte/los-closette-compiler.lisp:1.3 movitz/losp/muerte/los-closette-compiler.lisp:1.4 --- movitz/losp/muerte/los-closette-compiler.lisp:1.3 Wed Feb 4 10:25:33 2004 +++ movitz/losp/muerte/los-closette-compiler.lisp Wed Feb 4 10:29:25 2004 @@ -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.3 2004/02/04 15:25:33 ffjeld Exp $ +;;;; $Id: los-closette-compiler.lisp,v 1.4 2004/02/04 15:29:25 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -1581,7 +1581,7 @@ (translate-program lambda-list :cl :muerte.cl) (translate-program declarations :cl :muerte.cl) (translate-program (cons 'muerte.cl:progn body) :cl :muerte.cl) - nil nil nil)))) + nil nil)))) ;;; ;;; Bootstrap

1 0

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

04 Feb '04

Update of /project/movitz/cvsroot/movitz/losp/muerte In directory common-lisp.net:/tmp/cvs-serv15293 Modified Files: los-closette-compiler.lisp Log Message: More smallish rearrangement of compiler code, and some comments. Date: Wed Feb 4 10:25:33 2004 Author: ffjeld Index: movitz/losp/muerte/los-closette-compiler.lisp diff -u movitz/losp/muerte/los-closette-compiler.lisp:1.2 movitz/losp/muerte/los-closette-compiler.lisp:1.3 --- movitz/losp/muerte/los-closette-compiler.lisp:1.2 Mon Jan 19 06:23:46 2004 +++ movitz/losp/muerte/los-closette-compiler.lisp Wed Feb 4 10:25:33 2004 @@ -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.2 2004/01/19 11:23:46 ffjeld Exp $ +;;;; $Id: los-closette-compiler.lisp,v 1.3 2004/02/04 15:25:33 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -1578,10 +1578,10 @@ (multiple-value-bind (body declarations) (movitz::parse-docstring-declarations-and-body decl-doc-body 'cl:declare) (movitz::make-compiled-funobj name - (translate-program lambda-list :cl :muerte.cl) - (translate-program declarations :cl :muerte.cl) - (translate-program (cons 'muerte.cl:progn body) :cl :muerte.cl) - nil nil)))) + (translate-program lambda-list :cl :muerte.cl) + (translate-program declarations :cl :muerte.cl) + (translate-program (cons 'muerte.cl:progn body) :cl :muerte.cl) + nil nil nil)))) ;;; ;;; Bootstrap

1 0

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

04 Feb '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv7456 Modified Files: storage-types.lisp Log Message: More smallish rearrangement of compiler code, and some comments. Date: Wed Feb 4 10:25:28 2004 Author: ffjeld Index: movitz/storage-types.lisp diff -u movitz/storage-types.lisp:1.3 movitz/storage-types.lisp:1.4 --- movitz/storage-types.lisp:1.3 Mon Feb 2 08:09:26 2004 +++ movitz/storage-types.lisp Wed Feb 4 10:25:28 2004 @@ -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.3 2004/02/02 13:09:26 ffjeld Exp $ +;;;; $Id: storage-types.lisp,v 1.4 2004/02/04 15:25:28 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -820,6 +820,7 @@ :accessor movitz-funobj-symtab) (borrowed-bindings :initarg :borrowed-bindings + :initform nil :accessor borrowed-bindings) (function-envs :accessor function-envs)

1 0

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

04 Feb '04

Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv28514 Modified Files: special-operators-cl.lisp Log Message: More smallish rearrangement of compiler code, and some comments. Date: Wed Feb 4 10:25:23 2004 Author: ffjeld Index: movitz/special-operators-cl.lisp diff -u movitz/special-operators-cl.lisp:1.5 movitz/special-operators-cl.lisp:1.6 --- movitz/special-operators-cl.lisp:1.5 Tue Feb 3 14:17:30 2004 +++ movitz/special-operators-cl.lisp Wed Feb 4 10:25:23 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.5 2004/02/03 19:17:30 ffjeld Exp $ +;;;; $Id: special-operators-cl.lisp,v 1.6 2004/02/04 15:25:23 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------ @@ -887,7 +887,7 @@ (cadr name) lambda-declarations `(muerte.cl:progn ,@lambda-forms) - env nil nil))) + env nil))) (let ((lambda-binding (make-instance 'lambda-binding :name (gensym "anonymous-lambda-") :parent-funobj funobj @@ -950,7 +950,7 @@ (list* 'muerte.cl:block (compute-function-block-name flet-name) flet-body) - env nil nil))) + env nil))) do (movitz-env-add-binding flet-env flet-binding) collect `(:local-function-init ,flet-binding)))) (compiler-values-bind (&all body-values &code body-code) @@ -1057,7 +1057,7 @@ (compute-function-block-name labels-name) labels-body) labels-env nil - (function-binding-funobj labels-binding))) + :funobj (function-binding-funobj labels-binding))) collect `(:local-function-init ,labels-binding)))) (compiler-values-bind (&all body-values &code body-code) (compiler-call #'compile-implicit-progn

1 0