mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-03-15 17:30:37 -07:00
Code Issues Projects Releases Packages Wiki Activity

The VARARG-* forms did not work with unused variables

Browse source
This commit is contained in:
Juan Jose Garcia Ripoll 2009-12-26 20:28:06 +01:00
parent 33f9df411d
commit c31bc9bf53
4 changed files with 28 additions and 16 deletions
Download patch file Download diff file Expand all files Collapse all files

7
src/new-cmp/cmpbackend.lsp
View file

@ -255,9 +255,10 @@
(defun c2varargs-rest-op (dest-loc nargs-loc varargs-loc nkeys
keywords-loc allow-other-keys)
(if (not (or keywords-loc allow-other-keys))
(if (simple-varargs-loc-p varargs-loc)
(wt-nl dest-loc "=cl_grab_rest_args(args);")
(wt-nl dest-loc "=cl_grab_rest_args(cl_args);"))
(set-loc (if (simple-varargs-loc-p varargs-loc)
'(c-inline :object "cl_grab_rest_args(args)" () t nil)
'(c-inline :object "cl_grab_rest_args(cl_args)" () t nil))
dest-loc)
(progn
(if keywords-loc
(wt-nl "cl_parse_key(cl_args," nkeys "," keywords-loc ",keyvars")

12
src/new-cmp/cmpffi.lsp
View file

@ -331,15 +331,9 @@
(cmperr "C-INLINE: mismatch between sizes of argument list and argument types."))
(c1with-saved-values (prefix postfix temps arguments)
(nconc prefix
(make-c1form* 'C-INLINE :type output-type
:args
destination
temps
arg-types
output-rep-type
c-expression
side-effects
one-liner)
(c1c-inline-op output-type destination temps arg-types
output-rep-type c-expression side-effects
one-liner)
postfix)))))
(defun produce-inline-loc (argument-locs arg-types output-rep-type

14
src/new-cmp/cmppass.lsp
View file

@ -89,6 +89,12 @@ output value is not used."
t)
((BIND UNBIND)
(every #'unused-variable-p (c1form-arg 0 form)))
((VARARGS-REST VARARGS-POP)
(let ((destination (c1form-arg 0 form)))
(when (unused-variable-p destination)
(setf (c1form-arg 0 form) 'TRASH)
(eliminate-from-set-nodes destination form)))
nil)
(CALL-GLOBAL
(let* ((form-args (c1form-args form))
(destination (first form-args))
@ -113,8 +119,6 @@ output value is not used."
(t nil))))
(defun unused-destination (dest)
(when (var-p dest)
(print (var-read-nodes dest)))
(or (eq dest 'trash)
(and (var-p dest)
(unused-variable-p dest))))
@ -175,14 +179,16 @@ forms are also suppressed."
(flet ((compute-variable-rep-type (v requireds)
(let* ((kind (var-kind v)))
(if (eq kind 'LEXICAL)
(if (member v requireds)
(if (member v requireds :test #'eq)
:OBJECT
(lisp-type->rep-type (var-type v)))
kind))))
(loop with lambda-list = (fun-lambda-list function)
with requireds = (first lambda-list)
for v in (fun-local-vars function)
do (setf (var-kind v) (compute-variable-rep-type v requireds))))
do (setf (var-kind v) (compute-variable-rep-type v requireds))
do (format t "~&;;; Variable name ~A is type ~S location ~S" (var-name v)
(var-kind v) (var-loc v))))
forms)

11
src/new-cmp/cmptranslate.lsp
View file

@ -413,6 +413,17 @@
(update-destination-type destination form return-type)
form))
(defun c1c-inline-op (output-type destination temps arg-types
output-rep-type c-expression side-effects
one-liner)
(let ((form (make-c1form* 'C-INLINE :type output-type
:args destination temps arg-types
output-rep-type c-expression side-effects
one-liner)))
(loop for arg in temps do (maybe-add-to-read-nodes arg form))
(update-destination-type destination form output-type)
form))
;;;
;;; DEBUG INFORMATION
;;;