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

Diff of /gcl/cmpnew/gcl_cmpcall.lsp

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

revision 1.4 by camm, Thu Aug 5 22:17:17 2004 UTC revision 1.5 by camm, Fri Jan 7 17:58:33 2005 UTC
# Line 337  Line 337 
337    
338    
339  (defun add-fast-link (fname type args)  (defun add-fast-link (fname type args)
340    (let (link link-info (n (add-symbol fname)) vararg)    (let (link-info (n (add-symbol fname)) vararg)
341      (cond (type        (cond (type  
342             ;;should do some args checking in that case too.             ;;should do some args checking in that case too.
343             (let* (link-string tem argtypes             (let* (link-string tem argtypes
# Line 377  Line 377 
377                      (princ ")" st)                      (princ ")" st)
378                      )                      )
379                      )                      )
 ;             (print (list 'link-string link-string))  
 ;   (format t "~{~a~#[~:;,~]~}" '(1 2 3 4))  
 ; 1,2,3,4  
380    
381                (if vararg (setq link                ;; If link is bound above, closure is unprintable as is in its own environment
382                                          #'(lambda ( &rest l)                ;; enables tracing of inline-type-matches.  CM 20050106
383                  (let ((link (when vararg (lambda ( &rest l)
384                                              (wt "(VFUN_NARGS="(length l) ",")                                              (wt "(VFUN_NARGS="(length l) ",")
385                                              (wt-inline-loc link-string l)                                              (wt-inline-loc link-string l)
386                                              (wt ")"))))                                              (wt ")")))))
387                                                                              (push (list fname argtypes
388                (push (list fname argtypes                              (or (get fname 'proclaimed-return-type)
389                            (or (get fname 'proclaimed-return-type)                                  t)
390                                t)                              (flags side-effect-p allocates-new-storage)
391                            (flags side-effect-p allocates-new-storage)                              (or link link-string) 'link-call)
392                            (or link link-string) 'link-call)                        *inline-functions*))
                     *inline-functions*)  
393                (setq link-info (list fname (format nil "LI~d" n)                (setq link-info (list fname (format nil "LI~d" n)
394                                      (or (get fname 'proclaimed-return-type)                                      (or (get fname 'proclaimed-return-type)
395                                          t)                                          t)

Legend:
Removed from v.1.4  
changed lines
  Added in v.1.5

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