/[gcl]/gcl/cmpnew/gcl_cmplet.lsp
ViewVC logotype

Diff of /gcl/cmpnew/gcl_cmplet.lsp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.13 by camm, Wed Jun 29 04:18:24 2005 UTC revision 1.14 by camm, Fri Jul 8 06:02:47 2005 UTC
# Line 1  Line 1 
1    ;;-*-Lisp-*-
2  ;;; CMPLET  Let and Let*.  ;;; CMPLET  Let and Let*.
3  ;;;  ;;;
4  ;; Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa  ;; Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa
# Line 228  Line 229 
229                  ((eq (var-kind var) 'down)                  ((eq (var-kind var) 'down)
230                   (or (si::fixnump (var-loc var)) (wfs-error)))                   (or (si::fixnump (var-loc var)) (wfs-error)))
231                  (t (setf (var-ref var) (vs-push))))                  (t (setf (var-ref var) (vs-push))))
232          (case (var-kind var)          (if (member (var-kind var) +c-local-var-types+)
233            ((FIXNUM CHARACTER LONG-FLOAT SHORT-FLOAT INTEGER)              (push (list 'c2expr* (list 'var var nil) form)  initials)
234             (push (list 'c2expr* (list 'var var nil) form)  initials))          (case (car form)
           (otherwise  
             (case (car form)  
235                (LOCATION                (LOCATION
236                 (if (can-be-replaced var body)                 (if (can-be-replaced var body)
237                     (progn (setf (var-kind var) 'REPLACED)                     (progn (setf (var-kind var) 'REPLACED)
238                            (setf (var-loc var) (caddr form)))                            (setf (var-loc var) (caddr form)))
239                     (push (list var (caddr form)) bindings)))                   (push (list var (caddr form)) bindings)))
240                (VAR                (VAR
241                 (let ((var1 (caaddr form)))                 (let ((var1 (caaddr form)))
242                      (declare (object var1))                      (declare (object var1))
# Line 276  Line 275 
275                                      (list 'down (var-loc var)))                                      (list 'down (var-loc var)))
276                                     (t(push (list var) bindings)                                     (t(push (list var) bindings)
277                                      (list 'vs (var-ref var))))                                      (list 'vs (var-ref var))))
278                               form) initials))                               form) initials))))
279                )))          (when (eq (var-kind var) 'SPECIAL) (push (var-name var) prev-ss))))
         (when (eq (var-kind var) 'SPECIAL) (push (var-name var) prev-ss))  
         ))  
280    
281    (setq block-p (write-block-open (nreverse used-vars)))    (setq block-p (write-block-open (nreverse used-vars)))
282    
# Line 360  Line 357 
357               (push var used-vars))                       (push var used-vars))        
358             (cond (kind  (setf (var-kind var) kind)             (cond (kind  (setf (var-kind var) kind)
359                          (setf (var-loc var) (cs-push (var-type var) t))))                          (setf (var-loc var) (cs-push (var-type var) t))))
360          (if (member (var-kind var)          (if (member (var-kind var) +c-local-var-types+)
                     '(FIXNUM CHARACTER LONG-FLOAT SHORT-FLOAT INTEGER))  
361              nil              nil
362              (case (car form)              (case (car form)
363                (LOCATION                (LOCATION
# Line 406  Line 402 
402        ((null vl))        ((null vl))
403        (setq var (car vl))(setq form (car fl))        (setq var (car vl))(setq form (car fl))
404  ;      (print (list (var-kind var) (car form)))  ;      (print (list (var-kind var) (car form)))
405        (case        (cond
406         (var-kind var)         ((eq (var-kind var) 'replaced))
407         ((FIXNUM CHARACTER LONG-FLOAT SHORT-FLOAT OBJECT  INTEGER)         ((member (var-kind var) +c-local-var-types+)
408          (let ((*value-to-go* (list 'var var nil)))          (let ((*value-to-go* (list 'var var nil)))
409            (c2expr* form)))                (c2expr* form)))
        (REPLACED )  
410         (t         (t
411          (case          (case
412           (car form)           (car form)
# Line 446  Line 441 
441      (dolist**      (dolist**
442       (var vars)       (var vars)
443       (let ((kind (var-kind var)))       (let ((kind (var-kind var)))
444         (declare (object kind))         (when (or (eq kind 'object) (member kind +c-local-var-types+))
        (when (member kind '(FIXNUM CHARACTER LONG-FLOAT SHORT-FLOAT OBJECT  
                                    INTEGER))  
445               (wt-nl)               (wt-nl)
446               (unless block-p (wt "{") (setq block-p t))               (unless block-p (wt "{") (setq block-p t))
447               (wt-var-decl var)               (wt-var-decl var)

Legend:
Removed from v.1.13  
changed lines
  Added in v.1.14

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26