From 540e4140f4dbc06960dfeac3e57ab02f8815ba88 Mon Sep 17 00:00:00 2001 From: jjgarcia Date: Thu, 16 Oct 2003 07:38:17 +0000 Subject: [PATCH] Forms are now stored as structures. --- src/cmp/cmpcall.lsp | 10 +++--- src/cmp/cmpenv.lsp | 2 +- src/cmp/cmpeval.lsp | 6 ++-- src/cmp/cmpfun.lsp | 4 +-- src/cmp/cmpinline.lsp | 51 ++++++++++++++-------------- src/cmp/cmplam.lsp | 7 ++-- src/cmp/cmplet.lsp | 29 ++++++++-------- src/cmp/cmpmac.lsp | 77 ++++++++++++++---------------------------- src/cmp/cmpmain.lsp | 6 ++-- src/cmp/cmpmulti.lsp | 7 ++-- src/cmp/cmpspecial.lsp | 12 +++---- src/cmp/cmptag.lsp | 13 ++++--- src/cmp/cmptop.lsp | 23 +++++++------ src/cmp/cmpvar.lsp | 8 ++--- 14 files changed, 116 insertions(+), 139 deletions(-) diff --git a/src/cmp/cmpcall.lsp b/src/cmp/cmpcall.lsp index 8f4920dbd..eaa2bb7b2 100644 --- a/src/cmp/cmpcall.lsp +++ b/src/cmp/cmpcall.lsp @@ -54,7 +54,7 @@ ;; Don't create closure boundary like in c1function ;; since funob is used in this same environment (let ((lambda-expr (c1lambda-expr (rest function)))) - (make-c1form 'LAMBDA (second lambda-expr) lambda-expr (next-cfun)))) + (make-c1form 'LAMBDA lambda-expr lambda-expr (next-cfun)))) ((and (consp function) (eq (first function) 'LAMBDA-BLOCK) (consp (rest function))) @@ -62,7 +62,7 @@ ;; since funob is used in this same environment (let* ((block-name (second function))) (let ((lambda-expr (c1lambda-expr (cddr function) block-name))) - (make-c1form 'LAMBDA (second lambda-expr) lambda-expr (next-cfun))))) + (make-c1form 'LAMBDA lambda-expr lambda-expr (next-cfun))))) (t (cmperr "Malformed function: ~A" fun)))) (defun c1funcall (args) @@ -85,13 +85,13 @@ (make-c1form* 'FUNCALL :args (c1funob fun) (c1args* arguments)))))) (defun c2funcall (funob args &optional loc narg - &aux (form (third funob))) + &aux (form (c1form-arg 0 funob))) ;; Usually, ARGS holds a list of forms, which are arguments to the ;; function. If, however, the arguments are on VALUES, ;; ARGS should be set to the symbol ARGS-PUSHED, and NARG to a location ;; containing the number of arguments. ;; LOC is the location of the function object (created by save-funob). - (case (first funob) + (case (c1form-name funob) (GLOBAL (c2call-global form args loc t narg)) (LOCAL (c2call-local form args narg)) (ORDINARY ;;; An ordinary expression. In this case, if @@ -283,7 +283,7 @@ temp)))) (ORDINARY (let* ((temp (make-temp-var)) (*destination* temp)) - (c2expr* (third funob)) + (c2expr* (c1form-arg 0 funob)) temp)) (otherwise (baboon)) )) diff --git a/src/cmp/cmpenv.lsp b/src/cmp/cmpenv.lsp index aa2ce9f4e..4878f1161 100644 --- a/src/cmp/cmpenv.lsp +++ b/src/cmp/cmpenv.lsp @@ -445,7 +445,7 @@ (*compiler-push-events* *compiler-push-events*) (dl (c1add-declarations decls))) (setq body (c1progn body)) - (make-c1form 'DECL-BODY (second body) dl body)))) + (make-c1form 'DECL-BODY body dl body)))) (put-sysprop 'decl-body 'c2 'c2decl-body) diff --git a/src/cmp/cmpeval.lsp b/src/cmp/cmpeval.lsp index 82c1af78a..56f963bbe 100644 --- a/src/cmp/cmpeval.lsp +++ b/src/cmp/cmpeval.lsp @@ -52,7 +52,7 @@ (let* ((forms (c1args* args)) (fun (c1form-arg 0 fd)) (return-type (or (get-local-return-type fun) 'T))) - (let ((arg-types (get-local-arg-types (third fd)))) + (let ((arg-types (get-local-arg-types fun))) ;; Add type information to the arguments. (when arg-types (let ((fl nil)) @@ -248,9 +248,9 @@ (cmpwarn "The type of the form ~s is not ~s." (fourth args) slot-type) (progn - (when (eq 'VAR (car y)) + (when (eq 'VAR (c1form-name y)) ;; it's a variable, propagate type - (setf (var-type (third y)) new-type)) + (setf (var-type (c1form-arg 0 y)) new-type)) (setf (c1form-type y) new-type)))) (make-c1form* 'SYS:STRUCTURE-SET :type (c1form-type y) :args x (add-symbol name) (third args) y)) diff --git a/src/cmp/cmpfun.lsp b/src/cmp/cmpfun.lsp index b797babe5..a7ecef2ba 100644 --- a/src/cmp/cmpfun.lsp +++ b/src/cmp/cmpfun.lsp @@ -61,9 +61,9 @@ (c1expr (first args)))) (if (or (endp args) (and (eq (c1form-name stream) 'VAR) - (member (var-kind (third stream)) '(GLOBAL SPECIAL)))) + (member (var-kind (c1form-arg 0 stream)) '(GLOBAL SPECIAL)))) (make-c1form* 'C2PRINC :args #\Newline - (if (endp args) nil (third stream)) + (if (endp args) nil (c1form-arg 0 stream)) stream) (c1call-global 'TERPRI args))) diff --git a/src/cmp/cmpinline.lsp b/src/cmp/cmpinline.lsp index 72597ebf8..cdf13b3fd 100644 --- a/src/cmp/cmpinline.lsp +++ b/src/cmp/cmpinline.lsp @@ -56,8 +56,8 @@ (var-changed-in-forms loc forms))) (let ((check-specials (or (eq kind 'SPECIAL) (eq kind 'GLOBAL)))) (dolist (form forms) - (when (or (member var (info-changed-vars (second form))) - (and check-specials (info-sp-change (second form)))) + (when (or (member var (c1form-changed-vars form)) + (and check-specials (c1form-sp-change form))) (return t))))))) ;;; Valid property names for open coded functions are: @@ -88,8 +88,9 @@ (defun inline-args (forms &optional types) (flet ((all-locations (args &aux (res t)) (dolist (arg args res) - (unless (member (car arg) '(LOCATION VAR SYS:STRUCTURE-REF - #+clos SYS:INSTANCE-REF) + (unless (member (c1form-name arg) + '(LOCATION VAR SYS:STRUCTURE-REF + #+clos SYS:INSTANCE-REF) :test #'eq) (setq res nil))))) @@ -97,11 +98,11 @@ (form) (locs)) ((endp forms) (nreverse locs)) (setq form (car forms)) - (case (car form) + (case (c1form-name form) (LOCATION - (push (list (c1form-type form) (third form)) locs)) + (push (list (c1form-type form) (c1form-arg 0 form)) locs)) (VAR - (let ((var (third form))) + (let ((var (c1form-arg 0 form))) (if (var-changed-in-forms var (cdr forms)) (let* ((var-rep-type (var-rep-type var)) (lcl (make-lcl-var :rep-type var-rep-type :type (var-type var)))) @@ -111,8 +112,8 @@ (push (list (c1form-type form) var) locs)))) (CALL-GLOBAL - (let* ((fname (third form)) - (args (fourth form)) + (let* ((fname (c1form-arg 0 form)) + (args (c1form-arg 1 form)) (return-type (c1form-type form)) (arg-locs (inline-args args)) (loc (inline-function fname arg-locs return-type))) @@ -167,9 +168,9 @@ (push (list type (list 'SYS:STRUCTURE-REF (first (coerce-locs - (inline-args (list (third form))))) - (fourth form) - (fifth form))) + (inline-args (list (c1form-arg 0 form))))) + (c1form-arg 1 form) + (c1form-arg 2 form))) locs)))) #+clos (SYS:INSTANCE-REF @@ -182,18 +183,18 @@ (push (list type (list 'SYS:INSTANCE-REF (first (coerce-locs - (inline-args (list (third form))))) - (fourth form) - #+nil (fifth form))) ; JJGR + (inline-args (list (c1form-arg 0 form))))) + (c1form-arg 1 form) + #+nil (c1form-arg 2 form))) ; JJGR locs)))) (SETQ - (let ((vref (third form)) - (form1 (fourth form))) + (let ((vref (c1form-arg 0 form)) + (form1 (c1form-arg 1 form))) (let ((*destination* vref)) (c2expr* form1)) - (if (eq (car form1) 'LOCATION) - (push (list (c1form-type form1) (third form1)) locs) + (if (eq (c1form-name form1) 'LOCATION) + (push (list (c1form-type form1) (c1form-arg 0 form1)) locs) (setq forms (list* nil ; discarded at iteration - (make-c1form 'VAR (second form) vref) + (make-c1form 'VAR form vref) (cdr forms)) )))) @@ -307,14 +308,14 @@ ((or res (endp forms)) res) (let ((form (car forms))) (declare (object form)) - (case (car form) + (case (c1form-name form) (LOCATION) (VAR - (when (var-changed-in-forms (third form) (cdr forms)) + (when (var-changed-in-forms (c1form-arg 0 form) (cdr forms)) (setq res t))) (CALL-GLOBAL - (let ((fname (third form)) - (args (fourth form))) + (let ((fname (c1form-arg 0 form)) + (args (c1form-arg 1 form))) (when (or (not (inline-possible fname)) (null (setq ii (get-inline-info fname @@ -325,7 +326,7 @@ (need-to-protect args)) (setq res t)))) (SYS:STRUCTURE-REF - (when (need-to-protect (list (third form))) + (when (need-to-protect (list (c1form-arg 0 form))) (setq res t))) (t (setq res t))))) ) diff --git a/src/cmp/cmplam.lsp b/src/cmp/cmplam.lsp index 61f1ea852..4313ea70f 100644 --- a/src/cmp/cmplam.lsp +++ b/src/cmp/cmplam.lsp @@ -306,8 +306,8 @@ (var (second kwd)) (init (third kwd)) (flag (fourth kwd))) - (cond ((and (eq (car init) 'LOCATION) - (null (third init))) + (cond ((and (eq (c1form-name init) 'LOCATION) + (null (c1form-arg 0 init))) ;; no initform ;; Cnil has been set in keyvars if keyword parameter is not supplied. (setf (second KEYVARS[i]) i) @@ -379,7 +379,7 @@ (defun c1dm (macro-name vl body &aux (whole nil) (env nil) - (vnames nil) (dm-info (make-info)) (dm-vars nil) + (vnames nil) (dm-vars nil) (setjmps *setjmps*) ; Beppe doc ss is ts other-decls ppn) @@ -507,7 +507,6 @@ (check-vdecl vnames ts is) (setq body (c1decl-body other-decls body)) (unless (eql setjmps *setjmps*) - (setf (info-volatile dm-info) t) (put-sysprop macro-name 'CONTAINS-SETJMP t)) (dolist (v dm-vars) (check-vref v)) diff --git a/src/cmp/cmplet.lsp b/src/cmp/cmplet.lsp index 3ebb2119a..ce6793ac9 100644 --- a/src/cmp/cmplet.lsp +++ b/src/cmp/cmplet.lsp @@ -113,14 +113,15 @@ continue)) (defun update-var-type (var type x) - (when (listp x) - (if (and (eq (car x) 'VAR) - (eq var (third x))) - (setf (c1form-type x) - ;; some occurrences might be typed with 'the' - (type-and (c1form-type x) type)) - (dolist (e x) - (update-var-type var type e))))) + (cond ((consp x) + (dolist (e x) + (update-var-type var type e))) + ((not (c1form-p x))) + ((eq (c1form-name x) 'VAR) + (when (eq var (c1form-arg 0 x)) + (setf (c1form-type x) (type-and (c1form-type x) type)))) + (t + (update-var-type var type (c1form-args x))))) ;(defun read-only-variable-p (v l) (eq 'READ-ONLY (cdr (assoc v l)))) @@ -179,10 +180,10 @@ (LOCATION (if (can-be-replaced var body) (setf (var-kind var) 'REPLACED - (var-loc var) (third form)) - (push (cons var (third form)) bindings))) + (var-loc var) (c1form-arg 0 form)) + (push (cons var (c1form-arg 0 form)) bindings))) (VAR - (let* ((var1 (third form))) + (let* ((var1 (c1form-arg 0 form))) (cond ((or (var-changed-in-forms var1 (cdr fl)) (and (member (var-kind var1) '(SPECIAL GLOBAL)) (member (var-name var1) prev-ss))) @@ -369,9 +370,9 @@ (LOCATION (when (can-be-replaced* var body (cdr fl)) (setf (var-kind var) 'REPLACED - (var-loc var) (third form)))) + (var-loc var) (c1form-arg 0 form)))) (VAR - (let* ((var1 (third form))) + (let* ((var1 (c1form-arg 0 form))) (declare (type var var1)) (when (and (can-be-replaced* var body (cdr fl)) (member (var-kind var1) '(LEXICAL REPLACED :OBJECT)) @@ -426,7 +427,7 @@ (last-form (car (last (first args))))) ((LET LET* FLET LABELS BLOCK CATCH) (last-form (car (last args)))) - (VAR (first x)) + (VAR (c1form-arg 0 x)) (t x)))) (and (not (form-causes-side-effect form)) (or (< (var-ref var) 1) diff --git a/src/cmp/cmpmac.lsp b/src/cmp/cmpmac.lsp index f0c88f061..3117114e3 100644 --- a/src/cmp/cmpmac.lsp +++ b/src/cmp/cmpmac.lsp @@ -61,8 +61,24 @@ ;; C1-FORMS ;; -(defun make-c1form (name info &rest args) - (let ((form (list* name info args))) +(defstruct (c1form (:include info) + (:constructor do-make-c1form)) + (name nil) + (args '())) + +(defun make-c1form (name subform &rest args) + (let ((form (do-make-c1form :name name :args args + :changed-vars (info-changed-vars subform) + :referred-vars (info-referred-vars subform) + :type (info-type subform) + :sp-change (info-sp-change subform) + :volatile (info-volatile subform) + :local-referred (info-local-referred subform)))) + (c1form-add-info form args) + form) + #+nil + (let ((form (do-make-c1form :name name :args args))) + (add-info form info) (c1form-add-info form args) form)) @@ -80,68 +96,23 @@ (t (setf info-args (list* key (second l) info-args) l (cdr l)))))) - (let ((form (list* name (apply #'make-info info-args) form-args))) + (let ((form (apply #'do-make-c1form :name name :args form-args + info-args))) (c1form-add-info form form-args) form))) (defun c1form-add-info (form dependents) (dolist (subform dependents form) (cond ((c1form-p subform) - (add-info (second form) (second subform) - (eql (c1form-name subform) 'FUNCTION))) + (add-info form subform (eql (c1form-name subform) 'FUNCTION))) ((consp subform) (c1form-add-info form subform))))) (defun c1form-add-info1 (form subform) - (add-info (second form) (second subform) - (eql (c1form-name subform) 'FUNCTION))) - -(defun c1form-args (form) - (cddr form)) - -(defun (setf c1form-args) (value form) - (setf (cddr form) value)) - -(defun c1form-p (form) - (and (consp form) - (consp (cdr form)) - (info-p (second form)))) - -(defun c1form-name (form) - (first form)) - -(defun (setf c1form-name) (value form) - (setf (first form) value)) - -(defmacro c1form-referred-vars (form) - `(info-referred-vars (second ,form))) - -(defmacro c1form-local-referred (form) - `(info-local-referred (second ,form))) - -(defmacro c1form-changed-vars (form) - `(info-changed-vars (second ,form))) - -(defun c1form-type (form) - (info-type (second form))) - -(defun (setf c1form-type) (value form) - (setf (info-type (second form)) value)) - -(defmacro c1form-sp-change (form) - `(info-sp-change (second ,form))) - -(defmacro c1form-volatile (form) - `(info-volatile (second ,form))) - -(defun c1form-volatile* (form) - (if (c1form-volatile form) "volatile " "")) + (add-info form subform (eql (c1form-name subform) 'FUNCTION))) (defun copy-c1form (form) - (let* ((info (copy-info (second form))) - (output (copy-list form))) - (setf (second output) info) - output)) + (copy-structure form)) (defmacro c1form-arg (nth form) (case nth @@ -149,3 +120,5 @@ (1 `(second (c1form-args ,form))) (otherwise `(nth ,nth (c1form-args ,form))))) +(defun c1form-volatile* (form) + (if (c1form-volatile form) "volatile " "")) diff --git a/src/cmp/cmpmain.lsp b/src/cmp/cmpmain.lsp index a4f229f92..25745c07b 100644 --- a/src/cmp/cmpmain.lsp +++ b/src/cmp/cmpmain.lsp @@ -224,12 +224,12 @@ int init_~A(cl_object cblock) (delete-file o-name) output-name)) +(defun build-fasl (&rest args) + (apply #'builder :fasl args)) + (defun build-program (&rest args) (apply #'builder :program args)) -(defun build-module (&rest args) - (apply #'builder :fasl args)) - (defun build-static-library (&rest args) (apply #'builder :static-library args)) diff --git a/src/cmp/cmpmulti.lsp b/src/cmp/cmpmulti.lsp index b915e9742..769515991 100644 --- a/src/cmp/cmpmulti.lsp +++ b/src/cmp/cmpmulti.lsp @@ -16,8 +16,7 @@ (check-args-number 'MULTIPLE-VALUE-CALL args 1) (cond ((endp (rest args)) (c1funcall args)) (t (setq funob (c1funob (first args))) - (setq info (copy-info (second funob))) - (make-c1form 'MULTIPLE-VALUE-CALL info funob (c1args* (rest args)))))) + (make-c1form 'MULTIPLE-VALUE-CALL funob funob (c1args* (rest args)))))) (defun c2multiple-value-call (funob forms) (let ((tot (make-lcl-var :rep-type :cl-index)) @@ -223,7 +222,9 @@ (dolist (v vars) (wt-label (first labels)) (pop labels) - (bind (third (default-init v)) v))) + ;; DEFAULT-INIT returns a LOCATION form, whose only argument + ;; is the location that we pass to BIND. + (bind (c1form-arg 0 (default-init v)) v))) (wt-label label)) ;; 6) Compile the body. If there are bindings of special variables, diff --git a/src/cmp/cmpspecial.lsp b/src/cmp/cmpspecial.lsp index 75adb4ba7..f4a9e5ae0 100644 --- a/src/cmp/cmpspecial.lsp +++ b/src/cmp/cmpspecial.lsp @@ -57,7 +57,7 @@ (setq symbols (nreverse symbols)) (setq values (nreverse values)) (setq args (progv symbols values (c1progn (cdr args)))) - (make-c1form 'COMPILER-LET (second args) symbols values args)) + (make-c1form 'COMPILER-LET args symbols values args)) (defun c2compiler-let (symbols values body) (progv symbols values (c2expr body))) @@ -85,35 +85,33 @@ (cmpck (endp (cdr fun)) "The lambda expression ~s is illegal." fun) (let* ((funob (c1lambda-expr (cdr fun))) - (info (second funob)) (closure (closure-p funob)) (body (cddr fun)) (fun (make-fun :name NIL :cfun (next-cfun) :closure closure))) (if closure - (make-c1form 'FUNCTION info 'CLOSURE funob fun) + (make-c1form 'FUNCTION funob 'CLOSURE funob fun) (progn (push (make-c1form* 'FUNCTION-CONSTANT :args funob fun) *top-level-forms*) - (make-c1form 'FUNCTION info 'CONSTANT funob fun))))) + (make-c1form 'FUNCTION funob 'CONSTANT funob fun))))) ((and (consp fun) (eq (car fun) 'LAMBDA-BLOCK)) (cmpck (endp (cdr fun)) "The lambda expression ~s is illegal." fun) (let* ((name (second fun)) (funob (c1lambda-expr (cddr fun) name)) - (info (second funob)) (closure (closure-p funob)) (fun (make-fun :name NIL :description name :cfun (next-cfun) :closure closure))) (if closure - (make-c1form 'FUNCTION info 'CLOSURE funob fun) + (make-c1form 'FUNCTION funob 'CLOSURE funob fun) (progn (push (make-c1form* 'FUNCTION-CONSTANT :args funob fun) *top-level-forms*) - (make-c1form 'FUNCTION info 'CONSTANT funob fun))))) + (make-c1form 'FUNCTION funob 'CONSTANT funob fun))))) (t (cmperr "The function ~s is illegal." fun))))) (defun c2function (kind funob fun) diff --git a/src/cmp/cmptag.lsp b/src/cmp/cmptag.lsp index 76b6edb76..dc5f3c30e 100644 --- a/src/cmp/cmptag.lsp +++ b/src/cmp/cmptag.lsp @@ -56,11 +56,14 @@ ;; then increment the var-ref slot. (labels ((add-reg1 (form) ;; increase the var-ref in FORM for all vars - (if (consp form) - (dolist (v form) - (add-reg1 v)) - (when (var-p form) - (incf (var-ref form) (the fixnum *reg-amount*))))) + (cond ((c1form-p form) + (dolist (v (c1form-args form)) + (add-reg1 v))) + ((consp form) + (dolist (v form) + (add-reg1 v))) + ((var-p form) + (incf (var-ref form) (the fixnum *reg-amount*))))) (jumps-to-p (clause tag-name) ;; Does CLAUSE have a go TAG-NAME in it? (cond ((c1form-p clause) diff --git a/src/cmp/cmptop.lsp b/src/cmp/cmptop.lsp index f67ea3bdd..d0e5f005e 100644 --- a/src/cmp/cmptop.lsp +++ b/src/cmp/cmptop.lsp @@ -74,7 +74,7 @@ (when form (emit-local-funs) (setq *funarg-vars* nil) - (let ((def (get-sysprop (car form) 'T3))) + (let ((def (get-sysprop (c1form-name form) 'T3))) (when def ;; new local functions get pushed into *local-funs* (apply def (c1form-args form)))) @@ -229,7 +229,7 @@ (setq lambda-expr (c1lambda-expr (cdr args) (si::function-block-name fname))) (unless (eql setjmps *setjmps*) - (setf (info-volatile (second lambda-expr)) t)) + (setf (c1form-volatile lambda-expr) t)) (multiple-value-bind (decl body doc) (si::process-declarations (cddr args) nil) (cond ((and (assoc 'si::c-local decl) *allow-c-local-declaration*) @@ -242,7 +242,7 @@ (and (symbolp fname) (get-sysprop fname 'PROCLAIMED-FUNCTION) - (let ((lambda-list (third lambda-expr))) + (let ((lambda-list (c1form-arg 0 lambda-expr))) (declare (list lambda-list)) (and (null (second lambda-list)) ; no optional (null (third lambda-list)) ; no rest @@ -342,9 +342,9 @@ (setq *funarg-vars* funarg-vars) (when *compile-print* (print-emitting fname)) (when lambda-expr ; Not sharing code. - (setq lambda-list (third lambda-expr) + (setq lambda-list (c1form-arg 0 lambda-expr) requireds (car lambda-list)) - (analyze-regs (info-referred-vars (second lambda-expr))) + (analyze-regs (c1form-referred-vars lambda-expr)) (if (setq inline-info (assoc fname *inline-functions* :test #'same-fname-p)) @@ -391,7 +391,7 @@ (*unwind-exit* *unwind-exit*)) (wt-nl1 "{") (wt-function-prolog nil 'LOCAL-ENTRY) - (c2lambda-expr lambda-list (third (cddr lambda-expr)) cfun fname + (c2lambda-expr lambda-list (c1form-arg 2 lambda-expr) cfun fname nil 'LOCAL-ENTRY) (wt-nl1 "}") (wt-function-epilogue))) @@ -425,7 +425,7 @@ (wt-nl1 "{") (wt-function-prolog sp) - (c2lambda-expr lambda-list (third (cddr lambda-expr)) cfun fname) + (c2lambda-expr lambda-list (c1form-arg 2 lambda-expr) cfun fname) (wt-nl1 "}") (wt-function-epilogue))))) @@ -733,7 +733,7 @@ &aux (level (fun-level fun)) (nenvs level) (*volatile* (c1form-volatile* lambda-expr)) - (lambda-list (third lambda-expr)) + (lambda-list (c1form-arg 0 lambda-expr)) (requireds (car lambda-list)) (va_args (or (second lambda-list) (third lambda-list) @@ -762,7 +762,7 @@ (wt-h1 ");") (wt ")") - (analyze-regs (info-referred-vars (second lambda-expr))) + (analyze-regs (c1form-referred-vars lambda-expr)) (let* ((*lcl* 0) (*temp* 0) (*max-temp* 0) (*lex* 0) (*max-lex* 0) (*env* (fun-env fun)) ; continue growing env @@ -786,7 +786,7 @@ ;; parameter of this closure ;; (not yet bound, therefore var-loc is OBJECT) (eq (var-loc x) 'OBJECT))) - (info-local-referred (second lambda-expr))))) + (c1form-local-referred lambda-expr)))) (setq clv-used (sort clv-used #'> :key #'var-loc)) (when clv-used (wt-nl "{cl_object scan=env0;") @@ -800,7 +800,8 @@ (unless bs (return)) (when (plusp n) (wt " scan=CDR(scan);"))) (wt "}")))) - (c2lambda-expr (third lambda-expr) (third (cddr lambda-expr)) + (c2lambda-expr (c1form-arg 0 lambda-expr) + (c1form-arg 2 lambda-expr) (fun-cfun fun) (fun-name fun) (fun-closure fun)) (wt-nl1 "}") diff --git a/src/cmp/cmpvar.lsp b/src/cmp/cmpvar.lsp index 1289c5a6a..08d66e03f 100644 --- a/src/cmp/cmpvar.lsp +++ b/src/cmp/cmpvar.lsp @@ -320,8 +320,8 @@ (defun c2setq (vref form) (let ((*destination* vref)) (c2expr* form)) - (if (eq (car form) 'LOCATION) - (c2location (third form)) + (if (eq (c1form-name form) 'LOCATION) + (c2location (c1form-arg 0 form)) (unwind-exit vref)) ) @@ -413,8 +413,8 @@ form (car forms)) (if (or (var-changed-in-forms var (cdr forms)) (var-referred-in-forms var (cdr forms))) - (case (car form) - (LOCATION (push (cons var (third form)) saves)) + (case (c1form-name form) + (LOCATION (push (cons var (c1form-arg 0 form)) saves)) (otherwise (if (local var) (let* ((rep-type (var-rep-type var))