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 |
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) |