Revert "Revert "Merge branch 'develop' into 'develop'""

This reverts commit cf416f6fd4.

src/c/character.d

@@ -208,6 +208,7 @@ ecl_char_eq(cl_object x, cl_object y)
       if (ecl_char_eq(ecl_va_arg(ds), c)) {
         @(return ECL_NIL);
       }
+    ecl_va_end(ds);
   }
   @(return ECL_T);
 } @)

src/c/cinit.d

@@ -38,6 +38,7 @@ si_safe_eval(cl_narg narg, cl_object form, cl_object env, ...)
     cl_object err_value;
     va_list args; va_start(args, env);
     err_value = va_arg(args, cl_object);
+    va_end(args);
     return _ecl_funcall4(@'ext::safe-eval', form, env, err_value);
   }
   return _ecl_funcall3(@'ext::safe-eval', form, env);
@@ -98,6 +99,7 @@ si_string_to_object(cl_narg narg, cl_object string, ...)
     cl_object err_value;
     va_list args; va_start(args, string);
     err_value = va_arg(args, cl_object);
+    va_end(args);
     return _ecl_funcall3(@'si::string-to-object', string, err_value);
   }
   return _ecl_funcall2(@'si::string-to-object', string);
@@ -110,8 +112,9 @@ si_signal_simple_error(cl_narg narg, cl_object condition, cl_object continuable,
   cl_object rest;
   ecl_va_start(args, format_args, narg, 4);
   rest = cl_grab_rest_args(args);
-  cl_apply(6, @'si::signal-simple-error', condition, continuable,
-           format, format_args, rest);
+  ecl_va_end(args);
+  return cl_apply(6, @'si::signal-simple-error', condition, continuable,
+                  format, format_args, rest);
 }
 
 extern cl_object

src/c/clos/gfun.d

@@ -49,6 +49,7 @@ user_function_dispatch(cl_narg narg, ...)
   fun = fun->instance.slots[fun->instance.length - 1];
   output = ecl_apply_from_stack_frame(frame, fun);
   ecl_stack_frame_close(frame);
+  ecl_va_end(args);
   return output;
 }
 

src/c/dpp.c

@@ -764,6 +764,11 @@ put_declaration(void)
       put_lineno();
       fprintf(out, "\t}\n");
     }
+    if (simple_varargs) {
+	    fprintf(out,"\tva_end(%s);\n", rest_var);
+    } else {
+	    fprintf(out,"\tecl_va_end(%s);\n", rest_var);
+    }
     if (key_flag) {
       put_lineno();
       fprintf(out, "\tcl_parse_key(ARGS, %d, KEYS, KEY_VARS, NULL, %d);\n",

src/c/error.d

@@ -125,12 +125,15 @@ void
 FEerror(const char *s, int narg, ...)
 {
   ecl_va_list args;
+  cl_object rest;
   ecl_va_start(args, narg, narg, 0);
   ecl_enable_interrupts();
+  rest = cl_grab_rest_args(args);
+  ecl_va_end(args);
   funcall(4, @'si::universal-error-handler',
           ECL_NIL,                    /*  not correctable  */
           make_constant_base_string(s),    /*  condition text  */
-          cl_grab_rest_args(args));
+          rest);
   _ecl_unexpected_return();
 }
 

src/c/file.d

@@ -5328,7 +5328,8 @@ flisten(cl_object stream, FILE *fp)
   {
     /* regular file */
     ecl_off_t old_pos = ecl_ftello(fp), end_pos;
-    unlikely_if (ecl_fseeko(fp, 0, SEEK_END) != 0)
+    unlikely_if (old_pos == -1 ||
+                 ecl_fseeko(fp, 0, SEEK_END) != 0)
       file_libc_error(@[file-error], stream,
                       "Unable to check file position", 0);
     end_pos = ecl_ftello(fp);

src/c/numbers/ceiling.d

@@ -77,6 +77,7 @@ ecl_ceiling2(cl_object x, cl_object y)
   const cl_env_ptr the_env = ecl_process_env();
   cl_object v0, v1;
   cl_type ty;
+  v0 = v1 = ECL_NIL;
   ty = ecl_t_of(y);
   if (ecl_unlikely(!ECL_REAL_TYPE_P(ty))) {
     FEwrong_type_nth_arg(@[ceiling],2, y, @[real]);

src/c/numbers/number_compare.d

@@ -208,7 +208,9 @@ monotonic(int s, int t, int narg, ecl_va_list nums)
 
 #define MONOTONIC(i, j) (cl_narg narg, ...)                     \
   { ecl_va_list nums; ecl_va_start(nums, narg, narg, 0);        \
-    return monotonic(i, j, narg, nums); }
+    cl_object result = monotonic(i, j, narg, nums);             \
+    ecl_va_end(nums);                                           \
+    return result; }
 
 cl_object @<= MONOTONIC( 1, 0)
   cl_object @>= MONOTONIC(-1, 0)

src/c/numbers/number_equalp.d

@@ -188,6 +188,7 @@ ecl_number_equalp(cl_object x, cl_object y)
       if (ecl_number_equalp(numi, ecl_va_arg(numb))) {
         @(return ECL_NIL);
       }
+    ecl_va_end(numb);
   }
   @(return ECL_T);
   @)

src/c/package.d

@@ -51,12 +51,15 @@ void
 CEpackage_error(const char *message, const char *continue_message, cl_object package, int narg, ...)
 {
   ecl_va_list args;
+  cl_object arg;
   ecl_va_start(args, narg, narg, 0);
+  arg = narg? cl_grab_rest_args(args) : cl_list(1,package);
+  ecl_va_end(args);
   si_signal_simple_error(6,
                          @'package-error',
                          make_constant_base_string(continue_message),
                          make_constant_base_string(message), /* format control */
-                         narg? cl_grab_rest_args(args) : cl_list(1,package),
+                         arg,
                          @':package', package);
 }
 

src/c/pathname.d

@@ -564,6 +564,7 @@ ecl_parse_namestring(cl_object s, cl_index start, cl_index end, cl_index *ep,
   if (start == end) {
     host = device = path = name = type = aux = version = @'nil';
     logical = 0;
+    *ep = end;
     goto make_it;
   }
   /* We first try parsing as logical-pathname. In case of

src/c/tcp.d

@@ -251,6 +251,7 @@ create_server_port(int port)
     FElibc_error("Accepting requests", 0);
 #endif  /* THREADS */
 
+  close(request);
   return(conn);
 }
 

src/c/threads/process.d

@@ -190,7 +190,7 @@ thread_cleanup(void *aux)
   cl_env_ptr env = process->process.env;
   /* The following flags will disable all interrupts. */
   AO_store_full((AO_t*)&process->process.phase, ECL_PROCESS_EXITING);
-  ecl_disable_interrupts_env(env);
+  if (env) ecl_disable_interrupts_env(env);
 #ifdef HAVE_SIGPROCMASK
   /* ...but we might get stray signals. */
   {
@@ -440,6 +440,7 @@ mp_process_preset(cl_narg narg, cl_object process, cl_object function, ...)
   assert_type_process(process);
   process->process.function = function;
   process->process.args = cl_grab_rest_args(args);
+  ecl_va_end(args);
   @(return process);
 }
 
@@ -645,6 +646,7 @@ cl_object
 mp_process_run_function(cl_narg narg, cl_object name, cl_object function, ...)
 {
   cl_object process;
+  cl_object rest;
   ecl_va_list args;
   ecl_va_start(args, function, narg, 2);
   if (narg < 2)
@@ -654,8 +656,10 @@ mp_process_run_function(cl_narg narg, cl_object name, cl_object function, ...)
   } else {
     process = mp_make_process(2, @':name', name);
   }
+  rest = cl_grab_rest_args(args);
+  ecl_va_end(args);
   cl_apply(4, @'mp::process-preset', process, function,
-           cl_grab_rest_args(args));
+           rest);
   return mp_process_enable(process);
 }
 
@@ -673,6 +677,7 @@ mp_process_run_function_wait(cl_narg narg, ...)
       cl_sleep(wait);
     }
   }
+  ecl_va_end(args);
   @(return process);
 }
 

src/c/threads/queue.d

@@ -386,5 +386,6 @@ print_lock(char *prefix, cl_object l, ...)
     fflush(stdout);
     ecl_giveup_spinlock(&lock);
   }
+  va_end(args);
 }
 /*#define print_lock(a,b,c) (void)0*/

src/c/typespec.d

@@ -90,9 +90,9 @@ cl_object
 ecl_type_error(cl_object function, const char *place, cl_object o,
                cl_object type)
 {
-  si_wrong_type_argument(4, o, type,
-                         (*place? make_constant_base_string(place) : ECL_NIL),
-                         function);
+  return si_wrong_type_argument(4, o, type,
+                                (*place? make_constant_base_string(place) : ECL_NIL),
+                                function);
 }
 
 /**********************************************************************/

src/c/unicode/ucd_names_char.c

@@ -514,7 +514,7 @@ static void
 fill_pair_name(char *buffer, int pair)
 {
   if (pair < ECL_UCD_FIRST_PAIR) {
-    strncat(buffer, ecl_ucd_names_word[pair], ECL_UCD_LARGEST_CHAR_NAME+1);
+    strncat(buffer, ecl_ucd_names_word[pair], ECL_UCD_LARGEST_CHAR_NAME);
 /*
     printf("text=%s\n", ecl_ucd_names_word[pair]);
  */

src/c/unixsys.d

@@ -104,7 +104,7 @@ from_list_to_execve_argument(cl_object l, char ***environp)
   cl_object buffer;
   char **environ;
   for (p = l; !Null(p); p = ECL_CONS_CDR(p)) {
-    cl_object s;
+    cl_object s = ECL_CONS_CAR(p);
     total_size += s->base_string.fillp + 1;
     nstrings++;
   }
@@ -515,7 +515,7 @@ si_spawn_subprocess(cl_object command, cl_object argv, cl_object environ,
     }
     close(child_stdin);
     close(child_stdout);
-    close(child_stderr);
+    if (!(error == @':output')) close(child_stderr);
 
     if (child_pid < 0) {
       pid = ECL_NIL;
@@ -533,7 +533,7 @@ si_spawn_subprocess(cl_object command, cl_object argv, cl_object environ,
   if (Null(pid)) {
     if (parent_write) close(parent_write);
     if (parent_read) close(parent_read);
-    if (parent_error) close(parent_error);
+    if (parent_error > 0) close(parent_error);
     parent_write = 0;
     parent_read = 0;
     parent_error = 0;

src/cmp/cmpmain.lsp

@@ -262,7 +262,7 @@ void ~A(cl_object cblock)
          * circular chain. This disables the garbage collection of
          * the library until _ALL_ functions in all modules are unlinked.
          */
-        cl_object current, next = Cblock;
+        cl_object current = OBJNULL, next = Cblock;
 ~:{
         current = ecl_make_codeblock();
         current->cblock.next = next;
@@ -313,6 +313,7 @@ extern int
         ecl_init_module(OBJNULL, ~A);
         ~A
         } ECL_CATCH_ALL_END;
+        return 0;
 }
 ")
 

src/cmp/cmptop.lsp

@@ -443,7 +443,7 @@
     (wt-nl "volatile cl_object lex" *level* "[" *max-lex* "];"))
 
   (unless (eq closure-type 'CLOSURE)
-    (wt-nl "cl_object " *volatile* "env0;"))
+    (wt-nl "cl_object " *volatile* "env0 = ECL_NIL;"))
 
   (when  (plusp *max-env*)
     ;; Closure structure has to be marked volatile or else GCC may

src/h/internal.h

@@ -194,6 +194,7 @@ extern cl_object si_constant_form_value _ECL_ARGS((cl_narg narg, cl_object form,
                 va_list args;                                           \
                 va_start(args, lastarg);                                \
                 frame->frame.base = (cl_object*)args;                   \
+                va_end(args);                                           \
         } else {                                                        \
                 frame->frame.base = env->stack_top - narg;              \
         }
@@ -207,7 +208,7 @@ extern cl_object si_constant_form_value _ECL_ARGS((cl_narg narg, cl_object form,
         frame->frame.t = t_frame;                                       \
         frame->frame.env = env;                                         \
         frame->frame.size = narg;                                       \
-        if (narg < ECL_C_ARGUMENTS_LIMIT) {                                 \
+        if (narg < ECL_C_ARGUMENTS_LIMIT) {                             \
                 cl_object *p = frame->frame.base = env->values;         \
                 va_list args;                                           \
                 va_start(args, lastarg);                                \
@@ -215,6 +216,7 @@ extern cl_object si_constant_form_value _ECL_ARGS((cl_narg narg, cl_object form,
                         *p = va_arg(args, cl_object);                   \
                         ++p;                                            \
                 }                                                       \
+                va_end(args);                                           \
                 frame->frame.stack = (cl_object*)0x1;                   \
         } else {                                                        \
                 frame->frame.base = env->stack_top - narg;              \