mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2025-12-06 02:40:26 -08:00
Code Issues Projects Releases Packages Wiki Activity

Fix additional warnings about unused variables and variables which are assumed global in the compiler.

Browse source
This commit is contained in:
Juan Jose Garcia Ripoll 2011-12-26 17:59:16 +01:00
parent 481302642f
commit 24debdf161
10 changed files with 38 additions and 33 deletions
Download patch file Download diff file Expand all files Collapse all files

2
contrib/bytecmp/bytecmp.lsp
View file

@ -33,7 +33,7 @@
:format-arguments (list thing))))
nil)
(defun bc-compile (name &optional (def nil supplied-p))
(defun bc-compile (name &optional (def nil supplied-p) &aux form)
(cond ((and supplied-p def)
(when (functionp def)
(unless (function-lambda-expression def)

2
src/c/symbols_list.h
View file

@ -1149,7 +1149,7 @@ cl_symbols[] = {
{SYS_ "BDS-VAL", SI_ORDINARY, si_bds_val, 1, OBJNULL},
{SYS_ "BDS-VAR", SI_ORDINARY, si_bds_var, 1, OBJNULL},
{SYS_ "BIT-ARRAY-OP", SI_ORDINARY, si_bit_array_op, 4, OBJNULL},
{SYS_ "C-ARGUMENTS-LIMIT", SI_ORDINARY, NULL, -1, MAKE_FIXNUM(C_ARGUMENTS_LIMIT)},
{SYS_ "C-ARGUMENTS-LIMIT", SI_CONSTANT, NULL, -1, MAKE_FIXNUM(C_ARGUMENTS_LIMIT)},
{SYS_ "CHAR-SET", SI_ORDINARY, si_char_set, 3, OBJNULL},
{EXT_ "CHDIR", EXT_ORDINARY, si_chdir, -1, OBJNULL},
{SYS_ "CLEAR-COMPILER-PROPERTIES", SI_ORDINARY, cl_identity, 1, OBJNULL},

15
src/cmp/cmpcall.lsp
View file

@ -135,13 +135,14 @@
;; Call to a function whose C language function name is known,
;; either because it has been proclaimed so, or because it belongs
;; to the runtime.
(when (and (policy-use-direct-C-call)
(setf fd (get-sysprop fname 'Lfun)))
(multiple-value-bind (minarg maxarg) (get-proclaimed-narg fname)
(return-from call-global-loc
(call-exported-function-loc
fname args fd minarg maxarg
(member fname *in-all-symbols-functions*)))))
(when (policy-use-direct-C-call)
(let ((fd (get-sysprop fname 'Lfun)))
(when fd
(multiple-value-bind (minarg maxarg) (get-proclaimed-narg fname)
(return-from call-global-loc
(call-exported-function-loc
fname args fd minarg maxarg
(member fname *in-all-symbols-functions*)))))))
(multiple-value-bind (found fd minarg maxarg)
(si::mangle-name fname t)

2
src/cmp/cmpenv-declare.lsp
View file

@ -55,7 +55,7 @@
(defun collect-declared (type var-list tail)
(declare (si::c-local))
(cmpassert (valid-form-p var-list #'symbolp)
"Syntax error in declaration ~s" decl)
"Syntax error in declaration ~s" `(TYPE ,type ,var-list))
(loop for var-name in var-list
do (push (cons var-name type) tail))
tail)

6
src/cmp/cmplam.lsp
View file

@ -163,8 +163,8 @@ The function thus belongs to the type of functions that ecl_make_cfun accepts."
(cmpck (endp lambda-expr)
"The lambda expression ~s is illegal." (cons 'LAMBDA lambda-expr))
(multiple-value-setq (body ss ts is other-decls doc all-declarations)
(c1body (cdr lambda-expr) t))
(multiple-value-setq (body ss ts is other-decls doc)
(c1body (cdr lambda-expr) t))
(when block-name (setq body (list (cons 'BLOCK (cons block-name body)))))
@ -359,7 +359,7 @@ The function thus belongs to the type of functions that ecl_make_cfun accepts."
(setf optionals (nconc (reduce #'nconc (mapcar #'(lambda (var) (list var *c1nil* NIL))
(subseq requireds si::c-arguments-limit)))
(rest optionals))
required (subseq requireds 0 si::c-arguments-limit)
requireds (subseq requireds 0 si::c-arguments-limit)
varargs t))
;; For each variable, set its var-loc.

10
src/cmp/cmpmain.lsp
View file

@ -579,6 +579,7 @@ List of offending files:~{~%~T~S~}"
(ext:*source-location* (cons source-truename 0))
(*suppress-compiler-messages*
(or *suppress-compiler-messages* (not *compile-verbose*)))
input-file
init-name)
(declare (notinline compiler-cc))
"Compiles the file specified by INPUT-PATHNAME and generates a fasl file
@ -661,8 +662,7 @@ compiled successfully, returns the pathname of the compiled file"
(cmpprogress "~&;;; End of Pass 1.")
(setf init-name (compute-init-name output-file :kind
(if system-p :object :fasl)))
(compiler-pass2 c-pathname h-pathname data-pathname system-p
init-name
(compiler-pass2 c-pathname h-pathname data-pathname init-name
:input-designator (namestring input-pathname))
(data-c-dump data-pathname)
@ -784,8 +784,7 @@ after compilation."
(t1expr form)
(cmpprogress "~&;;; End of Pass 1.")
(let (#+(or mingw32 msvc cygwin)(*self-destructing-fasl* t))
(compiler-pass2 c-pathname h-pathname data-pathname nil
init-name
(compiler-pass2 c-pathname h-pathname data-pathname init-name
:input-designator (format nil "~A" def)))
(data-c-dump data-pathname)
@ -877,7 +876,7 @@ from the C language code. NIL means \"do not create the file\"."
(when h-file (close *compiler-output2*)))))
nil)
(defun compiler-pass2 (c-pathname h-pathname data-pathname system-p init-name
(defun compiler-pass2 (c-pathname h-pathname data-pathname init-name
&key input-designator)
(with-open-file (*compiler-output1* c-pathname :direction :output
:if-does-not-exist :create :if-exists :supersede)
@ -885,6 +884,7 @@ from the C language code. NIL means \"do not create the file\"."
#-ecl-min
(multiple-value-bind (second minute hour day month year)
(get-decoded-time)
(declare (ignore second))
(wt-comment-nl "Date: ~D/~D/~D ~2,'0D:~2,'0D (yyyy/mm/dd)" year month day hour minute)
(wt-comment-nl "Machine: ~A ~A ~A" (software-type) (software-version) (machine-type)))
(wt-comment-nl "Source: ~A" input-designator)

5
src/cmp/cmpopt.lsp
View file

@ -251,9 +251,8 @@
;;
;; Complex types defined with DEFTYPE.
((and (atom type)
(get-sysprop type 'SI::DEFTYPE-DEFINITION)
(setq function (get-sysprop type 'SI::DEFTYPE-DEFINITION)))
(expand-coerce form value `',(funcall function) env))
(setq first (get-sysprop type 'SI::DEFTYPE-DEFINITION)))
(expand-coerce form value `',(funcall first) env))
;;
;; CONS types are not coercible.
((and (consp type)

5
src/cmp/cmpprop.lsp
View file

@ -286,8 +286,10 @@ as 2^*tagbody-limit* in the worst cases.")
(values 'null (append (p1merge-branches nil ass-list) orig-assumptions))))
(defun p1tagbody-one-pass (c1form assumptions tag-loc body)
(declare (ignore tag-loc))
(loop with local-ass = assumptions
with ass-list = '()
with aux
for f in body
do (if (tag-p f)
(let ((diff (ldiff local-ass assumptions)))
@ -303,14 +305,17 @@ as 2^*tagbody-limit* in the worst cases.")
ass-list)))))
(defun p1unwind-protect (c1form assumptions form body)
(declare (ignore c1form))
(multiple-value-bind (output-type assumptions)
(p1propagate form assumptions)
(p1propagate body assumptions)
(values output-type assumptions)))
(defun p1structure-set (c1form assumptions structure symbol vv-index value)
(declare (ignore vv-index symbol))
(multiple-value-bind (structure-type assumptions)
(p1propagate structure assumptions)
(declare (ignore structure-type))
(multiple-value-bind (slot-type assumptions)
(p1propagate value assumptions)
(let ((old-slot-type (c1form-primary-type c1form)))

2
src/cmp/cmpstructures.lsp
View file

@ -73,7 +73,7 @@
(type (get-slot-type name index)))
(make-c1form* 'SYS:STRUCTURE-REF :type type
:args c-form (add-symbol name) index
(if (or (subtypep (c1form-type c-form) structure-type)
(if (or (subtypep (c1form-type c-form) name)
(policy-assume-no-errors))
:unsafe
nil)))

22
src/cmp/cmptag.lsp
View file

@ -197,17 +197,17 @@
(cmp-env-search-tag name)
(unless tag
(cmperr "Undefined tag ~A" name))
(setq var (tag-var tag))
(cond (ccb (setf (tag-ref-ccb tag) t
(var-ref-ccb var) T
(var-kind var) 'CLOSURE))
(clb (setf (tag-ref-clb tag) t
(var-ref-clb var) t
(var-kind var) 'LEXICAL))
(unw (unless (var-kind var)
(setf (var-kind var) :OBJECT))))
(incf (tag-ref tag))
(add-to-read-nodes var (make-c1form* 'GO :args tag (or ccb clb unw))))))
(let ((var (tag-var tag)))
(cond (ccb (setf (tag-ref-ccb tag) t
(var-ref-ccb var) T
(var-kind var) 'CLOSURE))
(clb (setf (tag-ref-clb tag) t
(var-ref-clb var) t
(var-kind var) 'LEXICAL))
(unw (unless (var-kind var)
(setf (var-kind var) :OBJECT))))
(incf (tag-ref tag))
(add-to-read-nodes var (make-c1form* 'GO :args tag (or ccb clb unw)))))))
(defun c2go (tag nonlocal)
(if nonlocal