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

Diff of /gcl/cmpnew/gcl_cmpinline.lsp

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

revision 1.27 by camm, Wed Oct 5 15:22:35 2005 UTC revision 1.28 by camm, Sun Nov 6 18:07:35 2005 UTC
# Line 22  Line 22 
22    
23  (in-package 'compiler)  (in-package 'compiler)
24    
25    (import 'si::proclaimed-arg-types 'compiler)
26    (import 'si::proclaimed-return-type 'compiler)
27    (import 'si::proclaimed-function 'compiler)
28    
29    
30  ;;; Pass 1 generates the internal form  ;;; Pass 1 generates the internal form
31  ;;;     ( id  info-object . rest )  ;;;     ( id  info-object . rest )
32  ;;; for each form encountered.  ;;; for each form encountered.
# Line 445  Line 450 
450    (or (cdr (assoc (promoted-c-type type) +inline-types-alist+)) 'inline))    (or (cdr (assoc (promoted-c-type type) +inline-types-alist+)) 'inline))
451    
452  (defun get-inline-info (fname args return-type &aux x ii)  (defun get-inline-info (fname args return-type &aux x ii)
453    (and  (fast-link-proclaimed-type-p fname args)  ;  (and  (fast-link-proclaimed-type-p fname args)
454          (add-fast-link fname return-type args))  ;        (add-fast-link fname return-type args))
455    (setq args (mapcar #'(lambda (form) (info-type (cadr form))) args))    (setq args (mapcar #'(lambda (form) (info-type (cadr form))) args))
456    (when (if *safe-compile*    (when (if *safe-compile*
457              (setq x (get fname 'inline-safe))              (setq x (get fname 'inline-safe))
# Line 458  Line 463 
463          (dolist** (y x)          (dolist** (y x)
464            (when (setq ii (inline-type-matches fname y args return-type))            (when (setq ii (inline-type-matches fname y args return-type))
465                  (return-from get-inline-info ii))))                  (return-from get-inline-info ii))))
466    
467      (when  (fast-link-proclaimed-type-p fname args)
468        (add-fast-link fname return-type args))
469    
470    (dolist* (x *inline-functions*)    (dolist* (x *inline-functions*)
471          (when (and (eq (car x) fname)          (when (and (eq (car x) fname)
472                     (setq ii (inline-type-matches fname (cdr x) args return-type)))                     (setq ii (inline-type-matches fname (cdr x) args return-type)))
# Line 475  Line 484 
484                                 (wt "(VFUN_NARGS="(length l) ",")                                 (wt "(VFUN_NARGS="(length l) ",")
485                                 (wt-inline-loc x l)                                 (wt-inline-loc x l)
486                                 (wt ")")))))                                 (wt ")")))))
487    nil    nil)
   )  
488    
489  (defun inline-type-matches (fname inline-info arg-types return-type  (defun inline-type-matches (fname inline-info arg-types return-type
490                                          &aux (rts nil))                                          &aux (rts nil))

Legend:
Removed from v.1.27  
changed lines
  Added in v.1.28

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