← Back to branch summary

~ubuntu-branches/ubuntu/intrepid/ecl/intrepid

« back to all changes in this revision

Viewing changes to src/cmp/cmpeval.lsp

  • Committer: Bazaar Package Importer
  • Author(s): Albin Tonnerre
  • Date: 2008-06-20 18:00:19 UTC
  • mfrom: (1.1.4 upstream)
  • Revision ID: james.westby@ubuntu.com-20080620180019-7fbz1ln5444vtkkr
Tags: 0.9j-20080306-2ubuntu1
* Enabled unicode support. (Closes: LP #123530)
* Modify Maintainer value to match the DebianMaintainerField specification.

Show diffs side-by-side

added added

removed removed

Lines of Context:
src/cmp/cmpeval.lsp
 
1
;;;;  -*- Mode: Lisp; Syntax: Common-Lisp; Package: C -*-
 
2
;;;;
1
3
;;;; CMPEVAL --  The Expression Dispatcher.
2
4
 
3
5
;;;;  Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
85
87
      (let ((l (length args)))
86
88
        (when (> l si::c-arguments-limit)
87
89
          (return-from c1call-local
88
 
            (c1expr `(with-stack
89
 
                      ,@(loop for i in args collect `(stack-push ,i))
90
 
                      (apply-from-stack ,l #',fname))))))
 
90
            (let ((frame (gensym)))
 
91
              (c1expr `(with-stack ,frame
 
92
                         ,@(loop for i in args collect `(stack-push ,i))
 
93
                         (si::apply-from-stack-frame ,frame #',fname)))))))
91
94
      (let* ((forms (c1args* args))
92
95
             (lambda-form (fun-lambda fun))
93
96
             (return-type (or (get-local-return-type fun) 'T))
109
112
(defun c1call-global (fname args)
110
113
  (let ((l (length args)))
111
114
    (if (> l si::c-arguments-limit)
112
 
        (c1expr `(with-stack
113
 
                  ,@(loop for i in args collect `(stack-push ,i))
114
 
                  (apply-from-stack ,l #',fname)))
 
115
        (c1expr (let ((frame (gensym)))
 
116
                  `(with-stack ,frame
 
117
                     ,@(loop for i in args collect `(stack-push ,frame ,i))
 
118
                     (si::apply-from-stack-frame ,frame #',fname))))
115
119
        (let* ((forms (c1args* args))
116
120
               (return-type (propagate-types fname forms args)))
117
121
          (make-c1form* 'CALL-GLOBAL