/[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.1 by camm, Sun Sep 14 02:30:33 2003 UTC revision 1.2 by camm, Sun Sep 14 02:43:01 2003 UTC
# Line 0  Line 1 
1    ;;; CMPCALL  Function call.
2    ;;;
3    ;; Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa
4    
5    ;; This file is part of GNU Common Lisp, herein referred to as GCL
6    ;;
7    ;; GCL is free software; you can redistribute it and/or modify it under
8    ;;  the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by
9    ;; the Free Software Foundation; either version 2, or (at your option)
10    ;; any later version.
11    ;;
12    ;; GCL is distributed in the hope that it will be useful, but WITHOUT
13    ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
14    ;; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Library General Public
15    ;; License for more details.
16    ;;
17    ;; You should have received a copy of the GNU Library General Public License
18    ;; along with GCL; see the file COPYING.  If not, write to the Free Software
19    ;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
20    
21    
22    (in-package 'compiler)
23    
24    (defvar *ifuncall* nil)
25    
26    
27    (eval-when (compile eval)
28    (defmacro link-arg-p (x)
29      `(let ((.u ,x))
30         (not (member .u '(character boolean long-float short-float)))))
31    )
32    
33    (defun fast-link-proclaimed-type-p (fname &optional args)
34      (and
35           (symbolp fname)
36           (and (< (the fixnum(length args)) 64)
37                (or  (and (get fname 'fixed-args)
38                          (listp args))
39                     (and
40                      (get fname 'proclaimed-function)
41                      (link-arg-p (get fname 'proclaimed-return-type))
42                      (dolist (v (get fname 'proclaimed-arg-types) t)
43                              (or  (eq v '*)(link-arg-p v) (return nil))))))))
44    
45    (si::putprop 'funcall 'c2funcall-aux 'wholec2)
46    (si:putprop 'call-lambda 'c2call-lambda 'c2)
47    (si:putprop 'call-global 'c2call-global 'c2)
48    
49    ;;Like macro-function except it searches the lexical environment,
50    ;;to determine if the macro is shadowed by a function or a macro.
51    (defun cmp-macro-function (name &aux fd)
52      (cond ((setq fd (c1local-fun name))
53             (if (eq (car fd) 'call-local) nil  fd))
54            (t (macro-function name))))
55    
56    (defun c1funob (fun &aux fd)
57      ;;; NARGS is the number of arguments.  If the number is unknown, (e.g.
58      ;;; in case of APPLY), then NARGS should be NIL.
59      (cond ((and (consp fun)
60                  (symbolp (car fun))
61                  (cmp-macro-function (car fun)))
62             (setq fun (cmp-macroexpand fun))))
63      (or
64       (and
65        (consp fun)
66        (or (and (eq (car fun) 'quote)
67                 (not (endp (cdr fun)))
68                 (endp (cddr fun))
69                 (or (and (consp (cadr fun))
70                          (not (endp (cdadr fun)))
71                          (eq (caadr fun) 'lambda)
72                          (let ((*vars* nil) (*funs* nil) (*blocks* nil)
73                                             (*tags* nil))
74                               (let ((lambda-expr (c1lambda-expr (cdadr fun))))
75                                    (list 'call-lambda (cadr lambda-expr)
76                                          lambda-expr))))
77                     (and (symbolp (cadr fun))
78                          (or (and (setq fd (c1local-fun (cadr fun)))
79                                   (eq (car fd) 'call-local)
80                                   fd)
81                              (list 'call-global
82                                    (make-info
83                                     :sp-change
84                                     (null (get (cadr fun) 'no-sp-change)))
85                                    (cadr fun)))
86                          )))
87            (and (eq (car fun) 'function)
88                 (not (endp (cdr fun)))
89                 (endp (cddr fun))
90                 (or (and (consp (cadr fun))
91                          (eq (caadr fun) 'lambda)
92                          (not (endp (cdadr fun)))
93                          (let ((lambda-expr (c1lambda-expr (cdadr fun))))
94                               (list 'call-lambda (cadr lambda-expr) lambda-expr))
95                          )
96                     (and (symbolp (cadr fun))
97                          (or (and (setq fd (c1local-fun (cadr fun)))
98                                   (eq (car fd) 'call-local)
99                                   fd)
100                              (list 'call-global
101                                    (make-info
102                                     :sp-change
103                                     (null (get (cadr fun) 'no-sp-change)))
104                                    (cadr fun)))
105                          )))))
106       (let ((x (c1expr fun)) (info (make-info :sp-change t)))
107            (add-info info (cadr x))
108            (list 'ordinary info x))
109       ))
110    
111    
112    (defun c2funcall-aux(form &aux  (info (cadr form))
113                           (funob (caddr form))
114                           (args (cadddr form))
115                           (loc (nth 4 form)))
116      (c2funcall funob args loc info))
117    
118    (defvar  *use-sfuncall* t)
119    (defvar *super-funcall* nil)
120    
121    (defun c2funcall (funob args &optional loc info)
122    
123      ;;; Usually, ARGS holds a list of forms, which are arguments to the
124      ;;; function.  If, however, the arguments are already pushed on the stack,
125      ;;; ARGS should be set to the symbol ARGS-PUSHED.
126      (case (car funob)
127        (call-global (c2call-global (caddr funob) args loc t))
128        (call-local (c2call-local (cddr funob) args))
129        (call-lambda (c2call-lambda (caddr funob) args))
130        (ordinary           ;;; An ordinary expression.  In this case, if
131                            ;;; arguments are already pushed on the stack, then
132                            ;;; LOC cannot be NIL.  Callers of C2FUNCALL must be
133                            ;;; responsible for maintaining this condition.
134          (let ((*vs* *vs*) (form (caddr funob)))
135               (declare (object form))
136               (cond ((and (listp args)
137                           *use-sfuncall*
138                           ;;Determine if only one value at most is required:
139                           (or
140                            (eq *value-to-go* 'trash)
141                            (and (consp *value-to-go*)
142                                 (eq (car *value-to-go*) 'var))
143                            (and info (equal (info-type info) '(values t)))
144                            ))
145                      (c2funcall-sfun form args info)
146                      (return-from c2funcall nil)))
147               (unless loc
148                 (unless (listp args) (baboon))
149                 (cond ((eq (car form) 'LOCATION) (setq loc (caddr form)))
150                       ((and (eq (car form) 'VAR)
151                             (not (args-info-changed-vars (caaddr form) args)))
152                        (setq loc (cons 'VAR (caddr form))))
153                       (t
154                        (setq loc (list 'vs (vs-push)))
155                        (let ((*value-to-go* loc)) (c2expr* (caddr funob))))))
156               (push-args args)
157               (if *compiler-push-events*
158                   (wt-nl "super_funcall(" loc ");")
159                 (if *super-funcall*
160                     (funcall *super-funcall* loc)
161                   (wt-nl "super_funcall_no_event(" loc ");")))
162               (unwind-exit 'fun-val)))
163        (otherwise (baboon))
164        ))
165    
166    
167    (defun fcalln-inline (&rest args &aux (f (car args)) length)
168      (wt #\()
169      (unless (and (consp f) (eq (car f) 'var))
170              (setq f (list 'cvar (cs-push)))
171              (wt-nl f " = " (car args) ","))
172       (wt-nl "(type_of(" f ") == t_sfun ?"
173    ;         "(*(object (*)())((" f ")->sfn.sfn_self)):")
174              "(*((" f ")->sfn.sfn_self)):")
175       (when (< *space* 3)
176             (setq length t)
177             (wt-nl "(fcall.argd="  (length (cdr args)) ",type_of("f")==t_vfun) ?")
178    ;        (wt-nl  "(*(object (*)())((" f ")->sfn.sfn_self)):"))
179             (wt-nl  "(*((" f ")->sfn.sfn_self)):"))
180       (wt-nl  "(fcall.fun=(" f "),")
181       (unless length
182               (wt "fcall.argd="  (length (cdr args)) ","))
183       (wt   "fcalln))(")
184       (when (cdr args) (wt (cadr args))
185             (dolist (loc (cddr args)) (wt #\, loc)))
186       (wt #\) #\)  ))
187    
188    (defun c2call-lambda (lambda-expr args &aux (lambda-list (caddr lambda-expr)))
189      (declare (object lambda-list))
190      (cond ((or (cadr lambda-list)         ;;; Has optional?
191                 (caddr lambda-list)        ;;; Has rest?
192                 (cadddr lambda-list)       ;;; Has key?
193                 (not (listp args))         ;;; Args already pushed?
194                 )
195             (when (listp args)             ;;; Args already pushed?
196               (let ((*vs* *vs*) (base *vs*))
197                    (push-args-lispcall args)
198                    (when (need-to-set-vs-pointers lambda-list)
199                      (wt-nl "vs_top=(vs_base=base+" base ")+" (- *vs* base) ";")
200                      (base-used)
201                      )))
202             (c2lambda-expr lambda-list (caddr (cddr lambda-expr)))
203             )
204            (t
205             (let ((l-length (length (car lambda-list)))
206                   (a-length (length args)))
207               (or (eql a-length l-length)
208                 (cmperr "Calling lambda with ~a args not ~a" a-length
209                         l-length)))
210                  
211             (c2let (car lambda-list) args (caddr (cddr lambda-expr)))))
212      )
213    
214    (defun check-fname-args (fname args)
215      (let ((a (get fname 'arg-types t)))
216        (and (eq t a) (get fname 'si::structure-access)
217             (setq a '(t)))
218        (cond ((and (listp a)
219                    (listp args)
220                    (not (member '* a)))
221               (or (eql (length a) (length args))
222                       (cmpwarn "Wrong number of args for ~s: ~a instead of ~a."
223                                fname
224                                (length args) (length a)))))))
225    
226    (defun save-avma (fd)
227      (when (and (not *restore-avma*)
228                 (setq *restore-avma*
229                     (or
230                      (member 'integer (car fd))
231                      (eq (cadr fd) 'integer)
232                      (flag-p (caddr fd) is))))
233        (wt-nl "{ save_avma;")
234        (inc-inline-blocks)
235        (or (consp *inline-blocks*)
236            (setq *inline-blocks* (cons  *inline-blocks* 'restore-avma)))))
237    
238        
239        
240    
241    
242    (defun c2call-global (fname args loc return-type &aux fd (*vs* *vs*))
243    ;this is now done in get-inline-info
244    ;  (and  *Fast-link-compiling* (fast-link-proclaimed-type-p fname args)
245    ;        (add-fast-link fname t args))
246      (if (inline-possible fname)
247        (cond
248         ;;; Tail-recursive case.
249         ((and (listp args)
250               *do-tail-recursion*
251               *tail-recursion-info*
252               (eq (car *tail-recursion-info*) fname)
253               (member *exit*
254                       '(RETURN RETURN-FIXNUM RETURN-CHARACTER RETURN-SHORT-FLOAT
255                                RETURN-LONG-FLOAT RETURN-OBJECT))
256               (tail-recursion-possible)
257               (= (length args) (length (cdr *tail-recursion-info*))))
258          (let* ((*value-to-go* 'trash)
259                 (*exit* (next-label))
260                 (*unwind-exit* (cons *exit* *unwind-exit*)))
261                (c2psetq (mapcar #'(lambda (v) (list v nil))
262                                 (cdr *tail-recursion-info*))
263                         args)
264                (wt-label *exit*))
265          (unwind-no-exit 'tail-recursion-mark)
266          (wt-nl "goto TTL;")
267          (cmpnote "Tail-recursive call of ~s was replaced by iteration." fname))
268    
269         ;;; Open-codable function call.
270         ((and (listp args)
271               (null loc)
272               (setq fd (get-inline-info fname args return-type)))
273          (let ((*inline-blocks* 0)
274                (*restore-avma*  *restore-avma*))
275            (save-avma fd)
276            (unwind-exit (get-inline-loc fd args) nil fname)
277            (close-inline-blocks)))
278    
279         ;;; Call to a function whose C language function name is known.
280         ((setq fd (or (get fname 'Lfun) (get fname 'Ufun)))
281          (check-fname-args fname args)
282          (push-args args)
283          (wt-nl fd "();")
284          (unwind-exit 'fun-val nil fname)
285          )
286    
287         ( t; *Fast-link-compiling*
288          (cond ((and
289                          (listp args)
290                  (< (the fixnum (length args)) 10)
291                  (or
292                       *ifuncall*
293                       (get fname 'ifuncall))
294                          (progn (if (eq *value-to-go* 'top) (format t "~%Called with top:~a" fname)) t)
295                          (not (eq 'top *value-to-go*))
296                      (null loc)
297                      )
298                 (let ((*inline-blocks* 0))
299                   (unwind-exit (get-inline-loc  (inline-proc fname args) args)
300                                nil fname)
301                   (close-inline-blocks)))
302                (t
303                 (push-args args)
304                 (let ((num (add-fast-link fname nil args)))
305                   (wt-nl "(void) (*Lnk" num  ")(")
306                   (if (get fname 'proclaimed-closure) (wt "Lclptr" num))
307                   (wt  ");")
308                   (unwind-exit 'fun-val nil fname)))))
309    
310    
311         ;;; Call to a function defined in the same file.
312         ((setq fd (assoc fname *global-funs*))
313          (push-args args)
314          (wt-nl "L" (cdr fd) "();")
315          (unwind-exit 'fun-val nil fname)
316          )
317         ((eql fname 'funcall-c)
318          (wt-funcall-c args))
319    
320         ;;; Otherwise.
321         (t (c2call-unknown-global fname args loc t)))
322        (c2call-unknown-global fname args loc nil))
323      )
324    
325    
326    
327    (defun add-fast-link (fname type args)
328      (let (link link-info (n (add-symbol fname)) vararg)
329        (cond (type  
330               ;;should do some args checking in that case too.
331               (let* (link-string tem argtypes
332                          (leng (and (listp args) (length args))))
333                 (setq argtypes
334                       (cond ((get fname 'proclaimed-function)
335                              (get fname 'proclaimed-arg-types))
336                             ((setq tem (get fname ' fixed-args))
337                              (cond ((si:fixnump tem)
338                                     (or (equal leng tem)
339                                       (cmpwarn "~a: Fixed args not fixed!"
340                                                fname)))
341                                    (t (setf (get fname 'fixed-args) leng)))
342                              (make-list leng :initial-element t))))
343                 (and leng
344                      (or (eql leng  (length argtypes))
345                          (MEMBER '* ARGTYPES)
346                          (cmpwarn "~a called with ~a args, expected ~a "
347                                   fname leng
348                                   (length argtypes))))
349                 (unless
350                  (cddr (setq link-info (assoc fname *function-links*)))
351                  (setq link-string
352                        (with-output-to-string
353                         (st)
354                        (format st  "(*(LnkLI~d))(" n)
355                        (do ((com)
356                             (v argtypes (cdr v))
357                             (i 0 (+ 1 i)))
358                            ((null v))
359                            (cond ((eq (car v) '*)
360                                   (setq vararg t)
361                                   (princ "#*"  st))
362                                  (t
363                                   (if com  (princ "," st) (setq com t))
364                                   (format st "#~a" i))))
365                        (princ ")" st)
366                        )
367                        )
368    ;             (print (list 'link-string link-string))
369    ;   (format t "~{~a~#[~:;,~]~}" '(1 2 3 4))
370    ; 1,2,3,4
371    
372                  (if vararg (setq link
373                                            #'(lambda ( &rest l)
374                                                (wt "(VFUN_NARGS="(length l) ",")
375                                                (wt-inline-loc link-string l)
376                                                (wt ")"))))
377                                                              
378                  (push (list fname argtypes
379                              (or (get fname 'proclaimed-return-type)
380                                  t)
381                              (flags side-effect-p allocates-new-storage)
382                              (or link link-string) 'link-call)
383                        *inline-functions*)
384                  (setq link-info (list fname (format nil "LI~d" n)
385                                        (or (get fname 'proclaimed-return-type)
386                                            t)
387                                         argtypes)))))
388              (t      
389               (check-fname-args fname args)
390               (setq link-info (list fname n
391                                     (if (get fname 'proclaimed-closure) 'proclaimed-closure)
392                                     ))))
393        (pushnew link-info    *function-links* :test 'equal)
394        n))
395    
396    (defun declaration-type (type)
397      (cond ((equal type "") "void")
398            ((equal type "long ") "object ")
399            (t type)))
400    
401    ;;make a function which will be called hopefully only once,
402    ;;and will establish the link.
403    (defun wt-function-link (x)
404      (let ((name (first x))
405            (num (second x))
406            (type (third x))
407            (args (fourth x)))
408        (cond
409          ((null type)
410           (wt-nl1 "static void LnkT"
411                   num "(){ call_or_link(VV[" num "],(void **)(void *)&Lnk" num");}"
412                   ))
413          ((eql type 'proclaimed-closure)
414           (wt-nl1 "static void LnkT" num
415                   "(ptr) object *ptr;{ call_or_link_closure(VV[" num "],(void **)(void *)&Lnk" num",(void **)(void *)&Lclptr" num");}"))
416          (t
417           ;;change later to include above.
418           ;;(setq type (cdr (assoc type '((t . "object")(:btpr . "bptr")))))
419           (wt-nl1 "static " (declaration-type (rep-type type)) " LnkT" num )
420           (cond ((or args (not (eq t type)))
421                  (let ((vararg (member '* args)))
422                    (wt "(object first,...){"
423                        (declaration-type (rep-type type)) "V1;"
424                        "va_list ap;va_start(ap,first);V1=call_"
425                        (if vararg "v" "") "proc_new(VV["
426                        (add-object name)"],(void **)(void *)&Lnk" num )
427                    (or vararg (wt "," (proclaimed-argd args type)))
428                    (wt   ",first,ap);va_end(ap);return V1;}" )))
429                 (t (wt "(){return call_proc0(VV[" (add-object name)
430                        "],(void **)(void *)&Lnk" num ");}" ))))
431          (t (error "unknown link type ~a" type)))
432        (setq name (symbol-name name))
433        (if (find #\/ name) (setq name (remove #\/ name)))
434        (wt " /* " name " */")
435        ))
436          
437    
438    
439    ;;For funcalling when the argument is guaranteed to be a compiled-function.
440    ;;For (funcall-c he 3 4), he being a compiled function. (not a symbol)!
441    (defun wt-funcall-c (args)
442      (let ((fun (car args))
443            (real-args (cdr args))
444            loc)
445        (cond ((eql (car fun) 'var)
446               (let ((fun-loc (cons (car fun) (third fun))))
447                 (when *safe-compile*
448                       (wt-nl "(type_of(")
449                       (wt-loc fun-loc)
450                       (wt ")==t_cfun)||FEinvalid_function(")
451                       (wt-loc fun-loc)(wt ");"))
452               (push-args real-args)
453               (wt-nl "(")  
454               (wt-loc  fun-loc)))
455              (t
456               (setq loc (list 'cvar (incf *next-cvar*)))
457               (let ((*value-to-go* loc))
458                 (wt-nl
459                  "{object V" (second loc) ";")
460                 (c2expr* (car args))
461                 (push-args (cdr args))
462                 (wt "(V" (second loc)))))
463        (wt ")->cf.cf_self ();")
464        (and loc (wt "}")))
465      (unwind-exit 'fun-val))
466    
467    (defun inline-proc (fname args &aux (n (length args)) res
468                              (obj (add-object fname)))
469      (format t "~%Using ifuncall: ~a" fname)
470      (let ((result
471      (case n
472            ;(0  (list () t (flags ans set) (format nil "ifuncall0(VV[~d])" obj)))
473            (1 (list  '(t) t (flags ans set) (format nil "ifuncall1(VV[~d],(#0))" obj)
474                      'ifuncall))
475            (2 (list  '(t t) t  (flags ans set)
476                           (format nil "ifuncall2(VV[~d],(#0),(#1))" obj)
477                           'ifuncall))
478            (t
479             (list (make-list n :initial-element t)
480                   t (flags ans set)
481                   (format nil "ifuncall(VV[~a],~a~{,#~a~})"
482                           obj n
483                           (dotimes (i n(nreverse res))
484                                    (push i res)))
485                   'ifuncall)))))
486        (push (cons fname result ) *inline-functions*)
487        result
488        ))
489    
490    
491    (si:putprop 'simple-call 'wt-simple-call 'wt-loc)
492    
493    (defun wt-simple-call (cfun base n &optional (vv-index nil))
494      (wt "simple_" cfun "(")
495      (when vv-index (wt "VV[" vv-index "],"))
496      (wt "base+" base "," n ")")
497      (base-used))
498    
499    ;;; Functions that use SAVE-FUNOB should reset *vs*.
500    (defun save-funob (funob)
501      (case (car funob)
502            ((call-lambda call-quote-lambda call-local))
503            (call-global
504             (unless (and (inline-possible (caddr funob))
505                          (or (get (caddr funob) 'Lfun)
506                              (get (caddr funob) 'Ufun)
507                              (assoc (caddr funob) *global-funs*)))
508               (let ((temp (list 'vs (vs-push))))
509                    (if *safe-compile*
510                        (wt-nl
511                         temp
512                         "=symbol_function(VV[" (add-symbol (caddr funob)) "]);")
513                        (wt-nl temp
514                               "=VV[" (add-symbol (caddr funob)) "]->s.s_gfdef;"))
515                    temp)))
516            (ordinary (let* ((temp (list 'vs (vs-push)))
517                             (*value-to-go* temp))
518                            (c2expr* (caddr funob))
519                            temp))
520            (otherwise (baboon))
521            ))
522    
523    (defun push-args (args)
524      (cond ((null args) (wt-nl "vs_base=vs_top;"))
525            ((consp args)
526             (let ((*vs* *vs*) (base *vs*))
527               (dolist** (arg args)
528                 (let ((*value-to-go* (list 'vs (vs-push))))
529                   (c2expr* arg)))
530               (wt-nl "vs_top=(vs_base=base+" base ")+" (- *vs* base) ";")
531               (base-used)))))
532    
533    (defun push-args-lispcall (args)
534      (dolist** (arg args)
535        (let ((*value-to-go* (list 'vs (vs-push))))
536          (c2expr* arg))))
537    
538    (defun c2call-unknown-global (fname args loc inline-p)
539      (cond (*compiler-push-events*
540             ;;; Want to set up the return catcher.
541             (unless loc
542               (setq loc (list 'vs (vs-push)))
543               (wt-nl loc "=symbol_function(VV[" (add-symbol fname) "]);"))
544             (push-args args)
545             (wt-nl "funcall_with_catcher(VV[" (add-symbol fname) "]," loc  ");")
546             (unwind-exit 'fun-val nil fname))
547            (loc
548             ;;; The function was already pushed.
549             (push-args args)
550             (if inline-p
551                 (if *safe-compile*
552                     (wt-nl "funcall_no_event(" loc ");")
553                     (wt-nl "CMPfuncall(" loc  ");"))
554                 (wt-nl "funcall(" loc  ");"))
555             (unwind-exit 'fun-val))
556            ((args-cause-side-effect args)
557             ;;; Evaluation of the arguments may cause side-effect.
558             ;;; Arguments are not yet pushed.
559             (let ((base *vs*))
560                  (setq loc (list 'vs (vs-push)))
561                  (if *safe-compile*
562                      (wt-nl loc "=symbol_function(VV[" (add-symbol fname) "]);")
563                      (wt-nl loc "=(VV[" (add-symbol fname) "]->s.s_gfdef);"))
564                  (push-args-lispcall args)
565                  (cond ((or (eq *value-to-go* 'return)
566                             (eq *value-to-go* 'top))
567                         (wt-nl "lispcall")
568                         (when inline-p (wt "_no_event"))
569                         (wt "(base+" base "," (length args) ");")
570                         (base-used)
571                         (unwind-exit 'fun-val))
572                        (t (unwind-exit
573                            (list 'SIMPLE-CALL
574                                  (if inline-p "lispcall_no_event" "lispcall")
575                                  base (length args))))))
576             )
577            (t
578             ;;; Evaluation of the arguments causes no side-effect.
579             ;;; Arguments are not yet pushed.
580             (let ((base *vs*))
581                  (push-args-lispcall args)
582                  (cond ((or (eq *value-to-go* 'return)
583                             (eq *value-to-go* 'top))
584                         (wt-nl "symlispcall")
585                         (when inline-p (wt "_no_event"))
586                         (wt "(VV[" (add-symbol fname) "],base+" base ","
587                             (length args) ");")
588                         (base-used)
589                         (unwind-exit 'fun-val nil fname))
590                        (t (unwind-exit
591                            (list 'SIMPLE-CALL
592                              (if inline-p "symlispcall_no_event" "symlispcall")
593                              base (length args) (add-symbol fname))
594                            nil fname))))
595             )))

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2

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