cosmetic: fix some compiler warnings

contrib/bytecmp/bytecmp.lsp

@@ -81,7 +81,7 @@
 (defun bc-compile-file-pathname (name &key (output-file name) (type :fasl)
 				 verbose print c-file h-file data-file
 				 shared-data-file system-p load external-format)
-  (declare (ignore load c-file h-file data-file shared-data-file system-p verbose print))
+  (declare (ignore load c-file h-file data-file shared-data-file system-p verbose print external-format))
   (let ((extension "fasc"))
     (case type
       ((:fasl :fas) (setf extension "fasc"))

src/c/alloc_2.d

@@ -191,11 +191,13 @@ static struct ecl_type_information {
   size_t t;
 } type_info[t_end];
 
+#ifdef GBC_BOEHM_PRECISE
 static void
 error_wrong_tag(cl_type t)
 {
   ecl_internal_error("Collector called with invalid tag number.");
 }
+#endif
 
 cl_index
 ecl_object_byte_size(cl_type t)
@@ -764,6 +766,7 @@ extern void (*GC_push_other_roots)();
 static void (*old_GC_push_other_roots)();
 static void stacks_scanner();
 
+#ifdef GBC_BOEHM_PRECISE
 static cl_index
 to_bitmap(void *x, void *y)
 {
@@ -773,6 +776,7 @@ to_bitmap(void *x, void *y)
   n /= sizeof(void*);
   return 1 << n;
 }
+#endif
 
 void
 init_alloc(void)

src/c/clos/cache.d

@@ -36,6 +36,7 @@ empty_cache(ecl_cache_ptr cache)
 #endif
 }
 
+#ifndef ECL_THREADS
 static void
 clear_one_from_cache(ecl_cache_ptr cache, cl_object target)
 {
@@ -51,8 +52,7 @@ clear_one_from_cache(ecl_cache_ptr cache, cl_object target)
     }
   }
 }
-
+#else
-#ifdef ECL_THREADS
 static void
 clear_list_from_cache(ecl_cache_ptr cache)
 {

src/c/compiler.d

@@ -847,7 +847,7 @@ c_block(cl_env_ptr env, cl_object body, int old_flags) {
   struct cl_compiler_env old_env;
   cl_object name = pop(&body);
   cl_object block_record;
-  cl_index labelz, pc, loc, constants;
+  cl_index labelz, pc, constants;
   int flags;
 
   if (!ECL_SYMBOLP(name))
@@ -858,7 +858,7 @@ c_block(cl_env_ptr env, cl_object body, int old_flags) {
   pc = current_pc(env);
 
   flags = maybe_values_or_reg0(old_flags);
-  loc = c_register_block(env, name);
+  c_register_block(env, name);
   block_record = ECL_CONS_CAR(env->c_env->variables);
   if (Null(name)) {
     asm_op(env, OP_DO);
@@ -1063,7 +1063,7 @@ c_case(cl_env_ptr env, cl_object clause, int flags) {
 
 static int
 c_catch(cl_env_ptr env, cl_object args, int flags) {
-  cl_index labelz, loc;
+  cl_index labelz;
   cl_object old_env;
 
   /* Compile evaluation of tag */
@@ -1071,7 +1071,7 @@ c_catch(cl_env_ptr env, cl_object args, int flags) {
 
   /* Compile binding of tag */
   old_env = env->c_env->variables;
-  loc = c_register_block(env, ecl_make_fixnum(0));
+  c_register_block(env, ecl_make_fixnum(0));
   asm_op(env, OP_CATCH);
 
   /* Compile jump point */
@@ -3039,7 +3039,7 @@ c_default(cl_env_ptr env, cl_object var, cl_object stmt, cl_object flag, cl_obje
 cl_object
 ecl_make_lambda(cl_env_ptr env, cl_object name, cl_object lambda) {
   cl_object reqs, opts, rest, key, keys, auxs, allow_other_keys;
-  cl_object specials, doc, decl, body, output;
+  cl_object specials, decl, body, output;
   cl_index handle;
   struct cl_compiler_env *old_c_env, new_c_env;
 
@@ -3057,7 +3057,7 @@ ecl_make_lambda(cl_env_ptr env, cl_object name, cl_object lambda) {
   keys = env->values[4];
   allow_other_keys = env->values[5];
   auxs = env->values[6];
-  doc  = env->values[7];
+  /* doc  = env->values[7]; unused */;
   specials = env->values[8];
   decl = env->values[9];
   body = env->values[10];

src/c/disassembler.d

@@ -53,13 +53,11 @@ print_oparg_arg(const char *s, cl_fixnum n, cl_object x) {
 static void
 disassemble_lambda(cl_object bytecodes) {
   const cl_env_ptr env = ecl_process_env();
-  cl_object *data;
   cl_opcode *vector;
 
   ecl_bds_bind(env, @'*print-pretty*', ECL_NIL);
 
   /* Print required arguments */
-  data = bytecodes->bytecodes.data->vector.self.t;
   cl_print(1,bytecodes->bytecodes.data);
 
   /* Name of LAMBDA */

src/c/ffi/mmap.d

@@ -53,7 +53,7 @@
                        @':element-type', element_type,
                        @':if-exists', if_exists,
                        @':if-does-not-exist', if_does_not_exist,
-                       @':external-format', @':default',
+                       @':external-format', external_format,
                        @':cstream', ECL_NIL);
       fd = ecl_to_int(si_file_stream_fd(stream));
       if (Null(length))

src/c/interpreter.d

@@ -314,7 +314,6 @@ ecl_interpret(cl_object frame, cl_object env, cl_object bytecodes)
   frame_aux.stack = frame_aux.base = 0;
   frame_aux.size = 0;
   frame_aux.env = the_env;
- BEGIN:
   BEGIN_SWITCH {
     CASE(OP_NOP); {
       reg0 = ECL_NIL;

src/c/number.d

@@ -611,7 +611,7 @@ si_complex_float(cl_object r, cl_object i)
 {
   cl_type tr = ecl_t_of(r);
   cl_type ti = ecl_t_of(i);
-  cl_object result;
+  cl_object result = OBJNULL;
   switch (tr) {
   case t_singlefloat:
     if (ti != tr) { ecl_type_error(@'si::complex-float',"imag part", i, @'single-float'); }

src/c/numbers/number_equalp.d

@@ -36,7 +36,6 @@
 int
 ecl_number_equalp(cl_object x, cl_object y)
 {
-  double dx;
   /* INV: (= fixnum bignum) => 0 */
   /* INV: (= fixnum ratio) => 0 */
   /* INV: (= bignum ratio) => 0 */

src/c/pathname.d

@@ -659,7 +659,9 @@ ecl_parse_namestring(cl_object s, cl_index start, cl_index end, cl_index *ep,
   if (!ecl_stringp(device)) {
     return ECL_NIL;
   }
+#if defined(ECL_MS_WINDOWS_HOST)
  maybe_parse_host:
+#endif
   /* Files have no effective device. */
   if (@string-equal(2, device, @':file') == ECL_T)
     device = ECL_NIL;

src/c/printer/float_to_digits.d

@@ -161,10 +161,8 @@ generate(cl_object digits, float_approx *approx)
 static void
 change_precision(float_approx *approx, cl_object position, cl_object relativep)
 {
-  cl_fixnum pos;
   if (Null(position))
     return;
-  pos = ecl_fixnum(position);
   if (!Null(relativep)) {
     cl_object k = ecl_make_fixnum(0);
     cl_object l = ecl_make_fixnum(1);

src/c/printer/write_symbol.d

@@ -102,13 +102,15 @@ needs_to_be_escaped(cl_object s, cl_object readtable, cl_object print_case)
   return 0;
 }
 
-#define buffer_write_char(c, buffer, stream, buffer_ndx, buffer_size) \
+static inline void
-  ecl_char_set(buffer, buffer_ndx++, c);                              \
+buffer_write_char(char c, cl_object buffer, cl_object stream, cl_index *buffer_ndx, cl_index buffer_size) {
-  if (buffer_ndx >= buffer_size) {                                    \
+  ecl_char_set(buffer, (*buffer_ndx)++, c);
-    si_fill_pointer_set(buffer, ecl_make_fixnum(buffer_size));        \
+  if (*buffer_ndx >= buffer_size) {
-    si_do_write_sequence(buffer, stream, ecl_make_fixnum(0), ECL_NIL);\
+    si_fill_pointer_set(buffer, ecl_make_fixnum(buffer_size));
-    buffer_ndx = 0;                                                   \
+    si_do_write_sequence(buffer, stream, ecl_make_fixnum(0), ECL_NIL);
+    *buffer_ndx = 0;
   }
+}
 
 static void
 write_symbol_string(cl_object s, int action, cl_object print_case,
@@ -124,13 +126,13 @@ write_symbol_string(cl_object s, int action, cl_object print_case,
   cl_index buffer_size = ecl_fixnum(cl_array_total_size(buffer));
   cl_index buffer_ndx = 0;
   if (escape)
-    buffer_write_char('|', buffer, stream, buffer_ndx, buffer_size);
+    buffer_write_char('|', buffer, stream, &buffer_ndx, buffer_size);
   capitalize = 1;
   for (i = 0;  i < s->base_string.fillp;  i++) {
     ecl_character c = ecl_char(s, i);
     if (escape) {
       if (c == '|' || c == '\\') {
-        buffer_write_char('\\', buffer, stream, buffer_ndx, buffer_size);
+        buffer_write_char('\\', buffer, stream, &buffer_ndx, buffer_size);
       }
     } else if (action != ecl_case_preserve) {
       if (ecl_upper_case_p(c)) {
@@ -155,10 +157,10 @@ write_symbol_string(cl_object s, int action, cl_object print_case,
         capitalize = !ecl_alphanumericp(c);
       }
     }
-    buffer_write_char(c, buffer, stream, buffer_ndx, buffer_size);
+    buffer_write_char(c, buffer, stream, &buffer_ndx, buffer_size);
   }
   if (escape)
-    buffer_write_char('|', buffer, stream, buffer_ndx, buffer_size);
+    buffer_write_char('|', buffer, stream, &buffer_ndx, buffer_size);
   si_fill_pointer_set(buffer, ecl_make_fixnum(buffer_ndx));
   si_do_write_sequence(buffer, stream, ecl_make_fixnum(0), ECL_NIL);
   si_put_buffer_string(buffer);

src/c/printer/write_ugly.d

@@ -120,7 +120,7 @@ write_float(cl_object f, cl_object stream)
 static void                    /* XXX: do not cons new floats here! */
 write_complex_float(cl_object f, cl_object stream)
 {
-  cl_object real, imag;
+  cl_object real = OBJNULL, imag = OBJNULL;
   switch (ecl_t_of(f)) {
   case t_csfloat:
     real = ecl_make_single_float(crealf(ecl_csfloat(f)));

src/c/sequence.d

@@ -189,7 +189,7 @@ ecl_copy_seq(cl_object sequence)
   return ecl_subseq(sequence, 0, MOST_POSITIVE_FIXNUM);
 }
 
-@(defun subseq (sequence start &optional end &aux x)
+@(defun subseq (sequence start &optional end)
   cl_index_pair p;
   @
   p = ecl_sequence_start_end(@[subseq], sequence, start, end);

src/c/threads/queue.d

@@ -84,6 +84,7 @@ wait_queue_delete(cl_env_ptr the_env, cl_object q, cl_object item)
  * THREAD SCHEDULER & WAITING
  */
 
+#if !defined(HAVE_SIGPROCMASK)
 static cl_object
 bignum_set_time(cl_object bignum, struct ecl_timeval *time)
 {
@@ -194,6 +195,7 @@ ecl_wait_on_timed(cl_env_ptr env, cl_object (*condition)(cl_env_ptr, cl_object),
   ecl_bds_unwind1(the_env);
   return output;
 }
+#endif
 
 /**********************************************************************
  * BLOCKING WAIT QUEUE ALGORITHM

src/c/unixfsys.d

@@ -351,7 +351,7 @@ file_truename(cl_object pathname, cl_object filename, int flags)
      * the other hand, if the link is broken – return file
      * truename "as is". */
     struct stat filestatus;
-    if (safe_stat(filename->base_string.self, &filestatus) < 0) {
+    if (safe_stat((char*) filename->base_string.self, &filestatus) < 0) {
       @(return pathname kind);
     }
     filename = si_readlink(filename);
@@ -560,7 +560,9 @@ ecl_file_len(int f)
     }
 #endif
   }
+#if defined(ECL_MS_WINDOWS_HOST)
  FAILURE_CLOBBER:
+#endif
   ecl_enable_interrupts();
   {
     cl_object c_error = _ecl_strerror(errno);

src/clos/combin.lsp

@@ -211,6 +211,7 @@
     o))
 
 (defun find-method-combination (gf method-combination-type-name method-combination-options)
+  (declare (ignore gf))
   (make-method-combination method-combination-type-name
                            (search-method-combination method-combination-type-name)
                            method-combination-options

src/clos/generic.lsp

@@ -181,7 +181,7 @@
 
 (defmethod shared-initialize ((gfun standard-generic-function) slot-names
                               &rest initargs)
-  (declare (ignore initargs slot-names))
+  (declare (ignore slot-names))
   (call-next-method)
   (when (generic-function-methods gfun)
     (compute-g-f-spec-list gfun))

src/clos/kernel.lsp

@@ -355,7 +355,7 @@
   (with-early-accessors (+standard-generic-function-slots+
                          +eql-specializer-slots+
                          +standard-method-slots+)
-    (flet ((nupdate-spec-how-list (spec-how-list specializers gf)
+    (flet ((nupdate-spec-how-list (spec-how-list specializers)
              ;; update the spec-how of the gfun 
              ;; computing the or of the previous value and the new one
              (setf spec-how-list (or spec-how-list
@@ -379,7 +379,7 @@
              (a-p-o (generic-function-argument-precedence-order gf)))
         (dolist (method (generic-function-methods gf))
           (setf spec-how-list
-                (nupdate-spec-how-list spec-how-list (method-specializers method) gf)))
+                (nupdate-spec-how-list spec-how-list (method-specializers method))))
         (setf (generic-function-spec-list gf)
               (loop for type in spec-how-list
                  for i from 0

src/clos/method.lsp

@@ -102,6 +102,7 @@
   (when (eq (first method-lambda) 'lambda)
     (multiple-value-bind (declarations body documentation)
         (si::find-declarations (cddr method-lambda))
+      (declare (ignore documentation))
       (let (block)
         (when (and (null (rest body))
                    (listp (setf block (first body)))
@@ -177,6 +178,7 @@
       (values method-lambda declarations documentation))))
 
 (defun make-method-lambda (gf method method-lambda env)
+  (declare (ignore method gf))
   (multiple-value-bind (call-next-method-p next-method-p-p in-closure-p)
       (walk-method-lambda method-lambda env)
     (values `(lambda (.combined-method-args. *next-methods*)
@@ -190,6 +192,7 @@
 (defun add-call-next-method-closure (method-lambda)
   (multiple-value-bind (declarations real-body documentation)
       (si::find-declarations (cddr method-lambda))
+    (declare (ignore documentation))
     `(lambda ,(second method-lambda)
        ,@declarations
        (let* ((.closed-combined-method-args.

src/clos/print.lsp

@@ -112,12 +112,15 @@
        (no-make-load-form object)))))
 
 (defmethod make-load-form ((object standard-object) &optional environment)
+  (declare (ignore environment))
   (no-make-load-form object))
 
 (defmethod make-load-form ((object structure-object) &optional environment)
+  (declare (ignore environment))
   (no-make-load-form object))
 
 (defmethod make-load-form ((object condition) &optional environment)
+  (declare (ignore environment))
   (no-make-load-form object))
 
 (defun no-make-load-form (object)

src/clos/std-accessors.lsp

@@ -23,6 +23,7 @@
 ;;; 
 
 (defun safe-slot-definition-location (slotd &optional default)
+  (declare (ignore default))
   (cond ((listp slotd)
          (error "List instead of a slot definition object"))
         (t

src/cmp/cmpc-machine.lsp

@@ -130,10 +130,6 @@
        :from-lisp from-lisp
        :from-lisp-unsafe from-lisp-unsafe))))
 
-(defun make-rep-type-hash (all-c-types)
-  (let ((table (make-hash-table :size 128 :test 'eq)))
-    table))
-
 (defun default-machine ()
   (let* ((all-c-types (append +this-machine-c-types+ +all-machines-c-types+))
          (table (make-hash-table :size 128 :test 'eq))

src/cmp/cmpenv-declaim.lsp

@@ -36,6 +36,7 @@
            env))
     (multiple-value-bind (body specials types ignored others doc all)
         (c1body `((DECLARE ,@args)) nil)
+      (declare (ignore body doc all))
       (when ignored
         (cmpwarn-style "IGNORE/IGNORABLE declarations in DECLAIM are ignored"))
       (reduce #'add-one-declaration others

src/cmp/cmpenv-declare.lsp

@@ -33,10 +33,10 @@
 (defun validate-alien-declaration (names-list error)
   (dolist (new-declaration names-list)
     (unless (symbolp new-declaration)
-      (cmperr "The declaration ~s is not a symbol" new-declaration))
+      (funcall error "The declaration ~s is not a symbol" new-declaration))
     (when (type-name-p new-declaration)
-      (cmperr "Symbol name ~S cannot be both the name of a type and of a declaration"
+      (funcall error "Symbol name ~S cannot be both the name of a type and of a declaration"
-              new-declaration))))
+               new-declaration))))
 
 (defun alien-declaration-p (name &optional (env *cmp-env*))
   (and (symbolp name)

src/cmp/cmpenv-fun.lsp

@@ -91,7 +91,7 @@
         (values nil nil))))
 
 (defun get-local-return-type (fun &optional (env *cmp-env*))
-  (let ((x (cmp-env-search-ftype (fun-name fun))))
+  (let ((x (cmp-env-search-ftype (fun-name fun) env)))
     (if x
         (values (second x) t)
         (values nil nil))))

src/cmp/cmpinline.lsp

@@ -182,7 +182,7 @@
   (wt-nl-open-brace)
   (incf *inline-blocks*))
 
-(defun close-inline-blocks (&optional new-line)
+(defun close-inline-blocks ()
   (loop for i of-type fixnum from 0 below *inline-blocks*
      do (wt-nl-close-brace)))
 

src/cmp/cmplam.lsp

@@ -335,6 +335,7 @@ The function thus belongs to the type of functions that ecl_make_cfun accepts."
         (maxarg call-arguments-limit))
     (destructuring-bind (requireds optionals rest key-flag keywords a-o-k)
         (c1form-arg 0 lambda)
+      (declare (ignore keywords))
       (setf minarg (length requireds))
       (when (and (null rest) (not key-flag) (not a-o-k))
         (setf maxarg (+ minarg (/ (length optionals) 3)))))

src/cmp/cmplet.lsp

@@ -311,7 +311,7 @@
           (when env (pop-debug-lexical-env))))
       (c2expr body))
 
-  (close-inline-blocks :line))
+  (close-inline-blocks))
 
 (defun discarded (var form body &aux last)
   (labels ((last-form (x &aux (args (c1form-args x)))

src/cmp/cmploc.lsp

@@ -218,6 +218,7 @@
 ;;;
 
 (defun set-unknown-loc (loc)
+  (declare (ignore loc))
   (unknown-location 'set-loc *destination*))
 
 (defun set-loc (loc &aux fd)

src/cmp/cmpmain.lsp

@@ -48,6 +48,8 @@ the environment variable TMPDIR to a different value." template))
                               verbose print c-file h-file data-file
                               system-p load external-format source-truename
                               source-offset)
+  (declare (ignore verbose print c-file h-file data-file load
+                   external-format source-truename source-offset))
   (let* ((format '())
          (extension '()))
     (unless type-supplied-p
@@ -145,6 +147,7 @@ the environment variable TMPDIR to a different value." template))
 (defun linker-cc (o-pathname object-files &key
                   (type :program)
                   (ld-flags (split-program-options *ld-flags*)))
+  (declare (ignore type))
   (safe-run-program
    *ld*
    `("-o" ,(brief-namestring o-pathname)
@@ -995,6 +998,7 @@ from the C language code.  NIL means \"do not create the file\"."
                *safety* *space* *speed* *debug*))
 
 (defmacro with-compilation-unit (options &rest body)
+  (declare (ignore options))
   `(progn ,@body))
 
 (ext:package-lock "CL" t)

src/cmp/cmpmulti.lsp

@@ -166,7 +166,7 @@
   (declare (si::c-local))
   (if (plusp i) (values-loc i) 'VALUE0))
 
-(defun do-m-v-setq (vars form use-bind &aux min-values max-values)
+(defun do-m-v-setq (vars form use-bind)
   ;; This routine moves values from the multiple-value stack into the
   ;; variables VARS. The amount of values is not known (or at least we only
   ;; know that there is some number between MIN-VALUES and MAX-VALUES).  If

src/cmp/cmpname.lsp

@@ -161,7 +161,7 @@ initialization from the C code which wants to use it."
                   c)
                  (t
                   #\p)))
-         (disambiguation (c)
+         (disambiguation (kind)
            (case kind
              ((:object :c) "")
              ((:fasl :fas) "fas_")

src/cmp/cmpnum.lsp

@@ -254,11 +254,13 @@
 (def-type-propagator acos (fname op1-type)
   (multiple-value-bind (output-type op1-type)
       (ensure-nonrational-type op1-type)
+    (declare (ignore output-type))
     (values (list op1-type) 'NUMBER)))
 
 (def-type-propagator atan (fname op1-type &optional (op2-type t op2-p))
   (multiple-value-bind (float-t1 t1)
       (ensure-nonrational-type op1-type)
+    (declare (ignore float-t1))
     (if op2-p
         (multiple-value-bind (result t1 t2)
             (maximum-number-type t1 op2-type :only-real t)

src/cmp/cmpopt-printer.lsp

@@ -65,19 +65,19 @@
                      "ecl_princ(#0,#1)"
                      :one-liner t)))
 
-(define-compiler-macro terpri (&optional stream &environment env)
+(define-compiler-macro terpri (&optional stream)
   `(ffi:c-inline (,stream)
                  (:object) :object
                  "ecl_terpri(#0)"
                  :one-liner t))
 
-(define-compiler-macro print (value &optional stream &environment env)
+(define-compiler-macro print (value &optional stream)
   `(ffi:c-inline (,value ,stream)
                  (:object :object) :object
                  "ecl_print(#0,#1)"
                  :one-liner t))
 
-(define-compiler-macro prin1 (value &optional stream &environment env)
+(define-compiler-macro prin1 (value &optional stream)
   `(ffi:c-inline (,value ,stream)
                  (:object :object) :object
                  "ecl_prin1(#0,#1)"

src/cmp/cmpopt-sequence.lsp

@@ -220,6 +220,7 @@
              (return ,%sublist)))))))
 
 (define-compiler-macro member (&whole whole value list &rest sequence-args)
+  (declare (value list sequence-args))
   (if (policy-inline-sequence-functions)
       (or (apply #'expand-member (rest whole))
           whole)
@@ -264,6 +265,7 @@
                    (return ,%elt))))))))))
 
 (define-compiler-macro assoc (&whole whole value list &rest sequence-args)
+  (declare (ignore value list sequence-args))
   (if (policy-inline-sequence-functions)
       (or (apply #'expand-assoc (rest whole))
           whole)
@@ -287,6 +289,7 @@
                (return ,%elt))))))))
 
 (define-compiler-macro find (&whole whole value sequence &rest sequence-args)
+  (declare (ignore value sequence sequence-args))
   (if (policy-inline-sequence-functions)
       (or (apply #'expand-find (rest whole))
           whole)

src/cmp/cmpopt.lsp

@@ -160,6 +160,7 @@
            form))))
 
 (define-compiler-macro typep (&whole form object type &optional e &environment env)
+  (declare (ignore e))
   (expand-typep form object type env))
 
 ;;;
@@ -346,8 +347,7 @@
     (multiple-value-bind (constant-p float)
         (constant-value-p float env)
       (when (and constant-p (floatp float))
-        (let* ((aux (gentemp))
+        (let* ((float (type-of float))
-               (float (type-of float))
                (c-type (lisp-type->rep-type float)))
           `(let ((value ,value))
              (declare (:read-only value))

src/cmp/cmpprop.lsp

@@ -379,12 +379,14 @@ compute it. This version only handles the simplest cases."
             elt-type)))
 
 (def-type-propagator si::row-major-aset (fname array-type index obj)
+  (declare (ignore index obj))
   (multiple-value-bind (elt-type array-type)
       (type-from-array-elt array-type)
     (values (list array-type 'si::index elt-type)
             elt-type)))
 
 (def-type-propagator row-major-aref (fname array-type index)
+  (declare (ignore index))
   (multiple-value-bind (elt-type array-type)
       (type-from-array-elt array-type)
     (values (list array-type 'si::index) elt-type)))

src/cmp/cmptop.lsp

@@ -477,6 +477,7 @@
       args
     (multiple-value-bind (function pprint doc-string)
         (sys::expand-defmacro name lambda-list body)
+      (declare (ignore pprint doc-string))
       (let ((fn (cmp-eval function *cmp-env*)))
         (cmp-env-register-global-macro name fn))
       (t1expr* (macroexpand `(DEFMACRO ,@args))))))

src/cmp/cmptype-assert.lsp

@@ -58,7 +58,7 @@
            FEtype_error_sequence(#0);")
     (vector . "if (ecl_unlikely(!ECL_VECTORP(#0))) FEtype_error_vector(#0);")))
 
-(defun simple-type-assertion (value type env)
+(defun simple-type-assertion (value type)
   (let ((simple-form (cdr (assoc type +simple-type-assertions+))))
     (if simple-form
         `(ffi:c-inline (,value) (:object) :void ,simple-form
@@ -82,13 +82,13 @@
         (compulsory
          ;; The check has to be produced, independent of the declared
          ;; value of the variable (for instance, in LAMBDA arguments).
-         (simple-type-assertion value type env))
+         (simple-type-assertion value type))
         (t
          ;; We may rely on the compiler to choose the appropriate
          ;; branch once type propagation has happened.
          `(ext:compiler-typecase ,value
             (,type)
-            (t ,(simple-type-assertion value type env))))))
+            (t ,(simple-type-assertion value type))))))
 
 (defun c1checked-value (args)
   (let* ((type (pop args))

src/cmp/cmpvar.lsp

@@ -74,13 +74,13 @@
   (mapcar #'first (var-read-nodes var)))
 
 (defun assert-var-ref-value (var)
-  #+debug-compiler
+  (when *debug-compiler*
-  (unless (let ((ref (var-ref var)))
+    (unless (let ((ref (var-ref var)))
-            (or (> ref (/ most-positive-fixnum 2))
+              (or (> ref (/ most-positive-fixnum 2))
-                (= (var-ref var) (+ (length (var-read-nodes var))
+                  (= (var-ref var) (+ (length (var-read-nodes var))
-                                    (length (var-set-nodes var))))))
+                                      (length (var-set-nodes var))))))
-    (baboon :format-control "Number of references in VAR ~A unequal to references list"
+      (baboon :format-control "Number of references in VAR ~A unequal to references list"
-            :format-arguments (list var))))
+              :format-arguments (list var)))))
 
 (defun assert-var-not-ignored (var)
   (when (let ((x (var-ignorable var))) (and x (minusp x)))
@@ -229,6 +229,7 @@
 (defun c1vref (name)
   (multiple-value-bind (var cfb unw)
       (cmp-env-search-var name)
+    (declare (ignore unw))
     (cond ((null var)
            (c1make-global-variable name :warn t
                                    :type (or (si:get-sysprop name 'CMP-TYPE) t)))

src/cmp/proclamations.lsp

@@ -1189,7 +1189,7 @@
 (proclamation si:open-unix-socket-stream (string) stream)
 #+wants-sockets
 (proclamation si:lookup-host-entry (t) (values (or null string) list list))
-(proclamation si:copy-stream (stream stream wait) t)
+(proclamation si:copy-stream (stream stream gen-bool) t)
 (proclamation si:make-encoding (t) hash-table)
 (proclamation si:load-encoding (t) t)
 

src/h/bytecodes.h

@@ -152,6 +152,7 @@ typedef int16_t cl_opcode;
         goto *(&&LBL_OP_NOP + offsets[GET_OPCODE(vector)])
 #else
 #define BEGIN_SWITCH \
+        BEGIN: \
         switch (GET_OPCODE(vector))
 #define THREAD_NEXT \
         goto BEGIN

src/lsp/defstruct.lsp

@@ -313,10 +313,10 @@
       (or (equal old-def new-def)
           (destructuring-bind (old-slot-name old-init old-type old-read-only old-offset old-ac)
               old-def
-            (declare (ignore old-init old-read-only old-ac))
+            (declare (ignore old-slot-name old-init old-read-only old-ac))
             (destructuring-bind (new-slot-name new-init new-type new-read-only new-offset new-ac)
                 new-def
-              (declare (ignore new-init new-read-only new-ac))
+              (declare (ignore new-slot-name new-init new-read-only new-ac))
               ;; Name EQL is not enforced because structures may be
               ;; constructed by code generators and it is likely they
               ;; will have gensymed names. -- jd 2019-05-22

src/lsp/ffi.lsp

@@ -834,7 +834,8 @@ reference the arguments of the function as \"#0\", \"#1\", etc.
 
 The interpreter ignores this form.  ARG-TYPES are argument types of
 the defined Lisp function and RESULT-TYPE is its return type."
-  (let ((args (mapcar #'(lambda (x) (gensym)) arg-types)))
+  (let ((args (mapcar #'(lambda (x) (declare (ignore x)) (gensym))
+                      arg-types)))
   `(defun ,name ,args
      (c-inline ,args ,arg-types ,result-type
                ,c-expression :one-liner t))))
@@ -850,7 +851,8 @@ FUNCTION-NAME.
 The interpreter ignores this form. ARG-TYPES are argument types of
 the C function and RESULT-TYPE is its return type."
   (let ((output-type :object)
-        (args (mapcar #'(lambda (x) (gensym)) arg-types)))
+        (args (mapcar #'(lambda (x) (declare (ignore x)) (gensym))
+                      arg-types)))
     (if (consp c-name)
         (setf output-type (first c-name)
               c-name (second c-name)))

src/lsp/setf.lsp

@@ -31,7 +31,6 @@
         (push item vars))
       (push item all))
     (dotimes (i stores-no)
-      (declare (ignore i))
       (push (gensym) stores))
     (let* ((all (nreverse all)))
       (values (nreverse vars)