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

Diff of /gcl/cmpnew/gcl_cmptop.lsp

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

revision 1.22 by camm, Sat May 7 14:44:37 2005 UTC revision 1.23 by camm, Wed Jun 22 01:37:25 2005 UTC
# Line 638  Line 638 
638    (if (var-p x) (setq x (var-type x)))    (if (var-p x) (setq x (var-type x)))
639    (cond ((and x (subtypep x 'fixnum))    (cond ((and x (subtypep x 'fixnum))
640           1)           1)
641            ((and x (subtypep x 'integer))
642             2)
643          (t 0)))          (t 0)))
644    
645    
# Line 793  Line 795 
795      (t3defun-aux 't3defun-local-entry      (t3defun-aux 't3defun-local-entry
796                   (case (promoted-c-type (caddr inline-info))                   (case (promoted-c-type (caddr inline-info))
797                     (fixnum 'return-fixnum)                     (fixnum 'return-fixnum)
798                       (integer 'return-integer)
799                     (character 'return-character)                     (character 'return-character)
800                     (long-float 'return-long-float)                     (long-float 'return-long-float)
801                     (short-float 'return-short-float)                     (short-float 'return-short-float)
# Line 826  Line 829 
829               (setf (var-kind (car vl))               (setf (var-kind (car vl))
830                     (case (promoted-c-type (car types))                     (case (promoted-c-type (car types))
831                           (fixnum 'FIXNUM)                           (fixnum 'FIXNUM)
832                             (integer 'integer)
833                           (character 'CHARACTER)                           (character 'CHARACTER)
834                           (long-float 'LONG-FLOAT)                           (long-float 'LONG-FLOAT)
835                           (short-float 'SHORT-FLOAT)                           (short-float 'SHORT-FLOAT)
# Line 1821  Line 1825 
1825    
1826  (defun wt-cvars( &aux type )  (defun wt-cvars( &aux type )
1827    (dolist (v *c-vars*)    (dolist (v *c-vars*)
1828       (let ((t1 (if (consp v) (prog1 (car v) (setq v (cdr v))) t)))      (let ((t1 (if (consp v) (prog1 (car v) (setq v (cdr v))) t)))
1829         (cond ((eq type t1)(format *compiler-output2* " ,V~a" v))        (cond ((eq type t1)(format *compiler-output2* " ,V~a" v))
1830               (t (or (null type)              (t (or (null type)
1831                      (format *compiler-output2* ";"))                     (format *compiler-output2* ";"))
1832                  (setq type t1)                 (setq type t1)
1833                  (format *compiler-output2* " ~a V~a"                 (if (eq (promoted-c-type type) 'integer)
1834                                         (rep-type type) v)))                     (format *compiler-output2*  "IDECL1(V~a,V~abody,V~aalloc)" v v v)
1835         (cond ((eq type 'integer)                   (format *compiler-output2* " ~a V~a" (rep-type type) v))))))
1836                (format *compiler-output2* "= 0,V~aalloc" v)    (and *c-vars* (format *compiler-output2* ";"))
               ))  
        ))  
  (and *c-vars* (format *compiler-output2* ";"))  
1837   (unless (or (not *vcs-used*) (eql *cs* 0))   (unless (or (not *vcs-used*) (eql *cs* 0))
1838  ;        (format *compiler-output2* " object Vcs[~a]={Cnil" *cs*)  ;        (format *compiler-output2* " object Vcs[~a]={Cnil" *cs*)
1839  ;        (dotimes (temp (- *cs* 1) t) (format *compiler-output2* ",Cnil"))  ;        (dotimes (temp (- *cs* 1) t) (format *compiler-output2* ",Cnil"))
1840  ;        (format *compiler-output2* "};"))  ;        (format *compiler-output2* "};"))
1841           (format *compiler-output2* " object Vcs[~a];" *cs*))           (format *compiler-output2* " object Vcs[~a];" *cs*)))
   )  
1842    
1843    
1844    

Legend:
Removed from v.1.22  
changed lines
  Added in v.1.23

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