/[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.8 by camm, Wed Jun 29 21:53:20 2005 UTC revision 1.9 by camm, Fri Jul 8 06:02:47 2005 UTC
# Line 1  Line 1 
1    ;;-*-Lisp-*-
2  ;;; CMPCALL  Function call.  ;;; CMPCALL  Function call.
3  ;;;  ;;;
4  ;; Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa  ;; Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa
# Line 26  Line 27 
27    
28  (eval-when (compile eval)  (eval-when (compile eval)
29  (defmacro link-arg-p (x)  (defmacro link-arg-p (x)
30    `(let ((.u ,x))   `(or (is-global-arg-type ,x) (not (is-local-arg-type ,x)))))
      (not (member .u '(character boolean long-float short-float)))))  
 )  
31    
32  (defun fast-link-proclaimed-type-p (fname &optional args)  (defun fast-link-proclaimed-type-p (fname &optional args)
33    (and    (and
# Line 262  Line 261 
261             *do-tail-recursion*             *do-tail-recursion*
262             *tail-recursion-info*             *tail-recursion-info*
263             (eq (car *tail-recursion-info*) fname)             (eq (car *tail-recursion-info*) fname)
264             (member *exit*             (or (eq *exit* 'return)
265                     '(RETURN RETURN-FIXNUM RETURN-CHARACTER RETURN-SHORT-FLOAT                 (rassoc *exit* +return-alist+))
                             RETURN-LONG-FLOAT RETURN-OBJECT))  
266             (tail-recursion-possible)             (tail-recursion-possible)
267             (= (length args) (length (cdr *tail-recursion-info*))))             (= (length args) (length (cdr *tail-recursion-info*))))
268        (let* ((*value-to-go* 'trash)        (let* ((*value-to-go* 'trash)

Legend:
Removed from v.1.8  
changed lines
  Added in v.1.9

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